aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorCarsten Dominik2009-08-06 09:14:10 +0000
committerCarsten Dominik2009-08-06 09:14:10 +0000
commitc8d0cf5ca023b996beb0ca15f7b054951acf9c7e (patch)
treeb1c465c4840dd899dc51ea577a3f5f70c4079e71 /lisp
parent8c914fdb1828b576dd66fd4ef546c32d62252c06 (diff)
downloademacs-c8d0cf5ca023b996beb0ca15f7b054951acf9c7e.tar.gz
emacs-c8d0cf5ca023b996beb0ca15f7b054951acf9c7e.zip
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')
-rw-r--r--lisp/org/ChangeLog1811
-rw-r--r--lisp/org/org-agenda.el1296
-rw-r--r--lisp/org/org-archive.el16
-rw-r--r--lisp/org/org-ascii.el606
-rw-r--r--lisp/org/org-attach.el6
-rw-r--r--lisp/org/org-bbdb.el80
-rw-r--r--lisp/org/org-bibtex.el2
-rw-r--r--lisp/org/org-clock.el606
-rw-r--r--lisp/org/org-colview.el184
-rw-r--r--lisp/org/org-compat.el45
-rw-r--r--lisp/org/org-docbook.el1405
-rw-r--r--lisp/org/org-exp-blocks.el440
-rw-r--r--lisp/org/org-exp.el3494
-rw-r--r--lisp/org/org-faces.el88
-rw-r--r--lisp/org/org-feed.el665
-rw-r--r--lisp/org/org-footnote.el99
-rw-r--r--lisp/org/org-gnus.el15
-rw-r--r--lisp/org/org-html.el2084
-rw-r--r--lisp/org/org-icalendar.el581
-rw-r--r--lisp/org/org-id.el29
-rw-r--r--lisp/org/org-indent.el283
-rw-r--r--lisp/org/org-info.el2
-rw-r--r--lisp/org/org-inlinetask.el199
-rw-r--r--lisp/org/org-irc.el2
-rw-r--r--lisp/org/org-jsinfo.el5
-rw-r--r--lisp/org/org-latex.el (renamed from lisp/org/org-export-latex.el)528
-rw-r--r--lisp/org/org-list.el310
-rw-r--r--lisp/org/org-mac-message.el184
-rw-r--r--lisp/org/org-macs.el64
-rw-r--r--lisp/org/org-mew.el2
-rw-r--r--lisp/org/org-mhe.el2
-rw-r--r--lisp/org/org-mouse.el30
-rw-r--r--lisp/org/org-plot.el29
-rw-r--r--lisp/org/org-protocol.el636
-rw-r--r--lisp/org/org-publish.el294
-rw-r--r--lisp/org/org-remember.el205
-rw-r--r--lisp/org/org-rmail.el85
-rw-r--r--lisp/org/org-src.el471
-rw-r--r--lisp/org/org-table.el223
-rw-r--r--lisp/org/org-timer.el73
-rw-r--r--lisp/org/org-vm.el7
-rw-r--r--lisp/org/org-w3m.el4
-rw-r--r--lisp/org/org-wl.el2
-rw-r--r--lisp/org/org-xoxo.el124
-rw-r--r--lisp/org/org.el4008
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 @@
12009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
2
3 * org.el (org-create-formula-image): Remove the -E option for
4 dvipng.
5
6 * org-exp.el (org-default-export-plist): Respect #+BIND.
7 (org-export-confirm-letbind): New function.
8
9 * org.el (org-paste-subtree): Test the kill ring entry if it is
10 going to be used.
11 (org-copy-subtree): Use `org-forward-same-level'.
12 (org-forward-same-level): Respect the `invisibe-ok' arg for
13 back-to-heading.
14
152009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
16
17 * org.el (org-table-map-tables): Make sure cursor is back at table
18 beginning after funcall.
19
20 * org-agenda.el (org-agenda-bulk-action): Make sure parents are
21 handled before children, and do not error if an entry is not
22 found, probably because it hase been remove when the parent was
23 archived or refiled.
24
25 * org.el (org-ido-completing-read): Accept straight lists for
26 completion as well as alists.
27
28 * org-timer.el (org-timer-cancel-timers): Renamed from
29 `org-timer-cancel-timers'.
30
31 * org.el (org-cycle-internal-local): Fix problem with finding next
32 invisible line.
33
342009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
35
36 * org-list.el (org-list-send-list): Call
37 `org-list-goto-true-beginning' instead of
38 `org-list-find-true-beginning', which does not exist.
39
40 * org-timer.el (org-timer-reset-timers): Use `mapc'.
41 (org-timer-set-timer): Do not assign to heading.
42
43 * org-id.el (org-id-open): Quote function name.
44
45 * org-macs.el (org-unmodified): Turn off recording undo
46 information while running inside the macro.
47
48 * org-table.el (org-table-export): Also work in file-less
49 buffers.
50
51 * org.el (org-startup-indented): New option.
52 (org-startup-options): Add new options indent and noindent.
53 (org-unfontify-region): Remove line-prefix and wrap-prefix
54 properties.
55 (org-after-demote-entry-hook, org-after-promote-entry-hook): New
56 hooks.
57 (org-promote, org-demote): Run the new hooks.
58
59 * org-table.el (org-table-align): Replace leading \n as well.
60
61 * org-exp.el (org-export-push-to-kill-ring): Remove `line-prefix'
62 and `line-wrap' text properties.
63
64 * org-compat.el (org-kill-new): New function.
65
66 * org-agenda.el (org-format-agenda-item): Remove `line-prefix' and
67 `line-wrap' text properties.
68
69 * org-indent.el: New file.
70
712009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
72
73 * org.el (org-provide-todo-statistics): Tweak docstring.
74
75 * org-id.el (org-id-open): Honor `org-link-frame-setup'.
76
772009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
78
79 * org-exp.el (org-export-as-org): Insert the "-source" string
80 before the extension.
81
82 * org.el (org-read-date): Make sure the calendar is in the current
83 frame.
84 (org-set-emph-re): Remove the ? from the post-match.
85 (org-emphasis-regexp-components): Add backslash to the
86 postmatch class.
87 (org-set-font-lock-defaults): Write \n instead of \xa, and make it
88 optional so that also lines at the end of the buffers will still
89 be matched as headlines.
90
91 * org-table.el (org-table-error-on-row-ref-crossing-hline):
92 Variable made obsolete.
93 (org-table-relative-ref-may-cross-hline): New option.
94 (org-table-find-row-type): Honow the new option
95 `org-table-relative-ref-may-cross-hline'.
96
972009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
98
99 * org-table.el (org-table-cut-region, org-table-copy-region): Work
100 on single field if no active region.
101
1022009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
103
104 * org-latex.el (org-export-latex-make-header): Only insert title
105 if one is defined.
106
107 * org.el (org-make-options-regexp): Allow empty values.
108
1092009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
110
111 * org.el (org-cycle-internal-local): Improved version of finding
112 next visible line.
113 (org-cycle-hide-drawers): Only hide drawers if this is really
114 necessary.
115 (outline-end-of-subtree): Make `outline-end-of-subtree' use the
116 org-version of this function in Org-mode. We use advice to
117 implement this change, so that future changes to this function in
118 outline.el wil be handled properly.
119 (org-forward-same-level, org-backward-same-level): New commands.
120
1212009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
122
123 * org.el (org-remove-empty-overlays-at)
124 (org-clean-visibility-after-subtree-move): New functons.
125 (org-move-subtree-down): Simplify cleanup of display.
126
1272009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
128
129 * org-mac-message.el (org-mac-message-get-links): Improve
130 docstring. Make argument SELECT-OR-FLAGGED optional, default to
131 "s". Fix the return value.
132 (org-mac-message-insert-flagged): Simplify.
133
134 * org.el (org-refile-get-location): Tamper with refile history o
135 that history contains compete matches instead of the entered
136 string.
137
1382009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
139
140 * org.el (org-store-link): Never store a link to an inline task.
141
142 * org-footnote.el (org-footnote-goto-local-insertion-point): Skip
143 inline tasks when positioning footnotes.
144
145 * org.el (org-refile): Remove the END line when archiving an
146 inline task that does have an END line.
147
148 * org-archive.el (org-archive-subtree): Remove the END line when
149 archiving an inline task that does have an END line.
150
151 * org-macs.el (org-with-limited-levels): New macro.
152 (org-get-limited-outline-regexp): New function.
153
154 * org-exp.el (org-export-format-source-code-or-example): Fix bug
155 that did not enumerate first line.
156 (org-export-mark-radio-links): Skip matches in links.
157
1582009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
159
160 * org.el (org-activate-plain-links): Make single-match.
161 (org-adapt-indentation): Fix docstring.
162
163 * org-macs.el (org-unmodified): Turn of modification hooks while
164 running this macro.
165
1662009-08-06 Bastien Guerry <bzg@altern.org>
167
168 * org.el (org-adapt-indentation): Slightly improve the docstring.
169 (org-occur): Sends an error when the user inputs an empty string.
170 (org-priority): Bugfix: the tag alignement should happen within
171 save-excursion.
172
1732009-08-06 Bastien Guerry <bzg@altern.org>
174
175 * org.el (org-make-link-regexps): Don't exclude parentheses from
176 `org-plain-link-re'
177 (org-cycle-internal-local): When locally cycling, switch directly
178 from CHILDREN to FOLDED if there is no subtree
179 (org-cycle): Update the docstring to document the new behavior of
180 `org-cycle-internal-local'.
181
1822009-08-06 Nicolas Goaziou <n.goaziou@neuf.fr> (tiny change)
183
184 * org-clock.el (org-clock-in): Bugfix: recognize timestamps with
185 an abbreviated format for days.
186
1872009-08-06 Bastien Guerry <bzg@altern.org>
188
189 * org-protocol.el (org-protocol-default-template-key): New
190 option.
191
192 * org.el (org-refile): Bugfix: save-excursion before reading the
193 refile target, otherwise cursor moves might confuse `org-refile'.
194
195 * org.el (org-toggle-heading): Bugfix: correctly convert list
196 items before the first headline.
197
198 * org.el (org-provide-todo-statistics): Allow a list of TODO
199 keywords to compute statistics against headlines containing a
200 keyword from this list.
201 (org-update-parent-todo-statistics): Possibly use the new allowed
202 value of `org-provide-todo-statistics'.
203
2042009-08-06 Bastien Guerry <bzg@altern.org>
205
206 * org-timer.el: Add autoload cookie.
207
208 * org.el (org-occur-link-in-agenda-files): New function.
209
210 * org-timer.el (org-timer-last-timer): New variable.
211
212 * org-agenda.el (org-agenda-mode-map): New key for
213 org-timer-set-timer called from the agenda.
214
215 * org.el (org-mode-map): New key for org-timer-set-timer.
216
217 * org-timer.el (org-timer-reset-timers)
218 (org-timer-show-remaining-time, org-timer-set-timer): New
219 functions.
220
221 * org-clock.el (org-show-notification): Update the docstring.
222
223 * org.el (org-provide-todo-statistics): Allow new value
224 'all-headlines for this option, which includes entries with no
225 TODO keywords in the todo statistics.
226 (org-update-parent-todo-statistics): Possibly use the new
227 'all-headline value from `org-provide-todo-statistics'.
228
2292009-08-06 Bastien Guerry <bzg@altern.org>
230
231 * org-clock.el (org-dblock-write:clocktable): Add a new option
232 :timestamp which allows display of timestamps in clock reports.
233
234 * org.el (org-mode-map): Define new key `C-c C-*': convert a plain
235 list to a subtree, preserving the structure of the list.
236 (org-set-emph-re): Make the last element optional in the regexp.
237 This regexp now matches an emphasized string at the end of a line.
238
239 * org-list.el (org-list-goto-true-beginning)
240 (org-list-make-subtree, org-list-make-subtrees): New functions.
241
242 * org.el (org-eval-in-calendar): Select the right frame.
243 (org-save-frame-excursion): Remove this macro.
244
2452009-08-06 Bastien Guerry <bzg@altern.org>
246
247 * org-list.el (org-list-beginning-re): Bugfix: don't use * when
248 trying to find the beginning of a list.
249
250 * org-exp.el (org-get-file-contents): Use a new argument: markup.
251 When present, tell org-get-file-contents not to protect org-like
252 lines.
253
254 * org-id.el (org-id-uuid-program): New option to set the name of
255 the uuidgen program.
256 (org-id-method): Use `org-id-uuid-program'.
257 (org-id-new): Use `org-id-uuid-program'.
258
2592009-08-06 Bastien Guerry <bzg@altern.org>
260
261 * org-exp.el (org-export-number-lines): Allow whitespace in code
262 references. Allow the -r switch to remove the references in the
263 source code even when the lines are not numbered: the labels can
264 be explicit enough.
265
266 * org.el (org-fontify-whole-heading-line): New option.
267 (org-set-font-lock-defaults): Use the new option.
268
269 * org-clock.el (org-show-notification-handler): New option.
270 (org-show-notification): Use the new option.
271
2722009-08-06 Bastien Guerry <bzg@altern.org>
273
274 * org.el (org-eval-in-calendar): Fix a bug about calendar
275 navigation when `calendar-setup' value is 'calendar-only.
276
2772009-08-06 Bastien Guerry <bzg@altern.org>
278
279 * org.el (orgstruct++-mode): Fix typo in docstring.
280 (org-insert-link): Clean up: (or (...)) => (...)
281 (org-insert-link): Use TAB for stored links completion.
282
2832009-08-06 Bastien Guerry <bzg@altern.org>
284
285 * org.el (org-get-refile-targets): Fix bug: don't ignore case when
286 building the list of targets.
287
288 * org-remember.el (org-remember-delete-empty-lines-at-end): New
289 option.
290 (org-remember-handler): Use the new option.
291
2922009-08-06 James TD Smith <ahktenzero@mohorovi.cc>
293
294 * org.el (org-tags-sort-function): New option for sorting tags.
295 (org-set-tags): Use the new option to sort tags.
296
297 * org-plot.el (org-plot/gnuplot): Run with an idle timer to avoid
298 premature deletion of the data when using org-plot in a script.
299
3002009-08-06 Bastien Guerry <bzg@altern.org>
301
302 * org-clock.el (org-clock-in-prepare-hook): New hook.
303 (org-clock-in): Use this new hook.
304
3052009-08-06 Bastien Guerry <bzg@altern.org>
306
307 * org.el (org-special-ctrl-a/e): Explicitely bind the value
308 'reversed for this option to the "true line boundary first"
309 behavior.
310 (org-tags-match-list-sublevels): Document the 'indented value for
311 this variable.
312
313 * org-latex.el (org-export-latex-first-lines): Fix problem with
314 publishing the region.
315
316 * org-exp.el (org-export-format-source-code-or-example): Fix
317 bad line numbering when exporting examples in HTML.
318
3192009-08-06 James TD Smith <ahktenzero@mohorovi.cc>
320
321 * org-colview.el (org-format-time-period): Formats a time in
322 fractional days as days, hours, mins, seconds.
323 (org-columns-display-here): Add special handling for SINCE and
324 SINCE_IA to format for display.
325
326 * org.el (org-time-since): Add a function to get the time since an
327 org timestamp.
328 (org-entry-properties): Add two new special properties: SINCE and
329 SINCE_IA. These give the time since any active or inactive
330 timestamp in an entry.
331 (org-special-properties): Add SINCE, SINCE_IA.
332 (org-tags-sort-function): Add custom declaration for tags
333 sorting function.
334 (org-set-tags): Sort tags if org-tags-sort-function is set
335
3362009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
337
338 * org-clock.el (org-clock-goto): Find hidden headlines as well.
339
340 * org.el (org-narrow-to-subtree): Find hidden headlines as well.
341
342 * org-plot.el (org-plot/add-options-to-plist): Add timeind
343 option.
344
3452009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
346
347 * org-publish.el (org-publish-remove-all-timestamps): New function.
348 (org-publish-all): Remove all timestamp files if `org-publish-all'
349 is called with a prefix argument.
350
351 * org-list.el (org-indent-item): Fix typo.
352 (org-item-indent-positions): Normalize ordered bullet.
353
3542009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
355
356 * org-macs.el (org-set-local): Make a local variable, do not make
357 the variable buffer-local!
358
359 * org-latex.el (org-export-as-latex): Call `org-install-letbind'.
360
361 * org-exp.el (org-infile-export-plist): Read BIND lines.
362 (org-install-letbind): New function.
363 (org-export-as-org, org-export-preprocess-string): Call
364 `org-install-letbind'.
365
366 * org-list.el (org-list-demote-modify-bullet): New option.
367 (org-first-list-item-p): Save point.
368 (org-fix-bullet-type): New optional argument FORCE-BULLET.
369 (org-indent-item): Honor `org-list-demote-modify-bullet'.
370 (org-item-indent-positions): Return bullet types along with
371 indentation.
372
3732009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
374
375 * org.el (org-show-entry): Hide drawers.
376
3772009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
378
379 * org-footnote.el (org-footnote-auto-adjust): New option.
380 (org-footnote-auto-adjust-maybe): New function.
381 (org-footnote-new, org-footnote-delete): Call
382 `org-footnote-auto-adjust-maybe'.
383
384 * org.el (org-startup-options): Add new footnote-related
385 keywords.
386
387 * org-publish.el (org-publish-timestamp-filename): Additional
388 arguments PUB-DIR and PUB-FUNC, which are included in the hash.
389 (org-publish-needed-p): Additional arguments PUB-DIR PUB-FUNC
390 TRUE-PUB-DIR. Pass them through to
391 `org-publish-timestamp-filename'.
392 (org-publish-update-timestamp): Additional arguments PUB-DIR and
393 PUB-FUNC, which are included in the hash.
394 (org-publish-file): Delay timestamp test until the publishing
395 function is known.
396
3972009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
398
399 * org-agenda.el (org-agenda-bulk-action): Add scheduling and
400 setting the deadline.
401
402 * org.el (org-read-date-final-answer): New variable.
403 (org-read-date): Store the final answer string, including the date
404 from the calendar, for reuse by agenda bulk commands.
405
406 * org-publish.el (org-publish-attachment): Fix publishing of
407 attachments.
408
409 * org-latex.el (org-export-latex-quotation-marks): Fix export of
410 quotation makrs in parenthesis.
411 (org-remove-initial-hash): New function.
412 (org-export-latex-preprocess): Fix bug with infinite loop if
413 environment is not properly closed.
414
415 * org-table.el (org-table-get-remote-range): Find #+TBLNAME also
416 when indented.
417
418 * org.el (org-fontify-meta-lines-and-blocks): Make #+TBLNAME
419 highlight also when indented.
420
4212009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
422
423 * org-footnote.el (org-footnote-renumber-fn:N): New command.
424 (org-footnote-action): Offer renumbering.
425
426 * org.el (org-cycle): Honor the `integrate' value of
427 org-cycle-include-plain-lists'.
428
429 * org-list.el (org-cycle-include-plain-lists): New allowed value
430 `internal'. Improve the docstring.
431
432 * org.el (org-set-autofill-regexps): Improve the paragraph-start
433 regexp to work better with LaTeX commands.
434
4352009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
436
437 * org-latex.el (org-export-latex-inline-image-extensions): Add ps
438 and eps extensions.
439
4402009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
441
442 * org-agenda.el (org-write-agenda): Make sure org-icalendar is
443 loaded.
444
445 * org.el (org-map-entries): No longer force
446 `org-tags-match-list-sublevels' to t during a todo-only tags
447 search.
448
4492009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
450
451 * org-latex.el (org-export-latex-low-levels): Allow user-defined
452 environment.
453 (org-export-latex-subcontent): Handle user-defined environment.
454
455 * org-agenda.el (org-agenda-view-mode-dispatch): Add more keys to
456 the View dispatcher.
457
458 * org.el (org-hide-block-toggle): Use `org-make-overlay' instead of
459 `make-overlay'.
460
461 * org-latex.el (org-export-as-pdf): Protect match data during call
462 to shell-quote-argument.
463
464 * org-agenda.el (org-agenda-mode-map): Modify bulk action keys.
465 (org-agenda-view-mode-dispatch): New function.
466
4672009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
468
469 * org-agenda.el (org-agenda-mode): Reset list of marks.
470 (org-agenda-mode-map): Define new keys for refile and bulk action.
471 (org-agenda-menu): Add menu itesm for refile and bulk action.
472 (org-agenda-refile): New function.
473 (org-agenda-set-tags): Optional arguments TAG and ONOFF.
474 (org-agenda-marked-entries): New variable.
475 (org-agenda-bulk-select, org-agenda-remove-bulk-action-overlays)
476 (org-agenda-remove-all-bulk-action-marks)
477 (org-agenda-bulk-action): New functions/commands.
478
4792009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
480
481 * org-exp.el (org-get-file-contents): Protect org-like lines in
482 included files.
483 (org-export-format-source-code-or-example): Remove newlines.
484
485 * org-latex.el (org-export-latex-links): Check for no-description
486 marking.
487
488 * org-exp.el (org-export-preprocess-apply-macros): Switch macro
489 argument separator back to comma.
490 (org-export-normalize-links): Mark links without description.
491
4922009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
493
494 * org-exp.el (org-infile-export-plist): Fix bug in macro
495 processing.
496
497 * org-agenda.el (org-agenda-clock-out): Update line after clocking
498 out.
499 (org-agenda-highlight-todo): Fix bug with highlighting.
500
5012009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
502
503 * org.el (org-set-font-lock-defaults): Adapt formatting to capture
504 new alignment strings.
505
506 * org-table.el (orgtbl-self-insert-command): Add yas/expand to
507 command list.
508 (org-table-align): Check for forced align type.
509
510 * org.el (org-self-insert-command): Add yas/expand to command
511 list.
512
513 * org-clock.el (org-clock-in-hook): New hook.
514 (org-clock-in): Run `org-clock-in-hook.
515 (org-clock-out-hook): New hook.
516 (org-clock-out): Run `org-clock-out-hook.
517 (org-clock-cancel-hook): New hook.
518 (org-clock-cancel): Run `org-clock-cancel-hook.
519 (org-clock-goto-hook): New hook.
520 (org-clock-goto): Run `org-clock-goto-hook.
521
5222009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
523
524 * org.el (org-store-link): Better default description for link to
525 Org-mode headline.
526
527 * org-exp.el (org-export-generic): Autoload the generic exporter
528 function.
529 (org-export): Implement the `g' key for the generic exporter.
530
5312009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
532
533 * org-table.el (orgtbl-setup): Add a binding for `S-iso-lefttab',
534 and for zbacktab'.
535
536 * org-exp.el (org-infile-export-plist): Get macros also from
537 #+SETUPFILE.
538
5392009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
540
541 * org-colview.el (org-columns-capture-view): Protect vertical bars
542 in column values.
543 (org-columns-capture-view): Exclude comment and archived trees.
544
545 * org-colview-xemacs.el (org-columns-capture-view): Protect
546 vertical bars in column values.
547 (org-columns-capture-view): Exclude comment and archived trees.
548
549 * org.el (org-quote-vert): New function.
550
551 * org-latex.el (org-export-latex-verbatim-wrap): New option.
552
553 * org-exp.el (org-export-format-source-code-or-example): Use
554 `org-export-latex-verbatim-wrap'.
555
556 * org.el (org-clone-subtree-with-time-shift): Also shift inactive
557 time stamps.
558
5592009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
560
561 * org-exp-blocks.el: New file.
562
563 * org-remember.el (org-remember-templates): Allow the headline
564 element to be a function.
565 (org-remember-apply-template): If the headline is a function, call
566 it to get the true function.
567
568 * org-clock.el (org-clock-menu): New function.
569 (org-clock-update-mode-line): Update help string.
570 (org-clock-modify-effort-estimate): New function.
571 (org-clock-mark-default-task): New function.
572
573 * org.el (org-hh:mm-string-to-minutes): Also take just a number of
574 minutes as input.
575 (org-org-menu): Add new clocking stuff.
576 (org-clock-is-active): New function.
577
5782009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
579
580 * org.el (org-open-non-existing-files): Improve docstring.
581
5822009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
583
584 * org-icalendar.el (org-icalendar-include-bbdb-anniversaries): New
585 option.
586 (org-export-icalendar): Call `org-bbdb-anniv-export-ical'.
587
588 * org-bbdb.el (org-bbdb-anniv-export-ical): New function.
589
590 * org-list.el (org-get-checkbox-statistics-face): Use the new
591 faces.
592
593 * org-faces.el (org-checkbox-statistics-todo)
594 (org-checkbox-statistics-done): New faces.
595
5962009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
597
598 * org-latex.el (org-export-latex-use-verb): New variable.
599 (org-export-latex-emph-format): Prefer \texttt over \verb when
600 org-export-latex-use-verb is set.
601
6022009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
603
604 * org-remember.el (org-remember-handler): Abort remember if the
605 buffer is empty.
606
607 * org-exp.el (org-export-format-source-code-or-example): Run
608 `org-src-mode-hook'.
609
6102009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
611
612 * org.el (org-indent-line-function): Fix indentation of +#end lines.
613
6142009-08-06 Tassilo Horn <tassilo@member.fsf.org>
615
616 * org-gnus.el (org-gnus-store-link): Require message.el in
617 org-gnus-store-link.
618
6192009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
620
621 * org-src.el: New file, split out of org.el
622
623 * org-macs.el (org-replace-match-keep-properties): New function.
624
625 * org-exp.el (org-export-mark-blockquote-verse-center): Better
626 preprocessing of center and quote and verse blocks.
627
628 * org-list.el (org-list-end): Respect the stored "original"
629 indentation when determining the end of the list.
630
631 * org-exp.el (org-export-replace-src-segments-and-examples):
632 Remember indentation correctly.
633
6342009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
635
636 * org-clock.el (org-clock-update-mode-line): Apply face
637 org-mode-line-clock.
638
639 * org-faces.el (org-mode-line-clock): New face.
640
6412009-08-06 Tassilo Horn <tassilo@member.fsf.org>
642
643 * org-gnus.el (org-gnus-store-link): Fix bug where
644 `org-gnus-store-link' used wrong subject when called in an article
645 buffer. Patch provided by fengli AT gmail DOT com.
646
6472009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
648
649 * org-exp.el (org-export-format-source-code-or-example): Remember
650 the original indentation of source code snippets and examples.
651
652 * org-latex.el (org-export-as-latex): Relocate the table of
653 contents.
654
655 * org.el (org-ctrl-c-ctrl-c): Update clock lines.
656
657 * org-agenda.el (org-run-agenda-series): Scope global options also
658 when creating the agenda buffer.
659
6602009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
661
662 * org.el (org-adapt-indentation): Improve documentation.
663 (org-insert-property-drawer): Respect org-adapt-indentation when
664 inserting the drawer.
665 (org-remove-flyspell-overlays-in): New function.
666 (org-do-emphasis-faces, org-activate-plain-links)
667 (org-activate-code, org-fontify-meta-lines-and-blocks)
668 (org-activate-angle-links, org-activate-footnote-links)
669 (org-activate-bracket-links, org-activate-dates)
670 (org-activate-target-links, org-activate-tags): Remove flyspell
671 overlays.
672
6732009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
674
675 * org.el (org-edit-src-save): New function.
676
677 * org-clock.el (org-clock-out-switch-to-state): New option.
678 (org-clock-out): Honor `org-clock-out-switch-to-state'.
679
680 * org-compat.el (org-compatible-face): Improve macro.
681
682 * org.el (org-global-properties-fixed): Add default for
683 CLOCK_MODELINE_TOTAL.
684
685 * org-clock.el (org-clock-sum): Accept lists and strigs as tstart
686 andd tend.
687 (org-clock-sum-current-item): Optional argument TSTART, pass it to
688 org-clock-sum.
689 (org-clock-get-sum-start): New function.
690
691 * org.el (org-startup-options): New keywords blockhide and
692 blockshow.
693 (org-mode): Add new invisibility spec.
694 (org-set-startup-visibility): Hide block on startup if so
695 desired.
696 (org-hide-block-startup): New option.
697 (org-block-regexp): New constant.
698 (org-hide-block-overlays): New variable.
699 (org-block-map, org-hide-block-toggle-all, org-hide-block-all)
700 (org-show-block-all, org-hide-block-toggle-maybe)
701 (org-hide-block-toggle): New functions.
702 (org-edit-src-exit): Do not quote lines starting with # and no +
703 behind it.
704 (org-auto-repeat-maybe): Add LAST_REPEAT properter for a repeating
705 entry.
706
7072009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
708
709 * org.el (org-buffer-property-keys): Add Effort property for
710 completion.
711
7122009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
713
714 * org-clock.el (org-clock-sum-current-item): Fix positioning bug
715 when retrieving total clocked time in the subtree.
716
717 * org.el (org-quoting-blocks): New variable.
718
7192009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
720
721 * org-table.el (org-table-store-formulas)
722 (org-table-get-stored-formulas, org-table-fix-formulas)
723 (org-table-edit-formulas, orgtbl-ctrl-c-ctrl-c)
724 (orgtbl-gather-send-defs): Allow indented #+TBLFM line.
725
726 * org.el (org-fontify-meta-lines, org-ctrl-c-ctrl-c): Allow
727 indented #+TBLFM line.
728
729 * org-footnote.el (org-footnote-goto-local-insertion-point): Allow
730 indented #+TBLFM line.
731
732 * org-colview.el (org-dblock-write:columnview): Allow indented
733 #+TBLFM line.
734
735 * org-colview-xemacs.el (org-dblock-write:columnview): Allow
736 indented #+TBLFM line.
737
738 * org-clock.el (org-dblock-write:clocktable): Allow indented
739 #+TBLFM line.
740
7412009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
742
743 * org-exp.el (org-export-format-source-code-or-example): Make
744 editing indented blocks work correctly.
745
746 * org.el (org-edit-src-nindent): New variable.
747 (org-edit-src-code, org-edit-fixed-width-region)
748 (org-edit-src-find-region-and-lang, org-edit-src-exit): Make
749 editing indented blocks work correctly.
750
7512009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
752
753 * org-exp.el (org-export-replace-src-segments-and-examples): FInd
754 indented blocks.
755 (org-export-format-source-code-or-example): Fix indentation of
756 blocks.
757 (org-export-remove-indentation): New function.
758 (org-export-select-backend-specific-text): Allow backend-specific
759 code to be indented.
760 (org-export-mark-blockquote-verse-center): Allow markers to be
761 indented.
762
763 * org.el (org-fontify-meta-lines): New function.
764 (org-set-font-lock-defaults): Call the new fontification
765 function.
766
767 * org-faces.el (org-meta-line): New face
768 (org-block): New face.
769
7702009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
771
772 * org.el (org-treat-insert-todo-heading-as-state-change)
773 (org-treat-S-cursor-todo-selection-as-state-change): New
774 variables.
775 (org-insert-todo-heading): Honor
776 `org-treat-insert-todo-heading-as-state-change'.
777 (org-shiftright, org-shiftleft): Honor
778 `org-treat-S-cursor-todo-selection-as-state-change'.
779 (org-inhibit-logging): New variable.
780
7812009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
782
783 * org-agenda.el (org-remove-subtree-entries-from-agenda): Reduce
784 range for marker position checking.
785
786 * org-latex.el (org-export-latex-first-lines): Fix bug when
787 exporting a region.
788
7892009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
790
791 * org-exp.el (org-export-push-to-kill-ring): Protect using
792 x-set-selection, because that does not always work.
793
794 * org-agenda.el (org-agenda-list): Apply the new face
795 `org-agenda-date-today'.
796
797 * org-faces.el (org-agenda-date-today): New face.
798
7992009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
800
801 * org-agenda.el (org-agenda-to-appt): Turn off restriction when
802 creating appointments.
803
804 * org-latex.el (org-export-latex-low-levels): Fix customization
805 type.
806
807 * org.el (org-priority, org-shiftup, org-shiftdown): Disable
808 priority commands.
809
810 * org-agenda.el (org-agenda-priority): Disable priority commands.
811
812 * org.el (org-enable-priority-commands): New option.
813
814 * org-colview-xemacs.el (org-columns-compute)
815 (org-columns-number-to-string): Fix problems with empty fields.
816
817 * org-colview.el (org-columns-compute)
818 (org-columns-number-to-string): Fix problems with empty fields.
819
820 * org-exp.el (org-export-push-to-kill-ring): New function.
821 (org-export-copy-to-kill-ring): New option.
822
823 * org-latex.el (org-export-as-latex): Call
824 `org-export-push-to-kill-ring'.
825
826 * org-exp.el (org-export-show-temporary-export-buffer): New
827 option.
828
829 * org-latex.el (org-export-as-latex): Use
830 `org-export-show-temporary-export-buffer'.
831
832 * org-exp.el (org-export-show-temporary-export-buffer): New
833 option.
834 (org-export-push-to-kill-ring): New function.
835
836 * org-colview.el (org-columns-compile-map): New variable.
837 (org-columns-new, org-columns-compute)
838 (org-columns-number-to-string, org-columns-uncompile-format)
839 (org-columns-compile-format): Implement new operators.
840
8412009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
842
843 * org-exp.el (org-export-plist-vars): Add :xml-declaration.
844
845 * org-list.el (org-update-checkbox-count): Make property
846 dependent.
847
848 * org.el (org-hierarchical-todo-statistics): New option.
849 (org-update-parent-todo-statistics): Modified to handle recursive
850 statistics.
851
8522009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
853
854 * org-publish.el (org-publish): Make this function behave
855 correctly in interactive use when called with a prefix argument.
856
857 * org.el (org-todo-statistics-hook): New hook.
858 (org-update-parent-todo-statistics): Use new hook.
859 (org-log-into-drawer): New function.
860 (org-add-log-setup): Use the new `org-log-into-drawer' function to
861 determine if we should be logging into a drawer.
862 (org-log-into-drawer): Update docstring.
863 (org-default-properties): Add LOG_INTO_DRAWER as a property.
864
865 * org-list.el (org-checkbox-statistics-hook): New hook.
866 (org-update-checkbox-count-maybe): Use new hook.
867
8682009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
869
870 * org.el (org-edit-src-code, org-edit-fixed-width-region): Use a
871 better bufer-generating mechanism.
872 (org-edit-src-find-buffer): New function.
873
874 * org-icalendar.el (org-print-icalendar-entries): Don't check for
875 archive tag, this is already done by `org-agenda-skip'.
876 data while constructing lost of tags.
877
8782009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
879
880 * org-exp.el (org-export-preprocess-apply-macros): Use semicolon
881 as argument separator in macros.
882
8832009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
884
885 * org.el (org-after-sorting-entries-or-items-hook): New hook.
886 (org-sort-entries-or-items): Run the new hook.
887 (org-after-refile-insert-hook): New hook.
888 (org-refile): Run `org-after-refile-insert-hook'.
889
890 * org-agenda.el (org-agenda-get-progress): Never take time of day
891 from headline when displaying progress.
892
893 * org-latex.el (org-export-latex-complex-heading-re): New variable.
894 (org-export-as-latex): Force the correct regexp in the
895 preprocessor buffer.
896 (org-export-latex-set-initial-vars): Set
897 `org-export-latex-complex-heading-re'.
898
899 * org-agenda.el (org-agenda-start-with-log-mode): New option.
900 (org-agenda-mode): Use `org-agenda-start-with-log-mode'.
901
9022009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
903
904 * org-latex.el (org-export-latex-tables-centered): New option.
905 (org-export-latex-tables): Use `org-export-latex-tables-centered'.
906
907 * org-exp.el (org-export-as-org): New command.
908 (org-export-as-org): New command.
909
910 * org-publish.el (org-publish-org-to-org): New function.
911
9122009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
913
914 * org.el (org-yank): Just call `org-yank-generic'.
915 (org-yank-generic): New function, containing the formaer
916 functionality of `org-yank'.
917
918 * org-latex.el (org-export-latex-not-done-keywords)
919 (org-export-latex-done-keywords): New variables.
920 (org-export-latex-todo-keyword-markup): New option.
921 (org-export-latex-set-initial-vars): Remember the TODO keywords.
922 (org-export-latex-keywords-maybe): Apply the TODO markup.
923
9242009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
925
926 * org-exp.el (org-infile-export-plist): Add more default macros.
927 (org-export-preprocess-apply-macros): Process macro arguments.
928
9292009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
930
931 * org-icalendar.el (org-icalendar-include-todo): New allowedvalue
932 `unblocked'.
933 (org-print-icalendar-entries): Respect the new value of
934 `org-icalendar-include-todo'.
935
936 * org.el (org-link-try-special-completion)
937 (org-file-complete-link): New functions.
938 (org-insert-link): Add special completion support for some link
939 types.
940
941 * org-bbdb.el (org-bbdb-complete-link): New function.
942
9432009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
944
945 * org-list.el (org-update-checkbox-count): Allow recursive
946 statistics.
947 (org-hierarchical-checkbox-statistics): New option.
948
949 * org.el (org-cycle): Remove erraneous space character.
950
951 * org-icalendar.el (org-icalendar-timezone): Initialize from
952 environment.
953
9542009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
955
956 * org.el (org-autoload): Fix autoloading of ascii export
957 functions.
958 (org-modules): Add org-special-blocks.
959
9602009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
961
962 * org-icalendar.el (org-start-icalendar-file): Use the new option.
963 (org-ical-timezone): New option.
964
965 * org-exp.el (org-export-get-coderef-format): Use the description
966 is present.
967
968 * org.el (org-sort-entries-or-items): Improve docstring, and make
969 better implementation for time sorting.
970
9712009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
972
973 * org.el (org-edit-src-persistent-message): New option.
974 (org-edit-src-code, org-edit-fixed-width-region): Use the new
975 option.
976
977 * org-clock.el (org-clock-insert-selection-line): Fix prefious
978 patch.
979
980 * org.el (org-edit-src-code, org-edit-fixed-width-region): Use
981 separate buffer instead of indirect buffer to edit source code.
982 (org-edit-src-exit): Make this function work with the new setup.
983
984 * org-clock.el (org-clock-insert-selection-line): Make sure tasks
985 are properly fontified before shown in the selection menu.
986
987 * org.el (org-fontify-like-in-org-mode): New function.
988
989 * org-latex.el (org-export-latex-links): Use the property list to
990 retrieve the default image attributes.
991
992 * org-exp.el (org-export-plist-vars): Add a new option.
993
9942009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
995
996 * org-exp.el (org-export, org-export-visible): Support ASCII
997 export to buffer
998 (org-export-normalize-links): Do not protect the description if it
999 is explicitly given.
1000
1001 * org-list.el (org-reset-checkbox-state-subtree): Moved here from
1002 org-checklist.el.
1003 (org-reset-checkbox-state-subtree): Call
1004 `org-reset-checkbox-state-subtree'.
1005
1006 * org-remember.el (org-select-remember-template): For the
1007 selection of a valid template.
1008
1009 * org-latex.el (org-export-region-as-latex): Supply the
1010 force-no-subtree argument.
1011 (org-export-as-latex): Provide better limits when exporting the
1012 first line. When exporting to string, we still want the first
1013 lines.
1014 (org-export-latex-first-lines): New argument END, to force the end
1015 of the region.
1016 (org-export-region-as-latex): Use the property list.
1017 (org-export-as-latex):
1018
1019 * org-colview-xemacs.el (org-columns-remove-overlays)
1020 (org-columns): Fix call to `local-variable-p'.
1021
10222009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1023
1024 * org-latex.el (org-export-latex-after-blockquotes-hook): New hook.
1025 (org-export-latex-preprocess): Run the new hook.
1026
1027 * org-exp.el (org-export-preprocess-after-blockquote-hook): New hook.
1028 (org-export-preprocess-string): Run the new hook.
1029
10302009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1031
1032 * org-macs.el (org-check-external-command): New defsubst.
1033
1034 * org.el (org-mode-map): New key for reload.
1035 (org-format-latex): Better error message when external programs
1036 are not available.
1037
1038 * org-agenda.el (org-agenda-mode-map): Bind `org-reload'.
1039
1040 * org.el (org-sort-entries-or-items): Explicit sorting function
1041 for priorities, needed for XEmacs compatibility.
1042
1043 * org-remember.el (org-remember-apply-template): Improve auto-save
1044 behavior.
1045
10462009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1047
1048 * org-latex.el (org-export-latex-preprocess): Also protect
1049 environments ending in a star.
1050
1051 * org-list.el (org-at-item-p): Fix regular expression.
1052
10532009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1054
1055 * org.el (org-end-of-subtree): Improve speed.
1056
1057 * org-agenda.el (org-agenda-get-timestamps)
1058 (org-agenda-get-progress, org-agenda-get-deadlines)
1059 (org-agenda-get-scheduled, org-agenda-get-blocks): Optimizations,
1060 in particular, wait as long as possible to collect the tags.
1061 (org-stuck-projects): Improve docstring.
1062
1063 * org.el (org-store-link): No errors when getting custom id before
1064 first headline.
1065 (org-get-tags-at): Use `org-up-heading-safe' when getting tags.
1066
10672009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1068
1069 * org.el (org-prepare-agenda-buffers): Catch a throw to nextfile.
1070
1071 * org-protocol.el: Remove dependency on url.el.
1072 (org-protocol-unhex-compound, org-protocol-open-source): Remove
1073 dependency on url.el.
1074
1075 * org-latex.el (org-export-as-pdf): Use
1076 `org-latex-to-pdf-process'.
1077
10782009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1079
1080 * org-latex.el (org-latex-to-pdf-process): New option.
1081
1082 * org-agenda.el (org-agenda-skip-additional-timestamps-same-entry):
1083 New option.
1084 (org-agenda-get-timestamps): Honor
1085 `org-agenda-skip-additional-timestamps-same-entry'.
1086
1087 * org-clock.el (org-clock-goto-may-find-recent-task): New option.
1088 (org-clock-goto): Find recent task only if
1089 `org-clock-goto-may-find-recent-task' allows it.
1090
1091 * org-exp.el (org-export-remove-or-extract-drawers): Handle empty
1092 drawers, and drawers that are missing the :END: line.
1093
10942009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1095
1096 * org-clock.el (org-clock-goto): Go to recently clocked task if no
1097 clock is running.
1098
10992009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1100
1101 * org.el (org-update-parent-todo-statistics): Check for
1102 STATISTICS_FROM property.
1103
1104 * org-list.el (org-update-checkbox-count): Check for
1105 STATISTICS_FROM property.
1106
1107 * org.el (org-tab-first-hook)
1108 (org-tab-after-check-for-table-hook)
1109 (org-tab-after-check-for-cycling-hook): New hooks.
1110 (org-cycle-internal-global, org-cycle-internal-local): New
1111 functions, split out from `org-cycle'.
1112 (org-cycle): Call the new hooks.
1113
11142009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1115
1116 * org-exp.el (org-export-preprocess-string): Reset the list of
1117 preferred targets for each run of the preprocessor.
1118
1119 * org.el (org-refile-target-verify-function): Improve
1120 documentation.
1121 (org-get-refile-targets): Respect point being moved by the
1122 verification function.
1123
1124 * org-latex.el (org-export-latex-timestamp-keyword-markup): New
1125 option.
1126 (org-export-latex-keywords): Use new option.
1127
1128 * org.el (org-rear-nonsticky-at): New defsubst.
1129 (org-activate-plain-links, org-activate-angle-links)
1130 (org-activate-footnote-links, org-activate-bracket-links)
1131 (org-activate-dates, org-activate-target-links)
1132 (org-activate-tags): Place the rear-nonsticky properties at the
1133 correct location.
1134
11352009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1136
1137 * org-protocol.el (server-edit): Declare `server-edit'.
1138 (org-protocol-unhex-string, org-protocol-unhex-compound): New
1139 functions.
1140 (org-protocol-check-filename-for-protocol): Call `server-edit'.
1141
1142 * org.el (org-default-properties): New default properteis for
1143 completion.
1144
1145 * org-exp.el (org-export-add-subtree-options): Add new properties
1146 for subtree export.
1147
11482009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1149
1150 * org-id.el (org-id-get-with-outline-path-completion): Turn off
1151 org-refile-target-verify-function for the duration of the command.
1152
1153 * org.el (org-link-to-org-use-id): New possible value
1154 `create-if-interactive-and-no-custom-id'.
1155 (org-store-link): Use custom IDs.
1156 (org-link-search): Find custom ID properties from #link.
1157 (org-default-properties): Add CUSTOM_ID for property completion.
1158 (org-refile-target-verify-function): New option.
1159 (org-goto): Turn off org-refile-target-verify-function
1160 for the duration of the command.
1161
11622009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1163
1164 * org-exp.el (org-export-preferred-target-alist): New variable.
1165 (org-export-define-heading-targets): Find the new CUSTOM_ID
1166 property.
1167 (org-export-target-internal-links): Target the custom ids when
1168 possible.
1169
1170 * org-latex.el (org-export-latex-preprocess): Better regexp for
1171 matching latex macros with arguments.
1172
11732009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1174
1175 * org-remember.el (org-remember-handler): Allow filing to non-org
1176 files.
1177
11782009-08-06 Magnus Henoch <magnus.henoch@gmail.com>
1179
1180 * org-table.el (org-table-fix-formulas): Do not change references
1181 to remote tables.
1182 (org-table-get-remote-range): Convert standard coordinates to RC
1183 format.
1184
1185 * org-latex.el (org-export-latex-keywords): Fix regexp bug.
1186
11872009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1188
1189 * org-compat.el (org-sha1-string): Function removed.
1190
1191 * org.el (org-refile-allow-creating-parent-nodes): New option.
1192 (org-refile-get-location): New argument NEW-NODES.
1193 (org-refile): Call `org-refile-get-location' with the new
1194 argument.
1195 (org-refile-get-location): Arrange for adding a new child.
1196 (org-refile-new-child): New function.
1197
1198 * org-clock.el: Fix a number of docstrings.
1199 (org-clock-find-position): New argument
1200 FIND-UNCLOSED to make the function find an unclosed clock in the
1201 entry.
1202 (org-clock-in): Call `org-clock-find-position' with the new
1203 argument if we might be resuming a clock.
1204
12052009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1206
1207 * org-latex.el (org-export-latex-display-custom-times): New variable.
1208 (org-export-latex-timestamp-markup): New option.
1209 (org-export-latex-set-initial-vars): Remember the local value of
1210 `org-display-custom-times'.
1211 (org-export-latex-content): Process time stamps.
1212 (org-export-latex-time-stamps): New function.
1213
1214 * org-macs.el (org-maybe-intangible): Add intangible property
1215 again to invisible text.
1216
12172009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1218
1219 * org-exp.el (org-default-export-plist): Handle undefined
1220 variables.
1221
12222009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1223
1224 * org.el (org-sort-entries-or-items): Match TODO keywrds
1225 case-sensitively, when sorting.
1226 (org-priority): Do not match TODO keywords with wrong case.
1227
12282009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1229
1230 * org.el (org-todo): Honor the NOBLOCKING property.
1231
1232 * org-agenda.el (org-agenda-dim-blocked-tasks): Honor the
1233 NOBLOCKING property.
1234
1235 * org.el (org-scan-tags): Fix bug in tag scanner
1236
12372009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1238
1239 * org.el (org-modules): Mark obsolete packages.
1240
1241 * org-html.el: New file, split out from org-exp.el.
1242
1243 * org-icalendar.el: New file, split out from org-exp.el.
1244
1245 * org-xoxo.el: New file, split out from org-exp.el.
1246
1247 * org-ascii.el: New file, split out from org-exp.el.
1248
12492009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1250
1251 * org-compat.el (org-find-library-name): New function.
1252
1253 * org.el (org-pre-cycle-hook): New hook.
1254 (org-cycle): Call the new hook in appropriate places.
1255 (org-reload): Only reload files that have been loaded before.
1256
12572009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1258
1259 * org.el (org-set-font-lock-defaults): Enforxe space or line end
1260 after todo keyword.
1261 (org-todo): When changing TODO state, do matching
1262 case-sensitively.
1263 (org-map-continue-from): New variable.
1264 (org-scan-tags): Respect values in `org-map-continue-from'.
1265 (org-reload): Make XEmacs compatible.
1266
12672009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1268
1269 * org-protocol.el (org-protocol-flatten-greedy): New function.
1270 (org-protocol-flatten): New function.
1271
1272 * org.el (org-open-link-from-string): Pass reference buffer to
1273 `org-open-at-point'.
1274 (org-open-at-point): New optional argument `reference-buffer'.
1275
12762009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1277
1278 * org.el (org-scan-tags): Make tag scan find headline in first
1279 line, 2nd attempt.
1280 (org-get-refile-targets): Add the naked file name.
1281 (org-refile): Store as top-level entry when only file name was
1282 given.
1283
1284 * org-agenda.el (org-agenda-get-progress): Fix regexp bug.
1285
1286 * org.el (org-block-todo-from-children-or-siblings-or-parent):
1287 Renamed from org-block-todo-from-children-or-siblings, and
1288 enhanced to look for the parent's status as well.
1289
1290 * org-agenda.el (org-agenda-log-mode-add-notes): New option.
1291 (org-agenda-get-progress): Add first notes line to log entry if so
1292 desired.
1293
12942009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1295
1296 * org-agenda.el (org-agenda-cleanup-fancy-diary-hook): New hook.
1297 (org-agenda-cleanup-fancy-diary): Call the new hook.
1298
1299 * org-remember.el (org-remember-apply-template): Take the default
1300 for the annotation from the :annotation property.
1301
1302 * org-mac-message.el (org-mac-message-get-link): Remove the
1303 quotes.
1304 (org-mac-message-get-link): Return the result.
1305
13062009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1307
1308 * org.el (org-refile-get-location): Add file name only if not
1309 already included in outline path.
1310
1311 * org-faces.el (org-n-level-faces): Fix customization type from
1312 number to integer.
1313
1314 * org-exp.el (org-export-headline-levels): Fix customization type
1315 from number to integer.
1316
1317 * org-agenda.el (org-agenda-confirm-kill)
1318 (org-agenda-custom-commands-local-options)
1319 (org-timeline-show-empty-dates, org-agenda-ndays)
1320 (org-agenda-start-on-weekday, org-scheduled-past-days): Fix
1321 customization type from number to integer.
1322
13232009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1324
1325 * org-protocol.el: Declare some functions.
1326
1327 * org-agenda.el (org-agenda-compare-effort): Honor
1328 `org-sort-agenda-noeffort-is-high'.
1329 (org-agenda-filter-by-tag, org-agenda-filter-make-matcher)
1330 (org-agenda-compare-effort): Implement the "?" operator for
1331 finding entries without effort setting.
1332
1333 * org.el (org-extract-attributes-from-string): New function.
1334
1335 * org-exp.el (org-export-splice-attributes): New function.
1336
13372009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1338
1339 * org-mouse.el: XEmacs compatibility fixes
1340
1341 * org.el (org-modules): Add org-inlinetasks.el
1342 (org-cycle): Implement limiting level on cycling.
1343 (org-move-subtree-down): Fix bug with swapping subtrees at end of
1344 buffer.
1345
1346 * org-inlinetask.el: New file.
1347
1348 * org-protocol.el: New file.
1349
1350 * org.el (org-emphasis-regexp-components): Allow braces in
1351 emphasis pre and post match.
1352
1353 * org-footnote.el (org-footnote-normalize): When only dorting, do
1354 not insert inline notes at the end.
1355
1356 * org.el (org-require-autoloaded-modules): Add org-docbook.el.
1357
1358 * org-docbook.el: New file.
1359
13602009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1361
1362 * org.el (org-reftex-citation): New command.
1363
13642009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1365
1366 * org-agenda.el (org-agenda-cmp-user-defined): New option.
1367 (org-sorting-choice, org-agenda-sorting-strategy): Add the new
1368 sorting options.
1369 (org-entries-lessp): Apply the new sorting option.
1370
1371 * org.el (org-block-todo-from-children-or-siblings): Fix bug in
1372 blocker code, when an older sibling has children.
1373
1374 * org-mac-message.el (org-mac-message-get-link): Improve getting
1375 links from multiple selected messages.
1376
13772009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1378
1379 * org-remember.el (org-remember-finalize): Do not set buffer file
1380 name to nil.
1381 (org-remember-handler): Mark buffer as unmodified.
1382 (org-remember-handler): Delete backup file and show message about
1383 remaining backup files.
1384 (org-remember-auto-remove-backup-files): New option.
1385
1386 * org.el (org-store-link): Use buffer name as link description in
1387 w3-mode buffers.
1388 (org-ido-switchb): Fix argument bug for completion.
1389
1390 * org-remember.el (org-remember-apply-template): Set local
1391 variable `auto-save-visited-file-name' instead of global one.
1392
13932009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1394
1395 * org-agenda.el (org-agenda-get-todos): Fix bug with match-data.
1396 (org-agenda-get-todos): Mark file tags as inherited.
1397 (org-agenda-list): Always search diary lines for a time.
1398
13992009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1400
1401 * org-feed.el: New file.
1402
1403 * org-exp.el (org-export-as-html): Close local lists depending on
1404 indentation, also when starting a table.
1405
1406 * org-remember.el (org-remember-backup-directory)
1407 (org-remember-backup-name): New internal variable.
1408
14092009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1410
1411 * org-clock.el (org-clock-out-if-current): Make buffer detection
1412 work in indirect buffers as well.
1413
1414 * org.el (org-emphasis-regexp-components): Add the exxclamation
1415 mark to the post-emphasis characters.
1416
14172009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1418
1419 * org.el (org-read-date-minibiffer-septup-hook): New hook.
1420 (org-read-date): Run the new hook.
1421
1422 * org-mac-message.el (org-mac-flagged-mail): New group.
1423 (org-mac-mail-account): New variable.
1424 (org-mac-create-flagged-mail, org-mac-insert-flagged-mail): New
1425 commands.
1426
1427 * org-remember.el (org-remember-backup-directory): New variable.
1428 (org-remember-apply-template): Write file to backup directory.
1429
14302009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1431
1432 * org-mouse.el (org-mouse-todo-menu): New function.
1433 (org-mouse-todo-keywords): Function removed.
1434 (org-mouse-context-menu): Use `org-mouse-todo-menu'.
1435
1436 * org-table.el (org-table-beginning-of-field)
1437 (org-table-end-of-field): New commands
1438 (org-table-previous-field, org-table-beginning-of-field): Better
1439 error messages.
1440 (orgtbl-setup): Include `M-a' and `M-e'.
1441
1442 * org.el (org-backward-sentence, org-forward-sentence): New
1443 commands.
1444
1445 * org-colview.el (org-colview-initial-truncate-line-value): New
1446 variable.
1447 (org-columns-remove-overlays): Restore the value of `truncate-lines'.
1448 (org-columns): Remember the value of `truncate-lines'.
1449
1450 * org-colview-xemacs.el (org-colview-initial-truncate-line-value):
1451 New variable.
1452 (org-columns-remove-overlays): Restore the value of
1453 `truncate-lines'.
1454 (org-columns): Remember the value of `truncate-lines'.
1455
1456 * org.el (org-columns-skip-arrchived-trees): New option.
1457
1458 * org-agenda.el (org-agenda-export-html-style): Define color for
1459 org-agenda-done face.
1460 (org-search-view, org-agenda-get-todos, org-agenda-get-progress)
1461 (org-agenda-get-deadlines, org-agenda-get-scheduled): Use new face.
1462
1463 * org.el (org-scan-tags): Use the new face.
1464
1465 * org-faces.el (org-agenda-done): New face.
1466
1467 * org.el (org-scan-tags): Test the value org
1468 `org-tags-match-list-sublevels'.
1469 (org-tags-match-list-sublevels): New allowed value: indented.
1470
1471 * org-latex.el (org-export-latex-make-header): Apply macros
1472 in header.
1473
1474 * org-exp.el (org-export-apply-macros-in-string): New function.
1475
1476 * org-latex.el (org-export-latex-list-parameters): Fix bug
1477 with the definition of a checked box.
1478
1479 * org-clock.el (org-clock-find-position): Fix drawer indentations.
1480
1481 * org-latex.el (org-export-latex-low-levels): More options
1482 for how to process lower levels in LaTeX.
1483 (org-export-latex-subcontent): Better treatment for lists as a
1484 means of publishing lower levels.
1485
14862009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1487
1488 * org.el (org-set-font-lock-defaults): Use new checkbox face.
1489
1490 * org-faces.el (org-checkbox): New face.
1491
1492 * org-exp.el (org-export-html-preprocess): Only create LaTeX
1493 fragement images if there is an export file.
1494
14952009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1496
1497 * org-agenda.el (org-stuck-projects): Document that the subtree of
1498 projects that are not stuck will now be searched for stuck
1499 sub-projects.
1500 (org-agenda-skip-entry-when-regexp-matches)
1501 (org-agenda-skip-entry-when-regexp-matches-in-subtree): New functions.
1502 (org-agenda-list-stuck-projects): Use
1503 `org-agenda-skip-entry-when-regexp-matches-in-subtree'.
1504
1505 * org-latex.el (org-export-latex-preprocess): Improve
1506 export of verses.
1507
1508 * org-exp.el (org-export-as-html): Implement centering as a div
1509 rather than a paragraph. Do a better job with line-end in verse
1510 environments.
1511
15122009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1513
1514 * org.el (org-open-at-point): Fix tags searches by mouse click.
1515
15162009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1517
1518 * org-latex.el (org-export-latex-preprocess): Implement the
1519 centering markup.
1520
1521 * org-exp.el (org-export-mark-blockquote-verse-center): Renamed
1522 from `org-export-mark-blockquote-and-verse'.
1523 (org-export-as-html): Implement the centering markup.
1524
1525 * org-latex.el (org-export-latex-tables): Fix vertical
1526 lines in tables.
1527
15282009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1529
1530 * org.el (org-read-date-history): New variable.
1531 (org-read-date): Use new history variable.
1532 (org-toggle-heading): Fix bug when used before first headline.
1533 (org-store-log-note): Remove drawer if empty while note is
1534 aborted.
1535 (org-remove-empty-drawer-at): New function.
1536 (org-check-after-date): New command.
1537 (org-sparse-tree): New sparse tree command "a".
1538
1539 * org-exp.el (org-export-as-ascii): Improve export of plain lists.
1540
15412009-08-06 Bastien Guerry <bzg@altern.org>
1542
1543 * org.el (org-toggle-fixed-width-section): Bug fix: insert a
1544 column and a space, not only a column.
1545
15462009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1547
1548 * org-latex.el (org-export-latex-emphasis-alist): Better
1549 defaults for verbose emphasis.
1550 (org-export-latex-emph-format): New function.
1551 (org-export-latex-fontify): Call `org-export-latex-emph-format'.
1552
1553 * org-agenda.el (org-agenda-menu): Add new commands to menu.
1554 (org-agenda-do-date-later, org-agenda-do-date-earlier)
1555 (org-agenda-date-later-minutes, org-agenda-date-earlier-minutes)
1556 (org-agenda-date-later-hours, org-agenda-date-earlier-hours): New
1557 commands.
1558
1559 * org.el (org-timestamp-change): Move end-time along with start
1560 time.
1561
15622009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1563
1564 * org-exp.el (org-export-target-internal-links)
1565 (org-export-as-html): Protect links specified as #name.
1566
15672009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1568
1569 * org.el (org-clone-subtree-with-time-shift): New command.
1570
1571 * org-latex.el (org-export-latex-special-chars)
1572 (org-export-latex-treat-sub-super-char): Fix subscript export.
1573
1574 * org-exp.el (org-create-multibrace-regexp): Do not add
1575 backslashes to the class.
1576
15772009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1578
1579 * org-colview.el (org-columns-map): Better functions for moving up
1580 and down a row, even if `truncate-line' is nil.
1581
1582 * org.el (org-insert-todo-heading): Make sure the keyword is
1583 inserted at the correct position.
1584
1585 * org-publish.el (org-publish-project-alist)
1586 (org-publish-projects, org-publish-org-index): Change default anme
1587 for the index of file names to "sitemap.org".
1588
1589 * org-latex.el (org-export-latex-tables): Use
1590 `org-split-string', for Emacs 21 compatibility.
1591
15922009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1593
1594 * org-agenda.el (org-agenda-log-mode-items): Improve docstring.
1595
15962009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1597
1598 * org-exp.el (org-export-page-description)
1599 (org-export-page-keywords): New variables.
1600 (org-export-plist-vars): Add entries for :keywords and
1601 :description.
1602 (org-infile-export-plist): Parse for new keywords.
1603 (org-get-current-options): Add new keywords
1604 (org-export-as-html): Publish description and keywords.
1605
1606 * org-agenda.el (org-agenda-add-entry-text-descriptive-links): New
1607 option.
1608 (org-agenda-add-entry-text): Honor
1609 `org-agenda-add-entry-text-descriptive-links'.
1610
1611 * org-latex.el (org-export-latex-preprocess): Make all
1612 external preprocess functions use a PARAMETER arg.
1613
1614 * org-exp.el (org-export-preprocess-string)
1615 (org-export-select-backend-specific-text)
1616 (org-export-format-source-code-or-example)
1617 (org-format-org-table-html): Support docbook export.
1618 (org-export-preprocess-string): Make all external preprocess
1619 functions use a PARAMETER arg.
1620
16212009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1622
1623 * org-exp.el (org-export-html-style-include-scripts): New option.
1624 (org-export-plist-vars): Add new option
1625 `org-export-html-style-include-scripts'.
1626 (org-export-as-html): Honor new option
1627 `org-export-html-style-include-scripts'.
1628 (org-export-html-scripts, org-export-html-style-default): Fix
1629 xml issues with the Safari browser.
1630
16312009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1632
1633 * org-publish.el (org-publish-attachment): Only copy file when the
1634 directories differ.
1635
16362009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1637
1638 * org-clock.el (org-clocktable-steps): Use inactive time stamps
1639 for clocktable steps.
1640
1641 * org.el (org-additional-option-like-keywords): Add two more
1642 keywords.
1643
16442009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1645
1646 * org-exp.el (org-export-format-source-code-or-example): Mark
1647 temporary buffer unmodified, so that it will be killed even if
1648 mode like message mode has decided to assign a file name.
1649
1650 * org.el (org-scan-tags): Improve tag inheritance.
1651 (org-scan-tags, org-make-tags-matcher): Make tag comparison
1652 case-sensitive.
1653 (org-scan-tags): Use the internal tags list instead of creating it
1654 from scratch.
1655 (org-trust-scanner-tags, org-scanner-tags): New variables.
1656 (org-scan-tags): Set `org-scanner-tags'.
1657 (org-get-tags-at): Take advantage of `org-trust-scanner-tags'.
1658 (org-map-entries): Document the possible speedup using scanner
1659 tags.
1660
16612009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1662
1663 * org.el (org-add-planning-info): Fix bug with looking for keyword
1664 only at column 0.
1665
1666 * org-agenda.el (org-agenda-custom-commands-local-options): Add
1667 option for tags filter preset.
1668 (org-prepare-agenda): Store filter preset as a property on the
1669 filter variable.
1670 (org-finalize-agenda): Call the filter, if there is a preset.
1671 (org-agenda-filter-by-tag): Filter again after clearing the
1672 filter, when there still is a preset.
1673 (org-agenda-filter-make-matcher, org-agenda-set-mode-name):
1674 Include the preset filter.
1675 (org-agenda-redo): Apply the filter again, also the preset filter.
1676
1677 * org-exp.el (org-export-as-html): Use IDs in the correct way.
1678
1679 * org.el (org-uuidgen-p): New funtion.
1680
1681 * org-agenda.el (org-agenda-fontify-priorities): New default value
1682 `cookies'.
1683 (org-agenda-fontify-priorities): Renamed from
1684 org-fontify-priorities.
1685
1686 * org.el (org-set-font-lock-defaults): Call
1687 `org-font-lock-add-priority-faces'.
1688 (org-font-lock-add-priority-faces): New function.
1689
1690 * org-faces.el: (org-set-tag-faces): New option.
1691 (org-priority-faces): New variable.
1692
1693 * org-exp.el (org-export-as-html): Add a "content" div around the
1694 entire content of the body tag.
1695 (org-export-html-get-bibliography): New function.
1696 (org-export-html-validation-link): New variable.
1697 (org-export-as-html): Add validation link to exported page.
1698
1699 * org.el (org-match-sparse-tree): Renamed from
1700 `org-tags-sparse-tree'.
1701 (org-tags-sparse-tree): New alias.
1702
17032009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1704
1705 * org.el (org-get-valid-level): Catch the case where the level
1706 change is nil.
1707
1708 * org-clock.el (org-clock-find-position): Better indentation of
1709 new clock drawers.
1710
17112009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1712
1713 * org-agenda.el (org-agenda-quit): Delete window only when the
1714 frame-setup was not `current-window'.
1715
1716 * org.el (org-tag-persistent-alist): New option.
1717 (org-startup-options): Add keyword `noptag'.
1718 (org-fast-todo-selection): Handle :newline correctly.
1719 (org-set-tags): Handle :newline correctly.
1720 (org-fast-tag-selection): Handle :newline correctly.
1721
17222009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1723
1724 * org-exp.el (org-export-as-ascii): Reverse link buffer before
1725 outputting it.
1726 (org-export-ascii-push-links): Fix bug with pussing links into the
1727 export buffer.
1728
17292009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1730
1731 * org-archive.el (org-archive-subtree): Do not add 1 to level if
1732 pasting at top level.
1733
1734 * org-bbdb.el: Improve documentation.
1735
17362009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1737
1738 * org-list.el (org-insert-item): Only consider insert empty lines
1739 is `org-empty-line-terminates-plain-lists' is not nil.
1740
1741 * org.el (org-blank-before-new-entry): Mention the dependence on
1742 `org-empty-line-terminates-plain-lists' in the docstring.
1743
1744 * org-publish.el (org-publish-get-project-from-filename): New
1745 optional argument UP. Only find the top project if UP is set.
1746 (org-publish-current-project): Find the top encloding project.
1747
1748 * org-agenda.el (org-agenda-before-write-hook)
1749 (org-agenda-add-entry-text-maxlines): New options.
1750 (org-write-agenda): Run the new hook in the temporary buffer.
1751 (org-agenda-add-entry-text): New function.
1752 (org-write-agenda): Implement PDF export, using ps2pdf.
1753
1754 * org.el (org-global-properties-fixed, org-global-properties):
1755 Improve documentation string.
1756
1757 * org-exp.el (org-export-ascii-links-to-notes): New option.
1758 (org-export-as-ascii): Handle links better.
1759 (org-export-ascii-wrap, org-export-ascii-push-links): New
1760 functions.
1761
17622009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1763
1764 * org-agenda.el (org-agenda): Make prefix arg optional.
1765 (org-agenda-search-headline-for-time): New option.
1766 (org-format-agenda-item): Honor
1767 `org-agenda-search-headline-for-time'.
1768
1769 * org-table.el (orgtbl-self-insert-command): Cluster undo for 20
1770 characters.
1771
1772 * org.el (org-self-insert-cluster-for-undo): New option.
1773 (org-self-insert-command): Cluster undo for 20 characters.
1774 (org-self-insert-command-undo-counter): New variable.
1775
17762009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1777
1778 * org-exp.el (org-export-as-html): Fix problem with closing colone
1779 example.
1780
17812009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1782
1783 * org-latex.el (org-export-as-latex)
1784 (org-export-latex-first-lines): Avoid modification flag when
1785 adding or removing text properties.
1786 (org-export-latex-fontify): Catch error when org-emph-alist has
1787 entries that are not defined for LaTeX export.
1788
1789 * org-export-latex.el: renamed to org-latex.el
1790
1791 * org-latex.el: renamed from org-export-latex.el
1792
1793 * org.el (orgstruct++-mode): New function.
1794 (turn-on-orgstruct++): Call `orgstruct++-mode'.
1795 (org-context-p): Allow detecting item context after the first line
1796 of an item.
1797 (orgstruct-make-binding): Detect if item-body context should be
1798 seen.
1799 (orgstruct-is-++): New variable.
1800 (org-add-planning-info): Catch the case when there is no planning
1801 info yet and the call does not want to add anything, only maybe
1802 tries to remove something.
1803 (org-special-ctrl-a/e): All value to be a cons cell with separate
1804 settings for `C-a. and `C-e'.
1805 (org-beginning-of-line, org-end-of-line): Honor separate values
1806 for `C-a' and `C-e'.
1807
18082009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
1809
1810 * org.el (org-reload): New command.
1811
12009-06-05 Tassilo Horn <tassilo@member.fsf.org> 18122009-06-05 Tassilo Horn <tassilo@member.fsf.org>
2 1813
3 * org-gnus.el (org-gnus-store-link): Fix bug where 1814 * 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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -73,7 +73,7 @@ only needed when the text to be killed contains more than N non-white lines."
73 :type '(choice 73 :type '(choice
74 (const :tag "Never" nil) 74 (const :tag "Never" nil)
75 (const :tag "Always" t) 75 (const :tag "Always" t)
76 (number :tag "When more than N lines"))) 76 (integer :tag "When more than N lines")))
77 77
78(defcustom org-agenda-compact-blocks nil 78(defcustom org-agenda-compact-blocks nil
79 "Non-nil means, make the block agenda more compact. 79 "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."
102 102
103(defcustom org-agenda-exporter-settings nil 103(defcustom org-agenda-exporter-settings nil
104 "Alist of variable/value pairs that should be active during agenda export. 104 "Alist of variable/value pairs that should be active during agenda export.
105This is a good place to set options for ps-print and for htmlize." 105This is a good place to set options for ps-print and for htmlize.
106Note that the way this is implemented, the values will be evaluated
107before assigned to the variables. So make sure to quote values you do
108*not* want evaluated, for example
109
110 (setq org-agenda-exporter-settings
111 '((ps-print-color-p 'black-white)))"
106 :group 'org-agenda-export 112 :group 'org-agenda-export
107 :type '(repeat 113 :type '(repeat
108 (list 114 (list
109 (variable) 115 (variable)
110 (sexp :tag "Value")))) 116 (sexp :tag "Value"))))
111 117
118(defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text)
119 "Hook run in temporary buffer before writing it to an export file.
120A useful function is `org-agenda-add-entry-text'."
121 :group 'org-agenda-export
122 :type 'hook
123 :options '(org-agenda-add-entry-text))
124
125(defcustom org-agenda-add-entry-text-maxlines 0
126 "Maximum number of entry text lines to be added to agenda.
127This is only relevant when `org-agenda-add-entry-text' is part of
128`org-agenda-before-write-hook', which it is by default.
129When this is 0, nothing will happen. When it is greater than 0, it
130specifies the maximum number of lines that will be added for each entry
131that is listed in the agenda view."
132 :group 'org-agenda
133 :type 'integer)
134
135(defcustom org-agenda-add-entry-text-descriptive-links t
136 "Non-nil means, export org-links as descriptive links in agenda added text.
137This variable applies to the text added to the agenda when
138`org-agenda-add-entry-text-maxlines' is larger than 0.
139When this variable nil, the URL will (also) be shown."
140 :group 'org-agenda
141 :type 'boolean)
142
112(defcustom org-agenda-export-html-style "" 143(defcustom org-agenda-export-html-style ""
113 "The style specification for exported HTML Agenda files. 144 "The style specification for exported HTML Agenda files.
114If this variable contains a string, it will replace the default <style> 145If 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:
129 color: #cc6666; 160 color: #cc6666;
130 font-weight: bold; 161 font-weight: bold;
131 } 162 }
163 .org-agenda-done {
164 color: #339933;
165 }
132 .org-done { 166 .org-done {
133 color: #339933; 167 color: #339933;
134 } 168 }
@@ -160,21 +194,21 @@ you can \"misuse\" it to also add other text to the header. However,
160 (const tag-down) (const tag-up) 194 (const tag-down) (const tag-up)
161 (const priority-up) (const priority-down) 195 (const priority-up) (const priority-down)
162 (const todo-state-up) (const todo-state-down) 196 (const todo-state-up) (const todo-state-down)
163 (const effort-up) (const effort-down)) 197 (const effort-up) (const effort-down)
198 (const user-defined-up) (const user-defined-down))
164 "Sorting choices.") 199 "Sorting choices.")
165 200
166(defconst org-agenda-custom-commands-local-options 201(defconst org-agenda-custom-commands-local-options
167 `(repeat :tag "Local settings for this command. Remember to quote values" 202 `(repeat :tag "Local settings for this command. Remember to quote values"
168 (choice :tag "Setting" 203 (choice :tag "Setting"
169 (list :tag "Any variable" 204 (list :tag "Heading for this block"
170 (variable :tag "Variable") 205 (const org-agenda-overriding-header)
171 (sexp :tag "Value")) 206 (string :tag "Headline"))
172 (list :tag "Files to be searched" 207 (list :tag "Files to be searched"
173 (const org-agenda-files) 208 (const org-agenda-files)
174 (list 209 (list
175 (const :format "" quote) 210 (const :format "" quote)
176 (repeat 211 (repeat (file))))
177 (file))))
178 (list :tag "Sorting strategy" 212 (list :tag "Sorting strategy"
179 (const org-agenda-sorting-strategy) 213 (const org-agenda-sorting-strategy)
180 (list 214 (list
@@ -194,13 +228,19 @@ you can \"misuse\" it to also add other text to the header. However,
194 (const org-agenda-start-on-weekday) 228 (const org-agenda-start-on-weekday)
195 (choice :value 1 229 (choice :value 1
196 (const :tag "Today" nil) 230 (const :tag "Today" nil)
197 (number :tag "Weekday No."))) 231 (integer :tag "Weekday No.")))
198 (list :tag "Include data from diary" 232 (list :tag "Include data from diary"
199 (const org-agenda-include-diary) 233 (const org-agenda-include-diary)
200 (boolean)) 234 (boolean))
201 (list :tag "Deadline Warning days" 235 (list :tag "Deadline Warning days"
202 (const org-deadline-warning-days) 236 (const org-deadline-warning-days)
203 (integer :value 1)) 237 (integer :value 1))
238 (list :tag "Tags filter preset"
239 (const org-agenda-filter-preset)
240 (list
241 (const :format "" quote)
242 (repeat
243 (string :tag "+tag or -tag"))))
204 (list :tag "Standard skipping condition" 244 (list :tag "Standard skipping condition"
205 :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) 245 :value (org-agenda-skip-function '(org-agenda-skip-entry-if))
206 (const org-agenda-skip-function) 246 (const org-agenda-skip-function)
@@ -219,11 +259,16 @@ you can \"misuse\" it to also add other text to the header. However,
219 (const :tag "scheduled" 'scheduled) 259 (const :tag "scheduled" 'scheduled)
220 (const :tag "not scheduled" 'notscheduled) 260 (const :tag "not scheduled" 'notscheduled)
221 (const :tag "deadline" 'deadline) 261 (const :tag "deadline" 'deadline)
222 (const :tag "no deadline" 'notdeadline)))))) 262 (const :tag "no deadline" 'notdeadline)
263 (const :tag "timestamp" 'timestamp)
264 (const :tag "no timestamp" 'nottimestamp))))))
223 (list :tag "Non-standard skipping condition" 265 (list :tag "Non-standard skipping condition"
224 :value (org-agenda-skip-function) 266 :value (org-agenda-skip-function)
225 (const org-agenda-skip-function) 267 (const org-agenda-skip-function)
226 (sexp :tag "Function or form (quoted!)")))) 268 (sexp :tag "Function or form (quoted!)"))
269 (list :tag "Any variable"
270 (variable :tag "Variable")
271 (sexp :tag "Value (sexp)"))))
227 "Selection of examples for agenda command settings. 272 "Selection of examples for agenda command settings.
228This will be spliced into the custom type of 273This will be spliced into the custom type of
229`org-agenda-custom-commands'.") 274`org-agenda-custom-commands'.")
@@ -308,8 +353,8 @@ should provide a description for the prefix, like
308 (const :tag "TODO list" alltodo) 353 (const :tag "TODO list" alltodo)
309 (const :tag "Search words" search) 354 (const :tag "Search words" search)
310 (const :tag "Stuck projects" stuck) 355 (const :tag "Stuck projects" stuck)
311 (const :tag "Tags search (all agenda files)" tags) 356 (const :tag "Tags/Property match (all agenda files)" tags)
312 (const :tag "Tags search of TODO entries (all agenda files)" tags-todo) 357 (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo)
313 (const :tag "TODO keyword search (all agenda files)" todo) 358 (const :tag "TODO keyword search (all agenda files)" todo)
314 (const :tag "Tags sparse tree (current buffer)" tags-tree) 359 (const :tag "Tags sparse tree (current buffer)" tags-tree)
315 (const :tag "TODO keyword tree (current buffer)" todo-tree) 360 (const :tag "TODO keyword tree (current buffer)" todo-tree)
@@ -375,7 +420,8 @@ you can then use it to define a custom command."
375 '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") 420 '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
376 "How to identify stuck projects. 421 "How to identify stuck projects.
377This is a list of four items: 422This is a list of four items:
3781. A tags/todo matcher string that is used to identify a project. 4231. A tags/todo/property matcher string that is used to identify a project.
424 See the manual for a description of tag and property searches.
379 The entire tree below a headline matched by this is considered one project. 425 The entire tree below a headline matched by this is considered one project.
3802. A list of TODO keywords identifying non-stuck projects. 4262. A list of TODO keywords identifying non-stuck projects.
381 If the project subtree contains any headline with one of these todo 427 If the project subtree contains any headline with one of these todo
@@ -384,9 +430,18 @@ This is a list of four items:
3843. A list of tags identifying non-stuck projects. 4303. A list of tags identifying non-stuck projects.
385 If the project subtree contains any headline with one of these tags, 431 If the project subtree contains any headline with one of these tags,
386 the project is considered to be not stuck. If you specify \"*\" as 432 the project is considered to be not stuck. If you specify \"*\" as
387 a tag, any tag will mark the project unstuck. 433 a tag, any tag will mark the project unstuck. Note that this is about
434 the explicit presence of a tag somewhere in the subtree, inherited
435 tags to not count here. If inherited tags make a project not stuck,
436 use \"-TAG\" in the tags part of the matcher under (1.) above.
3884. An arbitrary regular expression matching non-stuck projects. 4374. An arbitrary regular expression matching non-stuck projects.
389 438
439If the project turns out to be not stuck, search continues also in the
440subtree to see if any of the subtasks have project status.
441
442See also the variable `org-tags-match-list-sublevels' which applies
443to projects matched by this search as well.
444
390After defining this variable, you may use \\[org-agenda-list-stuck-projects] 445After defining this variable, you may use \\[org-agenda-list-stuck-projects]
391or `C-c a #' to produce the list." 446or `C-c a #' to produce the list."
392 :group 'org-agenda-custom-commands 447 :group 'org-agenda-custom-commands
@@ -394,7 +449,7 @@ or `C-c a #' to produce the list."
394 (string :tag "Tags/TODO match to identify a project") 449 (string :tag "Tags/TODO match to identify a project")
395 (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) 450 (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string))
396 (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) 451 (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string))
397 (regexp :tag "Projects are *not* stuck if this regexp matches\ninside the subtree"))) 452 (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree")))
398 453
399(defcustom org-agenda-filter-effort-default-operator "<" 454(defcustom org-agenda-filter-effort-default-operator "<"
400 "The default operator for effort estimate filtering. 455 "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,
449but don't want them to show up in the TODO list. 504but don't want them to show up in the TODO list.
450When this is set, it also covers deadlines and scheduled items, the settings 505When this is set, it also covers deadlines and scheduled items, the settings
451of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' 506of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
452will be ignored." 507will be ignored.
508See also the variable `org-agenda-tags-todo-honor-ignore-options'."
453 :group 'org-agenda-skip 509 :group 'org-agenda-skip
454 :group 'org-agenda-todo-list 510 :group 'org-agenda-todo-list
455 :type 'boolean) 511 :type 'boolean)
@@ -458,7 +514,8 @@ will be ignored."
458 "Non-nil means, don't show scheduled entries in the global todo list. 514 "Non-nil means, don't show scheduled entries in the global todo list.
459The idea behind this is that by scheduling it, you have already taken care 515The idea behind this is that by scheduling it, you have already taken care
460of this item. 516of this item.
461See also `org-agenda-todo-ignore-with-date'." 517See also `org-agenda-todo-ignore-with-date'.
518See also the variable `org-agenda-tags-todo-honor-ignore-options'."
462 :group 'org-agenda-skip 519 :group 'org-agenda-skip
463 :group 'org-agenda-todo-list 520 :group 'org-agenda-todo-list
464 :type 'boolean) 521 :type 'boolean)
@@ -467,7 +524,8 @@ See also `org-agenda-todo-ignore-with-date'."
467 "Non-nil means, don't show near deadline entries in the global todo list. 524 "Non-nil means, don't show near deadline entries in the global todo list.
468Near means closer than `org-deadline-warning-days' days. 525Near means closer than `org-deadline-warning-days' days.
469The idea behind this is that such items will appear in the agenda anyway. 526The idea behind this is that such items will appear in the agenda anyway.
470See also `org-agenda-todo-ignore-with-date'." 527See also `org-agenda-todo-ignore-with-date'.
528See also the variable `org-agenda-tags-todo-honor-ignore-options'."
471 :group 'org-agenda-skip 529 :group 'org-agenda-skip
472 :group 'org-agenda-todo-list 530 :group 'org-agenda-todo-list
473 :type 'boolean) 531 :type 'boolean)
@@ -476,7 +534,7 @@ See also `org-agenda-todo-ignore-with-date'."
476 "Non-nil means, honor todo-list ...ignore options also in tags-todo search. 534 "Non-nil means, honor todo-list ...ignore options also in tags-todo search.
477The variables 535The variables
478 `org-agenda-todo-ignore-with-date', 536 `org-agenda-todo-ignore-with-date',
479 `org-agenda-todo-ignore-scheduled' 537 `org-agenda-todo-ignore-scheduled'
480 `org-agenda-todo-ignore-deadlines' 538 `org-agenda-todo-ignore-deadlines'
481make the global TODO list skip entries that have time stamps of certain 539make the global TODO list skip entries that have time stamps of certain
482kinds. If this option is set, the same options will also apply for the 540kinds. 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."
507 :group 'org-agenda-daily/weekly 565 :group 'org-agenda-daily/weekly
508 :type 'boolean) 566 :type 'boolean)
509 567
568(defcustom org-agenda-skip-additional-timestamps-same-entry t
569 "When nil, multiple same-day timestamps in entry make multiple agenda lines.
570When non-nil, after the search for timestamps has matched once in an
571entry, the rest of the entry will not be searched."
572 :group 'org-agenda-skip
573 :type 'boolean)
574
510(defcustom org-agenda-skip-timestamp-if-done nil 575(defcustom org-agenda-skip-timestamp-if-done nil
511 "Non-nil means don't select item by timestamp or -range if it is DONE." 576 "Non-nil means don't select item by timestamp or -range if it is DONE."
512 :group 'org-agenda-skip 577 :group 'org-agenda-skip
@@ -515,12 +580,19 @@ deadlines are always turned off when the item is DONE."
515 580
516(defcustom org-agenda-dim-blocked-tasks t 581(defcustom org-agenda-dim-blocked-tasks t
517 "Non-nil means, dim blocked tasks in the agenda display. 582 "Non-nil means, dim blocked tasks in the agenda display.
518This causes some overhead during agenda construction, but if you have turned 583This causes some overhead during agenda construction, but if you
519on `org-enforce-todo-dependencies' or any other blocking mechanism, this 584have turned on `org-enforce-todo-dependencies',
520will create useful feedback in the agenda. 585`org-enforce-todo-checkbox-dependencies', or any other blocking
521Instead ot t, this variable can also have the value `invisible'. Then 586mechanism, this will create useful feedback in the agenda.
522blocked tasks will be invisible and only become visible when they 587
523become unblocked." 588Instead ot t, this variable can also have the value `invisible'.
589Then blocked tasks will be invisible and only become visible when
590they become unblocked. An exemption to this behavior is when a task is
591blocked because of unchecked checkboxes below it. Since checkboxes do
592not show up in the agenda views, making this task invisible you remove any
593trace from agenda views that there is something to do. Therefore, a task
594that is blocked because of checkboxes will never be made invisible, it
595will only be dimmed."
524 :group 'org-agenda-daily/weekly 596 :group 'org-agenda-daily/weekly
525 :group 'org-agenda-todo-list 597 :group 'org-agenda-todo-list
526 :type '(choice 598 :type '(choice
@@ -538,7 +610,7 @@ N days, just insert a special line indicating the size of the gap."
538 :type '(choice 610 :type '(choice
539 (const :tag "None" nil) 611 (const :tag "None" nil)
540 (const :tag "All" t) 612 (const :tag "All" t)
541 (number :tag "at most"))) 613 (integer :tag "at most")))
542 614
543(defgroup org-agenda-startup nil 615(defgroup org-agenda-startup nil
544 "Options concerning initial settings in the Agenda in Org Mode." 616 "Options concerning initial settings in the Agenda in Org Mode."
@@ -606,17 +678,19 @@ option will be ignored.."
606 678
607(defcustom org-agenda-ndays 7 679(defcustom org-agenda-ndays 7
608 "Number of days to include in overview display. 680 "Number of days to include in overview display.
609Should be 1 or 7." 681Should be 1 or 7.
682Custom commands can set this variable in the options section."
610 :group 'org-agenda-daily/weekly 683 :group 'org-agenda-daily/weekly
611 :type 'number) 684 :type 'integer)
612 685
613(defcustom org-agenda-start-on-weekday 1 686(defcustom org-agenda-start-on-weekday 1
614 "Non-nil means, start the overview always on the specified weekday. 687 "Non-nil means, start the overview always on the specified weekday.
6150 denotes Sunday, 1 denotes Monday etc. 6880 denotes Sunday, 1 denotes Monday etc.
616When nil, always start on the current day." 689When nil, always start on the current day.
690Custom commands can set this variable in the options section."
617 :group 'org-agenda-daily/weekly 691 :group 'org-agenda-daily/weekly
618 :type '(choice (const :tag "Today" nil) 692 :type '(choice (const :tag "Today" nil)
619 (number :tag "Weekday No."))) 693 (integer :tag "Weekday No.")))
620 694
621(defcustom org-agenda-show-all-dates t 695(defcustom org-agenda-show-all-dates t
622 "Non-nil means, `org-agenda' shows every day in the selected range. 696 "Non-nil means, `org-agenda' shows every day in the selected range.
@@ -673,7 +747,8 @@ and timeline buffers."
673 (const :tag "Sunday" 0))) 747 (const :tag "Sunday" 0)))
674 748
675(defcustom org-agenda-include-diary nil 749(defcustom org-agenda-include-diary nil
676 "If non-nil, include in the agenda entries from the Emacs Calendar's diary." 750 "If non-nil, include in the agenda entries from the Emacs Calendar's diary.
751Custom commands can set this variable in the options section."
677 :group 'org-agenda-daily/weekly 752 :group 'org-agenda-daily/weekly
678 :type 'boolean) 753 :type 'boolean)
679 754
@@ -698,7 +773,7 @@ When an item is scheduled on a date, it shows up in the agenda on this
698day and will be listed until it is marked done for the number of days 773day and will be listed until it is marked done for the number of days
699given here." 774given here."
700 :group 'org-agenda-daily/weekly 775 :group 'org-agenda-daily/weekly
701 :type 'number) 776 :type 'integer)
702 777
703(defcustom org-agenda-log-mode-items '(closed clock) 778(defcustom org-agenda-log-mode-items '(closed clock)
704 "List of items that should be shown in agenda log mode. 779 "List of items that should be shown in agenda log mode.
@@ -706,10 +781,26 @@ This list may contain the following symbols:
706 781
707 closed Show entries that have been closed on that day. 782 closed Show entries that have been closed on that day.
708 clock Show entries that have received clocked time on that day. 783 clock Show entries that have received clocked time on that day.
709 state Show all logged state changes." 784 state Show all logged state changes.
785Note that instead of changing this variable, you can also press `C-u l' in
786the agenda to display all available LOG items temporarily."
710 :group 'org-agenda-daily/weekly 787 :group 'org-agenda-daily/weekly
711 :type '(set :greedy t (const closed) (const clock) (const state))) 788 :type '(set :greedy t (const closed) (const clock) (const state)))
712 789
790(defcustom org-agenda-log-mode-add-notes t
791 "Non-nil means, add first line of notes to log entries in agenda views.
792If a log item like a state change or a clock entry is associated with
793notes, the first line of these notes will be added to the entry in the
794agenda display."
795 :group 'org-agenda-daily/weekly
796 :type 'boolean)
797
798(defcustom org-agenda-start-with-log-mode nil
799 "The initial value of log-mode in a newly created agenda window."
800 :group 'org-agenda-startup
801 :group 'org-agenda-daily/weekly
802 :type 'boolean)
803
713(defcustom org-agenda-start-with-clockreport-mode nil 804(defcustom org-agenda-start-with-clockreport-mode nil
714 "The initial value of clockreport-mode in a newly created agenda window." 805 "The initial value of clockreport-mode in a newly created agenda window."
715 :group 'org-agenda-startup 806 :group 'org-agenda-startup
@@ -733,6 +824,17 @@ current display in the agenda."
733 :tag "Org Agenda Time Grid" 824 :tag "Org Agenda Time Grid"
734 :group 'org-agenda) 825 :group 'org-agenda)
735 826
827(defcustom org-agenda-search-headline-for-time t
828 "Non-nil means, search headline for a time-of-day.
829If the headline contains a time-of-day in one format or another, it will
830be used to sort the entry into the time sequence of items for a day.
831Some people have time stamps in the headline that refer to the creation
832time or so, and then this produces an unwanted side effect. If this is
833the case for your, use this variable to turn off searching the headline
834for a time."
835 :group 'org-agenda-time-grid
836 :type 'boolean)
837
736(defcustom org-agenda-use-time-grid t 838(defcustom org-agenda-use-time-grid t
737 "Non-nil means, show a time grid in the agenda schedule. 839 "Non-nil means, show a time grid in the agenda schedule.
738A time grid is a set of lines for specific times (like every two hours between 840A 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
790if an entry should be listed before another entry. The following 892if an entry should be listed before another entry. The following
791symbols are recognized: 893symbols are recognized:
792 894
793time-up Put entries with time-of-day indications first, early first 895time-up Put entries with time-of-day indications first, early first
794time-down Put entries with time-of-day indications first, late first 896time-down Put entries with time-of-day indications first, late first
795category-keep Keep the default order of categories, corresponding to the 897category-keep Keep the default order of categories, corresponding to the
796 sequence in `org-agenda-files'. 898 sequence in `org-agenda-files'.
797category-up Sort alphabetically by category, A-Z. 899category-up Sort alphabetically by category, A-Z.
798category-down Sort alphabetically by category, Z-A. 900category-down Sort alphabetically by category, Z-A.
799tag-up Sort alphabetically by last tag, A-Z. 901tag-up Sort alphabetically by last tag, A-Z.
800tag-down Sort alphabetically by last tag, Z-A. 902tag-down Sort alphabetically by last tag, Z-A.
801priority-up Sort numerically by priority, high priority last. 903priority-up Sort numerically by priority, high priority last.
802priority-down Sort numerically by priority, high priority first. 904priority-down Sort numerically by priority, high priority first.
803todo-state-up Sort by todo state, tasks that are done last. 905todo-state-up Sort by todo state, tasks that are done last.
804todo-state-down Sort by todo state, tasks that are done first. 906todo-state-down Sort by todo state, tasks that are done first.
805effort-up Sort numerically by estimated effort, high effort last. 907effort-up Sort numerically by estimated effort, high effort last.
806effort-down Sort numerically by estimated effort, high effort first. 908effort-down Sort numerically by estimated effort, high effort first.
909user-defined-up Sort according to `org-agenda-cmp-user-defined', high last.
910user-defined-down Sort according to `org-agenda-cmp-user-defined', high first.
807 911
808The different possibilities will be tried in sequence, and testing stops 912The different possibilities will be tried in sequence, and testing stops
809if one comparison returns a \"not-equal\". For example, the default 913if one comparison returns a \"not-equal\". For example, the default
@@ -820,7 +924,9 @@ categories by priority.
820 924
821Instead of a single list, this can also be a set of list for specific 925Instead of a single list, this can also be a set of list for specific
822contents, with a context symbol in the car of the list, any of 926contents, with a context symbol in the car of the list, any of
823`agenda', `todo', `tags' for the corresponding agenda views." 927`agenda', `todo', `tags' for the corresponding agenda views.
928
929Custom commands can bind this variable in the options section."
824 :group 'org-agenda-sorting 930 :group 'org-agenda-sorting
825 :type `(choice 931 :type `(choice
826 (repeat :tag "General" ,org-sorting-choice) 932 (repeat :tag "General" ,org-sorting-choice)
@@ -832,6 +938,16 @@ contents, with a context symbol in the car of the list, any of
832 (cons (const :tag "Strategy for Tags matches" tags) 938 (cons (const :tag "Strategy for Tags matches" tags)
833 (repeat ,org-sorting-choice))))) 939 (repeat ,org-sorting-choice)))))
834 940
941(defcustom org-agenda-cmp-user-defined nil
942 "A function to define the comparison `user-defined'.
943This function must receive two arguments, agenda entry a and b.
944If a>b, return +1. If a<b, return -1. If they are equal as seen by
945the user comparison, return nil.
946When this is defined, you can make `user-defined-up' and `user-defined-down'
947part of an agenda sorting strategy."
948 :group 'org-agenda-sorting
949 :type 'symbol)
950
835(defcustom org-sort-agenda-notime-is-late t 951(defcustom org-sort-agenda-notime-is-late t
836 "Non-nil means, items without time are considered late. 952 "Non-nil means, items without time are considered late.
837This is only relevant for sorting. When t, items which have no explicit 953This is only relevant for sorting. When t, items which have no explicit
@@ -844,6 +960,9 @@ agenda entries."
844 960
845(defcustom org-sort-agenda-noeffort-is-high t 961(defcustom org-sort-agenda-noeffort-is-high t
846 "Non-nil means, items without effort estimate are sorted as high effort. 962 "Non-nil means, items without effort estimate are sorted as high effort.
963This also applies when filtering an agenda view with respect to the
964< or > effort operator. Then, tasks with no effort defined will be treated
965as tasks with high effort.
847When nil, such items are sorted as 0 minutes effort." 966When nil, such items are sorted as 0 minutes effort."
848 :group 'org-agenda-sorting 967 :group 'org-agenda-sorting
849 :type 'boolean) 968 :type 'boolean)
@@ -906,7 +1025,9 @@ the prefix, you could use:
906 (setq org-agenda-prefix-format \" %-11:c% s\") 1025 (setq org-agenda-prefix-format \" %-11:c% s\")
907 1026
908See also the variables `org-agenda-remove-times-when-in-prefix' and 1027See also the variables `org-agenda-remove-times-when-in-prefix' and
909`org-agenda-remove-tags'." 1028`org-agenda-remove-tags'.
1029
1030Custom commands can set this variable in the options section."
910 :type '(choice 1031 :type '(choice
911 (string :tag "General format") 1032 (string :tag "General format")
912 (list :greedy t :tag "View dependent" 1033 (list :greedy t :tag "View dependent"
@@ -1025,18 +1146,22 @@ it means that the tags should be flushright to that column. For example,
1025(if (fboundp 'defvaralias) 1146(if (fboundp 'defvaralias)
1026 (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) 1147 (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column))
1027 1148
1028(defcustom org-agenda-fontify-priorities t 1149(defcustom org-agenda-fontify-priorities 'cookies
1029 "Non-nil means, highlight low and high priorities in agenda. 1150 "Non-nil means, highlight low and high priorities in agenda.
1030When t, the highest priority entries are bold, lowest priority italic. 1151When t, the highest priority entries are bold, lowest priority italic.
1152However, settings in org-priority-faces will overrule these faces.
1153When this variable is the symbol `cookies', only fontify the
1154cookies, not the entire task.
1031This may also be an association list of priority faces, whose 1155This may also be an association list of priority faces, whose
1032keys are the character values of `org-highest-priority', 1156keys are the character values of `org-highest-priority',
1033`org-default-priority', and `org-lowest-priority' (the default values 1157`org-default-priority', and `org-lowest-priority' (the default values
1034are ?A, ?B, and ?C, respectively). The face may be a names face, 1158are ?A, ?B, and ?C, respectively). The face may be a named face,
1035or a list like `(:background \"Red\")'." 1159or a list like `(:background \"Red\")'."
1036 :group 'org-agenda-line-format 1160 :group 'org-agenda-line-format
1037 :type '(choice 1161 :type '(choice
1038 (const :tag "Never" nil) 1162 (const :tag "Never" nil)
1039 (const :tag "Defaults" t) 1163 (const :tag "Defaults" t)
1164 (const :tag "Cookies only" cookies)
1040 (repeat :tag "Specify" 1165 (repeat :tag "Specify"
1041 (list (character :tag "Priority" :value ?A) 1166 (list (character :tag "Priority" :value ?A)
1042 (sexp :tag "face"))))) 1167 (sexp :tag "face")))))
@@ -1101,6 +1226,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
1101 "Keymap for `org-agenda-mode'.") 1226 "Keymap for `org-agenda-mode'.")
1102 1227
1103(defvar org-agenda-menu) ; defined later in this file. 1228(defvar org-agenda-menu) ; defined later in this file.
1229(defvar org-agenda-restrict) ; defined later in this file.
1104(defvar org-agenda-follow-mode nil) 1230(defvar org-agenda-follow-mode nil)
1105(defvar org-agenda-clockreport-mode nil) 1231(defvar org-agenda-clockreport-mode nil)
1106(defvar org-agenda-show-log nil) 1232(defvar org-agenda-show-log nil)
@@ -1110,6 +1236,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
1110 "Hook for org-agenda-mode, run after the mode is turned on.") 1236 "Hook for org-agenda-mode, run after the mode is turned on.")
1111(defvar org-agenda-type nil) 1237(defvar org-agenda-type nil)
1112(defvar org-agenda-force-single-file nil) 1238(defvar org-agenda-force-single-file nil)
1239(defvar org-agenda-bulk-marked-entries) ;; Defined further down in this file
1113 1240
1114(defun org-agenda-mode () 1241(defun org-agenda-mode ()
1115 "Mode for time-sorted view on action items in Org-mode files. 1242 "Mode for time-sorted view on action items in Org-mode files.
@@ -1120,7 +1247,8 @@ The following commands are available:
1120 (interactive) 1247 (interactive)
1121 (kill-all-local-variables) 1248 (kill-all-local-variables)
1122 (setq org-agenda-undo-list nil 1249 (setq org-agenda-undo-list nil
1123 org-agenda-pending-undo-list nil) 1250 org-agenda-pending-undo-list nil
1251 org-agenda-bulk-marked-entries nil)
1124 (setq major-mode 'org-agenda-mode) 1252 (setq major-mode 'org-agenda-mode)
1125 ;; Keep global-font-lock-mode from turning on font-lock-mode 1253 ;; Keep global-font-lock-mode from turning on font-lock-mode
1126 (org-set-local 'font-lock-global-modes (list 'not major-mode)) 1254 (org-set-local 'font-lock-global-modes (list 'not major-mode))
@@ -1139,7 +1267,8 @@ The following commands are available:
1139 (unless org-agenda-keep-modes 1267 (unless org-agenda-keep-modes
1140 (setq org-agenda-follow-mode org-agenda-start-with-follow-mode 1268 (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
1141 org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode 1269 org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode
1142 org-agenda-show-log nil)) 1270 org-agenda-show-log org-agenda-start-with-log-mode))
1271
1143 (easy-menu-change 1272 (easy-menu-change
1144 '("Agenda") "Agenda Files" 1273 '("Agenda") "Agenda Files"
1145 (append 1274 (append
@@ -1165,6 +1294,12 @@ The following commands are available:
1165(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) 1294(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill)
1166(org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive) 1295(org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive)
1167(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) 1296(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive)
1297(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile)
1298(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark)
1299(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark)
1300(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-remove-all-marks)
1301(org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action)
1302(org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload)
1168(org-defkey org-agenda-mode-map "$" 'org-agenda-archive) 1303(org-defkey org-agenda-mode-map "$" 'org-agenda-archive)
1169(org-defkey org-agenda-mode-map "A" 'org-agenda-archive-to-archive-sibling) 1304(org-defkey org-agenda-mode-map "A" 'org-agenda-archive-to-archive-sibling)
1170(org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link) 1305(org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link)
@@ -1184,16 +1319,15 @@ The following commands are available:
1184(org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date) 1319(org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date)
1185(org-defkey org-agenda-mode-map "d" 'org-agenda-day-view) 1320(org-defkey org-agenda-mode-map "d" 'org-agenda-day-view)
1186(org-defkey org-agenda-mode-map "w" 'org-agenda-week-view) 1321(org-defkey org-agenda-mode-map "w" 'org-agenda-week-view)
1187(org-defkey org-agenda-mode-map "m" 'org-agenda-month-view)
1188(org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) 1322(org-defkey org-agenda-mode-map "y" 'org-agenda-year-view)
1189(org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note) 1323(org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note)
1190(org-defkey org-agenda-mode-map "z" 'org-agenda-add-note) 1324(org-defkey org-agenda-mode-map "z" 'org-agenda-add-note)
1191(org-defkey org-agenda-mode-map "k" 'org-agenda-action) 1325(org-defkey org-agenda-mode-map "k" 'org-agenda-action)
1192(org-defkey org-agenda-mode-map "\C-c\C-x\C-k" 'org-agenda-action) 1326(org-defkey org-agenda-mode-map "\C-c\C-x\C-k" 'org-agenda-action)
1193(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-date-later) 1327(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later)
1194(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier) 1328(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier)
1195(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-date-later) 1329(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later)
1196(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier) 1330(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier)
1197 1331
1198(org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt) 1332(org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt)
1199(org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) 1333(org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
@@ -1205,7 +1339,7 @@ The following commands are available:
1205(org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) 1339(org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode)
1206(org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode) 1340(org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode)
1207(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) 1341(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode)
1208(org-defkey org-agenda-mode-map "v" 'org-agenda-archives-mode) 1342(org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch)
1209(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) 1343(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary)
1210(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) 1344(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
1211(org-defkey org-agenda-mode-map "r" 'org-agenda-redo) 1345(org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
@@ -1214,8 +1348,8 @@ The following commands are available:
1214(org-defkey org-agenda-mode-map "q" 'org-agenda-quit) 1348(org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
1215(org-defkey org-agenda-mode-map "x" 'org-agenda-exit) 1349(org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
1216(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) 1350(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda)
1217(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
1218(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) 1351(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
1352(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
1219(org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority) 1353(org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority)
1220(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags) 1354(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
1221(org-defkey org-agenda-mode-map "n" 'next-line) 1355(org-defkey org-agenda-mode-map "n" 'next-line)
@@ -1249,6 +1383,7 @@ The following commands are available:
1249(org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) 1383(org-defkey org-agenda-mode-map [(right)] 'org-agenda-later)
1250(org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) 1384(org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier)
1251(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) 1385(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
1386(org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
1252 1387
1253(org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add) 1388(org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add)
1254(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract) 1389(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract)
@@ -1256,6 +1391,7 @@ The following commands are available:
1256(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re) 1391(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
1257(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag) 1392(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
1258(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) 1393(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
1394(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
1259 1395
1260(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) 1396(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
1261 "Local keymap for agenda entries from Org-mode.") 1397 "Local keymap for agenda entries from Org-mode.")
@@ -1278,11 +1414,17 @@ The following commands are available:
1278 ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] 1414 ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
1279 "--" 1415 "--"
1280 ["Cycle TODO" org-agenda-todo t] 1416 ["Cycle TODO" org-agenda-todo t]
1281 ("Archive" 1417 ("Archive and Refile"
1282 ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t] 1418 ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t]
1283 ["Move to archive sibling" org-agenda-archive-to-archive-sibling t] 1419 ["Move to archive sibling" org-agenda-archive-to-archive-sibling t]
1284 ["Archive subtree" org-agenda-archive t]) 1420 ["Archive subtree" org-agenda-archive t]
1421 ["Refile" org-agenda-refile t])
1285 ["Delete subtree" org-agenda-kill t] 1422 ["Delete subtree" org-agenda-kill t]
1423 ("Bulk action"
1424 ["Toggle mark entry" org-agenda-bulk-mark t]
1425 ["Act on all marked" org-agenda-bulk-action t]
1426 ["Unmark all entries" org-agenda-bulk-remove-all-marks :active t :keys "C-u s"])
1427 "--"
1286 ["Add note" org-agenda-add-note t] 1428 ["Add note" org-agenda-add-note t]
1287 "--" 1429 "--"
1288 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)] 1430 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)]
@@ -1307,6 +1449,10 @@ The following commands are available:
1307 "--" 1449 "--"
1308 ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] 1450 ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
1309 ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] 1451 ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
1452 ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"]
1453 ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"]
1454 ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"]
1455 ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"]
1310 ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) 1456 ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])
1311 ("Clock" 1457 ("Clock"
1312 ["Clock in" org-agenda-clock-in t] 1458 ["Clock in" org-agenda-clock-in t]
@@ -1329,14 +1475,22 @@ The following commands are available:
1329 ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]) 1475 ["Create iCalendar file" org-export-icalendar-combine-agenda-files t])
1330 "--" 1476 "--"
1331 ("View" 1477 ("View"
1332 ["Day View" org-agenda-day-view :active (org-agenda-check-type nil 'agenda) 1478 ["Day View" org-agenda-day-view
1333 :style radio :selected (equal org-agenda-ndays 1)] 1479 :active (org-agenda-check-type nil 'agenda)
1334 ["Week View" org-agenda-week-view :active (org-agenda-check-type nil 'agenda) 1480 :style radio :selected (equal org-agenda-ndays 1)
1335 :style radio :selected (equal org-agenda-ndays 7)] 1481 :keys "v d (or just d)"]
1336 ["Month View" org-agenda-month-view :active (org-agenda-check-type nil 'agenda) 1482 ["Week View" org-agenda-week-view
1337 :style radio :selected (member org-agenda-ndays '(28 29 30 31))] 1483 :active (org-agenda-check-type nil 'agenda)
1338 ["Year View" org-agenda-year-view :active (org-agenda-check-type nil 'agenda) 1484 :style radio :selected (equal org-agenda-ndays 7)
1339 :style radio :selected (member org-agenda-ndays '(365 366))] 1485 :keys "v w (or just w)"]
1486 ["Month View" org-agenda-month-view
1487 :active (org-agenda-check-type nil 'agenda)
1488 :style radio :selected (member org-agenda-ndays '(28 29 30 31))
1489 :keys "v m"]
1490 ["Year View" org-agenda-year-view
1491 :active (org-agenda-check-type nil 'agenda)
1492 :style radio :selected (member org-agenda-ndays '(365 366))
1493 :keys "v y"]
1340 "--" 1494 "--"
1341 ["Include Diary" org-agenda-toggle-diary 1495 ["Include Diary" org-agenda-toggle-diary
1342 :style toggle :selected org-agenda-include-diary 1496 :style toggle :selected org-agenda-include-diary
@@ -1351,12 +1505,16 @@ The following commands are available:
1351 "--" 1505 "--"
1352 ["Show Logbook entries" org-agenda-log-mode 1506 ["Show Logbook entries" org-agenda-log-mode
1353 :style toggle :selected org-agenda-show-log 1507 :style toggle :selected org-agenda-show-log
1354 :active (org-agenda-check-type nil 'agenda 'timeline)] 1508 :active (org-agenda-check-type nil 'agenda 'timeline)
1509 :keys "v l (or just l)"]
1355 ["Include archived trees" org-agenda-archives-mode 1510 ["Include archived trees" org-agenda-archives-mode
1356 :style toggle :selected org-agenda-archives-mode :active t] 1511 :style toggle :selected org-agenda-archives-mode :active t
1512 :keys "v a"]
1357 ["Include archive files" (org-agenda-archives-mode t) 1513 ["Include archive files" (org-agenda-archives-mode t)
1358 :style toggle :selected (eq org-agenda-archives-mode t) :active t 1514 :style toggle :selected (eq org-agenda-archives-mode t) :active t
1359 :keys "C-u v"]) 1515 :keys "v A"]
1516 "--"
1517 ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
1360 ["Write view to file" org-write-agenda t] 1518 ["Write view to file" org-write-agenda t]
1361 ["Rebuild buffer" org-agenda-redo t] 1519 ["Rebuild buffer" org-agenda-redo t]
1362 ["Save all Org-mode Buffers" org-save-all-org-buffers t] 1520 ["Save all Org-mode Buffers" org-save-all-org-buffers t]
@@ -1428,7 +1586,7 @@ that have been changed along."
1428(defvar org-agenda-overriding-restriction nil) 1586(defvar org-agenda-overriding-restriction nil)
1429 1587
1430;;;###autoload 1588;;;###autoload
1431(defun org-agenda (arg &optional keys restriction) 1589(defun org-agenda (&optional arg keys restriction)
1432 "Dispatch agenda commands to collect entries to the agenda buffer. 1590 "Dispatch agenda commands to collect entries to the agenda buffer.
1433Prompts for a command to execute. Any prefix arg will be passed 1591Prompts for a command to execute. Any prefix arg will be passed
1434on to the selected command. The default selections are: 1592on to the selected command. The default selections are:
@@ -1442,6 +1600,15 @@ m Call `org-tags-view' to display headlines with tags matching
1442M Like `m', but select only TODO entries, no ordinary headlines. 1600M Like `m', but select only TODO entries, no ordinary headlines.
1443L Create a timeline for the current buffer. 1601L Create a timeline for the current buffer.
1444e Export views to associated files. 1602e Export views to associated files.
1603s Search entries for keywords.
1604/ Multi occur accros all agenda files and also files listed
1605 in `org-agenda-text-search-extra-files'.
1606< Restrict agenda commands to buffer, subtree, or region.
1607 Press several times to get the desired effect.
1608> Remove a previous restriction.
1609# List \"stuck\" projects.
1610! Configure what \"stuck\" means.
1611C Configure custom agenda commands.
1445 1612
1446More commands can be added by configuring the variable 1613More commands can be added by configuring the variable
1447`org-agenda-custom-commands'. In particular, specific tags and TODO keyword 1614`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
1527 (org-let lprops '(org-todo-list match))) 1694 (org-let lprops '(org-todo-list match)))
1528 ((eq type 'tags-tree) 1695 ((eq type 'tags-tree)
1529 (org-check-for-org-mode) 1696 (org-check-for-org-mode)
1530 (org-let lprops '(org-tags-sparse-tree current-prefix-arg match))) 1697 (org-let lprops '(org-match-sparse-tree current-prefix-arg match)))
1531 ((eq type 'todo-tree) 1698 ((eq type 'todo-tree)
1532 (org-check-for-org-mode) 1699 (org-check-for-org-mode)
1533 (org-let lprops 1700 (org-let lprops
@@ -1724,7 +1891,7 @@ s Search for keywords C Configure custom agenda commands
1724 (t (error "Invalid key %c" c)))))))) 1891 (t (error "Invalid key %c" c))))))))
1725 1892
1726(defun org-run-agenda-series (name series) 1893(defun org-run-agenda-series (name series)
1727 (org-prepare-agenda name) 1894 (org-let (nth 1 series) '(org-prepare-agenda name))
1728 (let* ((org-agenda-multi t) 1895 (let* ((org-agenda-multi t)
1729 (redo (list 'org-run-agenda-series name (list 'quote series))) 1896 (redo (list 'org-run-agenda-series name (list 'quote series)))
1730 (cmds (car series)) 1897 (cmds (car series))
@@ -1762,6 +1929,7 @@ s Search for keywords C Configure custom agenda commands
1762 (widen) 1929 (widen)
1763 (setq org-agenda-redo-command redo) 1930 (setq org-agenda-redo-command redo)
1764 (goto-char (point-min))) 1931 (goto-char (point-min)))
1932 (org-fit-agenda-window)
1765 (org-let (nth 1 series) '(org-finalize-agenda))) 1933 (org-let (nth 1 series) '(org-finalize-agenda)))
1766 1934
1767;;;###autoload 1935;;;###autoload
@@ -1923,22 +2091,23 @@ so the export commands can easily use it."
1923 (while files 2091 (while files
1924 (eval (list 'let (append org-agenda-exporter-settings opts pars) 2092 (eval (list 'let (append org-agenda-exporter-settings opts pars)
1925 (list 'org-write-agenda 2093 (list 'org-write-agenda
1926 (expand-file-name (pop files) dir) t)))) 2094 (expand-file-name (pop files) dir) nil t))))
1927 (and (get-buffer org-agenda-buffer-name) 2095 (and (get-buffer org-agenda-buffer-name)
1928 (kill-buffer org-agenda-buffer-name))))))) 2096 (kill-buffer org-agenda-buffer-name)))))))
1929 2097
1930(defun org-write-agenda (file &optional nosettings) 2098(defun org-write-agenda (file &optional open nosettings)
1931 "Write the current buffer (an agenda view) as a file. 2099 "Write the current buffer (an agenda view) as a file.
1932Depending on the extension of the file name, plain text (.txt), 2100Depending on the extension of the file name, plain text (.txt),
1933HTML (.html or .htm) or Postscript (.ps) is produced. 2101HTML (.html or .htm) or Postscript (.ps) is produced.
1934If the extension is .ics, run icalendar export over all files used 2102If the extension is .ics, run icalendar export over all files used
1935to construct the agenda and limit the export to entries listed in the 2103to construct the agenda and limit the export to entries listed in the
1936agenda now. 2104agenda now.
2105With prefic argument OPEN, open the new file immediately.
1937If NOSETTINGS is given, do not scope the settings of 2106If NOSETTINGS is given, do not scope the settings of
1938`org-agenda-exporter-settings' into the export commands. This is used when 2107`org-agenda-exporter-settings' into the export commands. This is used when
1939the settings have already been scoped and we do not wish to overrule other, 2108the settings have already been scoped and we do not wish to overrule other,
1940higher priority settings." 2109higher priority settings."
1941 (interactive "FWrite agenda to file: ") 2110 (interactive "FWrite agenda to file: \nP")
1942 (if (not (file-writable-p file)) 2111 (if (not (file-writable-p file))
1943 (error "Cannot write agenda to file %s" file)) 2112 (error "Cannot write agenda to file %s" file))
1944 (cond 2113 (cond
@@ -1958,6 +2127,7 @@ higher priority settings."
1958 (delete-region 2127 (delete-region
1959 beg (or (next-single-property-change beg 'org-filtered) 2128 beg (or (next-single-property-change beg 'org-filtered)
1960 (point-max)))) 2129 (point-max))))
2130 (run-hooks 'org-agenda-before-write-hook)
1961 (cond 2131 (cond
1962 ((string-match "\\.html?\\'" file) 2132 ((string-match "\\.html?\\'" file)
1963 (set-buffer (htmlize-buffer (current-buffer))) 2133 (set-buffer (htmlize-buffer (current-buffer)))
@@ -1973,9 +2143,22 @@ higher priority settings."
1973 (kill-buffer (current-buffer)) 2143 (kill-buffer (current-buffer))
1974 (message "HTML written to %s" file)) 2144 (message "HTML written to %s" file))
1975 ((string-match "\\.ps\\'" file) 2145 ((string-match "\\.ps\\'" file)
1976 (ps-print-buffer-with-faces file) 2146 (require 'ps-print)
2147 (flet ((ps-get-buffer-name () "Agenda View"))
2148 (ps-print-buffer-with-faces file))
1977 (message "Postscript written to %s" file)) 2149 (message "Postscript written to %s" file))
2150 ((string-match "\\.pdf\\'" file)
2151 (require 'ps-print)
2152 (flet ((ps-get-buffer-name () "Agenda View"))
2153 (ps-print-buffer-with-faces
2154 (concat (file-name-sans-extension file) ".ps")))
2155 (call-process "ps2pdf" nil nil nil
2156 (expand-file-name
2157 (concat (file-name-sans-extension file) ".ps"))
2158 (expand-file-name file))
2159 (message "PDF written to %s" file))
1978 ((string-match "\\.ics\\'" file) 2160 ((string-match "\\.ics\\'" file)
2161 (require 'org-icalendar)
1979 (let ((org-agenda-marker-table 2162 (let ((org-agenda-marker-table
1980 (org-create-marker-find-array 2163 (org-create-marker-find-array
1981 (org-agenda-collect-markers))) 2164 (org-agenda-collect-markers)))
@@ -1991,7 +2174,9 @@ higher priority settings."
1991 (save-buffer 0) 2174 (save-buffer 0)
1992 (kill-buffer (current-buffer)) 2175 (kill-buffer (current-buffer))
1993 (message "Plain text written to %s" file)))))))) 2176 (message "Plain text written to %s" file))))))))
1994 (set-buffer org-agenda-buffer-name))) 2177 (set-buffer org-agenda-buffer-name))
2178 (when open (org-open-file file)))
2179
1995(defvar org-agenda-filter-overlays nil) 2180(defvar org-agenda-filter-overlays nil)
1996 2181
1997(defun org-agenda-mark-filtered-text () 2182(defun org-agenda-mark-filtered-text ()
@@ -2021,6 +2206,84 @@ VALUE defaults to t."
2021 beg (or (next-single-property-change beg 'org-filtered) 2206 beg (or (next-single-property-change beg 'org-filtered)
2022 (point-max)))))) 2207 (point-max))))))
2023 2208
2209(defun org-agenda-add-entry-text ()
2210 "Add entry text to agenda lines.
2211This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
2212entry text following headings shown in the agenda.
2213Drawers will be excluded, also the line with scheduling/deadline info."
2214 (when (> org-agenda-add-entry-text-maxlines 0)
2215 (let (m txt drawer-re kwd-time-re ind)
2216 (goto-char (point-min))
2217 (while (not (eobp))
2218 (if (not (setq m (get-text-property (point) 'org-hd-marker)))
2219 (beginning-of-line 2)
2220 (save-excursion
2221 (with-current-buffer (marker-buffer m)
2222 (if (not (org-mode-p))
2223 (setq txt "")
2224 (save-excursion
2225 (save-restriction
2226 (widen)
2227 (goto-char m)
2228 (beginning-of-line 2)
2229 (setq txt (buffer-substring
2230 (point)
2231 (progn (outline-next-heading) (point)))
2232 drawer-re org-drawer-regexp
2233 kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
2234 ".*\n?"))
2235 (with-temp-buffer
2236 (insert txt)
2237 (when org-agenda-add-entry-text-descriptive-links
2238 (goto-char (point-min))
2239 (while (org-activate-bracket-links (point-max))
2240 (add-text-properties (match-beginning 0) (match-end 0)
2241 '(face org-link))))
2242 (goto-char (point-min))
2243 (while (re-search-forward org-bracket-link-regexp (point-max) t)
2244 (set-text-properties (match-beginning 0) (match-end 0)
2245 nil))
2246 (goto-char (point-min))
2247 (while (re-search-forward drawer-re nil t)
2248 (delete-region
2249 (match-beginning 0)
2250 (progn (re-search-forward
2251 "^[ \t]*:END:.*\n?" nil 'move)
2252 (point))))
2253 (goto-char (point-min))
2254 (while (re-search-forward kwd-time-re nil t)
2255 (replace-match ""))
2256 (if (re-search-forward "[ \t\n]+\\'" nil t)
2257 (replace-match ""))
2258 (goto-char (point-min))
2259 ;; find min indentation
2260 (goto-char (point-min))
2261 (untabify (point-min) (point-max))
2262 (setq ind (org-get-indentation))
2263 (while (not (eobp))
2264 (unless (looking-at "[ \t]*$")
2265 (setq ind (min ind (org-get-indentation))))
2266 (beginning-of-line 2))
2267 (goto-char (point-min))
2268 (while (not (eobp))
2269 (unless (looking-at "[ \t]*$")
2270 (move-to-column ind)
2271 (delete-region (point-at-bol) (point)))
2272 (beginning-of-line 2))
2273 (goto-char (point-min))
2274 (while (and (not (eobp)) (re-search-forward "^" nil t))
2275 (replace-match " > "))
2276 (goto-char (point-min))
2277 (while (looking-at "[ \t]*\n") (replace-match ""))
2278 (goto-char (point-max))
2279 (when (> (org-current-line)
2280 (1+ org-agenda-add-entry-text-maxlines))
2281 (goto-line (1+ org-agenda-add-entry-text-maxlines))
2282 (backward-char 1))
2283 (setq txt (buffer-substring (point-min) (point)))))))))
2284 (end-of-line 1)
2285 (if (string-match "\\S-" txt) (insert "\n" txt)))))))
2286
2024(defun org-agenda-collect-markers () 2287(defun org-agenda-collect-markers ()
2025 "Collect the markers pointing to entries in the agenda buffer." 2288 "Collect the markers pointing to entries in the agenda buffer."
2026 (let (m markers) 2289 (let (m markers)
@@ -2081,10 +2344,18 @@ VALUE defaults to t."
2081(defvar org-agenda-columns-active nil) 2344(defvar org-agenda-columns-active nil)
2082(defvar org-agenda-name nil) 2345(defvar org-agenda-name nil)
2083(defvar org-agenda-filter nil) 2346(defvar org-agenda-filter nil)
2347(defvar org-agenda-filter-preset nil
2348 "A preset of the tags filter used for secondary agenda filtering.
2349This must be a list of strings, each string must be a single tag preceeded
2350by \"+\" or \"-\".
2351This variable should not be set directly, but agenda custom commands can
2352bind it in the options section.")
2353
2084(defun org-prepare-agenda (&optional name) 2354(defun org-prepare-agenda (&optional name)
2085 (setq org-todo-keywords-for-agenda nil) 2355 (setq org-todo-keywords-for-agenda nil)
2086 (setq org-done-keywords-for-agenda nil) 2356 (setq org-done-keywords-for-agenda nil)
2087 (setq org-agenda-filter nil) 2357 (setq org-agenda-filter nil)
2358 (put 'org-agenda-filter :preset-filter org-agenda-filter-preset)
2088 (if org-agenda-multi 2359 (if org-agenda-multi
2089 (progn 2360 (progn
2090 (setq buffer-read-only nil) 2361 (setq buffer-read-only nil)
@@ -2146,14 +2417,16 @@ VALUE defaults to t."
2146 org-agenda-view-columns-initially) 2417 org-agenda-view-columns-initially)
2147 (org-agenda-columns)) 2418 (org-agenda-columns))
2148 (when org-agenda-fontify-priorities 2419 (when org-agenda-fontify-priorities
2149 (org-fontify-priorities)) 2420 (org-agenda-fontify-priorities))
2150 (when (and org-agenda-dim-blocked-tasks org-blocker-hook) 2421 (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
2151 (org-agenda-dim-blocked-tasks)) 2422 (org-agenda-dim-blocked-tasks))
2152 (run-hooks 'org-finalize-agenda-hook) 2423 (run-hooks 'org-finalize-agenda-hook)
2153 (setq org-agenda-type (get-text-property (point) 'org-agenda-type)) 2424 (setq org-agenda-type (get-text-property (point) 'org-agenda-type))
2425 (when (get 'org-agenda-filter :preset-filter)
2426 (org-agenda-filter-apply org-agenda-filter))
2154 ))) 2427 )))
2155 2428
2156(defun org-fontify-priorities () 2429(defun org-agenda-fontify-priorities ()
2157 "Make highest priority lines bold, and lowest italic." 2430 "Make highest priority lines bold, and lowest italic."
2158 (interactive) 2431 (interactive)
2159 (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) 2432 (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority)
@@ -2169,12 +2442,16 @@ VALUE defaults to t."
2169 l (or (get-char-property (point) 'org-lowest-priority) 2442 l (or (get-char-property (point) 'org-lowest-priority)
2170 org-lowest-priority) 2443 org-lowest-priority)
2171 p (string-to-char (match-string 1)) 2444 p (string-to-char (match-string 1))
2172 b (match-beginning 0) e (point-at-eol) 2445 b (match-beginning 0)
2446 e (if (eq org-agenda-fontify-priorities 'cookies)
2447 (match-end 0)
2448 (point-at-eol))
2173 ov (org-make-overlay b e)) 2449 ov (org-make-overlay b e))
2174 (org-overlay-put 2450 (org-overlay-put
2175 ov 'face 2451 ov 'face
2176 (cond ((listp org-agenda-fontify-priorities) 2452 (cond ((cdr (assoc p org-priority-faces)))
2177 (cdr (assoc p org-agenda-fontify-priorities))) 2453 ((and (listp org-agenda-fontify-priorities)
2454 (cdr (assoc p org-agenda-fontify-priorities))))
2178 ((equal p l) 'italic) 2455 ((equal p l) 'italic)
2179 ((equal p h) 'bold))) 2456 ((equal p h) 'bold)))
2180 (org-overlay-put ov 'org-type 'org-priority))))) 2457 (org-overlay-put ov 'org-type 'org-priority)))))
@@ -2188,25 +2465,30 @@ VALUE defaults to t."
2188 (let ((inhibit-read-only t) 2465 (let ((inhibit-read-only t)
2189 (org-depend-tag-blocked nil) 2466 (org-depend-tag-blocked nil)
2190 (invis (eq org-agenda-dim-blocked-tasks 'invisible)) 2467 (invis (eq org-agenda-dim-blocked-tasks 'invisible))
2191 b e p ov h l) 2468 org-blocked-by-checkboxes
2469 invis1 b e p ov h l)
2192 (goto-char (point-min)) 2470 (goto-char (point-min))
2193 (while (let ((pos (next-single-property-change (point) 'todo-state))) 2471 (while (let ((pos (next-single-property-change (point) 'todo-state)))
2194 (and pos (goto-char (1+ pos)))) 2472 (and pos (goto-char (1+ pos))))
2473 (setq org-blocked-by-checkboxes nil invis1 invis)
2195 (let ((marker (get-text-property (point) 'org-hd-marker))) 2474 (let ((marker (get-text-property (point) 'org-hd-marker)))
2196 (when (and marker 2475 (when (and marker
2197 (not (with-current-buffer (marker-buffer marker) 2476 (not (with-current-buffer (marker-buffer marker)
2198 (save-excursion 2477 (save-excursion
2199 (goto-char marker) 2478 (goto-char marker)
2200 (run-hook-with-args-until-failure 2479 (if (org-entry-get nil "NOBLOCKING")
2201 'org-blocker-hook 2480 t ;; Never block this entry
2202 (list :type 'todo-state-change 2481 (run-hook-with-args-until-failure
2203 :position marker 2482 'org-blocker-hook
2204 :from 'todo 2483 (list :type 'todo-state-change
2205 :to 'done)))))) 2484 :position marker
2206 (setq b (if invis (max (point-min) (1- (point))) (point)) 2485 :from 'todo
2486 :to 'done)))))))
2487 (if org-blocked-by-checkboxes (setq invis1 nil))
2488 (setq b (if invis1 (max (point-min) (1- (point))) (point))
2207 e (point-at-eol) 2489 e (point-at-eol)
2208 ov (org-make-overlay b e)) 2490 ov (org-make-overlay b e))
2209 (if invis 2491 (if invis1
2210 (org-overlay-put ov 'invisible t) 2492 (org-overlay-put ov 'invisible t)
2211 (org-overlay-put ov 'face 'org-agenda-dimmed-todo-face)) 2493 (org-overlay-put ov 'face 'org-agenda-dimmed-todo-face))
2212 (org-overlay-put ov 'org-type 'org-blocked-todo))))))) 2494 (org-overlay-put ov 'org-type 'org-blocked-todo)))))))
@@ -2406,7 +2688,8 @@ When EMPTY is non-nil, also include days without any entries."
2406;;; Agenda Daily/Weekly 2688;;; Agenda Daily/Weekly
2407 2689
2408(defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter 2690(defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter
2409(defvar org-agenda-start-day nil) ; dynamically scoped parameter 2691(defvar org-agenda-start-day nil ; dynamically scoped parameter
2692"Custom commands can set this variable in the options section.")
2410(defvar org-agenda-last-arguments nil 2693(defvar org-agenda-last-arguments nil
2411 "The arguments of the previous call to org-agenda") 2694 "The arguments of the previous call to org-agenda")
2412(defvar org-starting-day nil) ; local variable in the agenda buffer 2695(defvar org-starting-day nil) ; local variable in the agenda buffer
@@ -2507,14 +2790,17 @@ given in `org-agenda-start-on-weekday'."
2507 (w1 (org-days-to-iso-week d1)) 2790 (w1 (org-days-to-iso-week d1))
2508 (w2 (org-days-to-iso-week d2))) 2791 (w2 (org-days-to-iso-week d2)))
2509 (setq s (point)) 2792 (setq s (point))
2510 (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd))) 2793 (if org-agenda-overriding-header
2511 "-agenda" 2794 (insert (org-add-props (copy-sequence org-agenda-overriding-header)
2512 (if (< (- d2 d1) 350) 2795 nil 'face 'org-agenda-structure) "\n")
2513 (if (= w1 w2) 2796 (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd)))
2514 (format " (W%02d)" w1) 2797 "-agenda"
2515 (format " (W%02d-W%02d)" w1 w2)) 2798 (if (< (- d2 d1) 350)
2516 "") 2799 (if (= w1 w2)
2517 ":\n")) 2800 (format " (W%02d)" w1)
2801 (format " (W%02d-W%02d)" w1 w2))
2802 "")
2803 ":\n")))
2518 (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure 2804 (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
2519 'org-date-line t))) 2805 'org-date-line t)))
2520 (while (setq d (pop day-numbers)) 2806 (while (setq d (pop day-numbers))
@@ -2545,7 +2831,7 @@ given in `org-agenda-start-on-weekday'."
2545 :deadline :scheduled :sexp :timestamp)))) 2831 :deadline :scheduled :sexp :timestamp))))
2546 (setq rtnall (append rtnall rtn)))) 2832 (setq rtnall (append rtnall rtn))))
2547 (if org-agenda-include-diary 2833 (if org-agenda-include-diary
2548 (progn 2834 (let ((org-agenda-search-headline-for-time t))
2549 (require 'diary-lib) 2835 (require 'diary-lib)
2550 (setq rtn (org-get-entries-from-diary date)) 2836 (setq rtn (org-get-entries-from-diary date))
2551 (setq rtnall (append rtnall rtn)))) 2837 (setq rtnall (append rtnall rtn))))
@@ -2564,7 +2850,9 @@ given in `org-agenda-start-on-weekday'."
2564 'org-agenda-date)) 2850 'org-agenda-date))
2565 (put-text-property s (1- (point)) 'org-date-line t) 2851 (put-text-property s (1- (point)) 'org-date-line t)
2566 (put-text-property s (1- (point)) 'org-day-cnt day-cnt) 2852 (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
2567 (if todayp (put-text-property s (1- (point)) 'org-today t)) 2853 (when todayp
2854 (put-text-property s (1- (point)) 'org-today t)
2855 (put-text-property s (1- (point)) 'face 'org-agenda-date-today))
2568 (if rtnall (insert 2856 (if rtnall (insert
2569 (org-finalize-agenda-entries 2857 (org-finalize-agenda-entries
2570 (org-agenda-add-time-grid-maybe 2858 (org-agenda-add-time-grid-maybe
@@ -2584,7 +2872,7 @@ given in `org-agenda-start-on-weekday'."
2584 (setq tbl (apply 'org-get-clocktable p)) 2872 (setq tbl (apply 'org-get-clocktable p))
2585 (insert tbl))) 2873 (insert tbl)))
2586 (goto-char (point-min)) 2874 (goto-char (point-min))
2587 (org-fit-agenda-window) 2875 (or org-agenda-multi (org-fit-agenda-window))
2588 (unless (and (pos-visible-in-window-p (point-min)) 2876 (unless (and (pos-visible-in-window-p (point-min))
2589 (pos-visible-in-window-p (point-max))) 2877 (pos-visible-in-window-p (point-max)))
2590 (goto-char (1- (point-max))) 2878 (goto-char (1- (point-max)))
@@ -2652,7 +2940,7 @@ in `org-agenda-text-search-extra-files'."
2652 (org-set-sorting-strategy 'search) 2940 (org-set-sorting-strategy 'search)
2653 (org-prepare-agenda "SEARCH") 2941 (org-prepare-agenda "SEARCH")
2654 (let* ((props (list 'face nil 2942 (let* ((props (list 'face nil
2655 'done-face 'org-done 2943 'done-face 'org-agenda-done
2656 'org-not-done-regexp org-not-done-regexp 2944 'org-not-done-regexp org-not-done-regexp
2657 'org-todo-regexp org-todo-regexp 2945 'org-todo-regexp org-todo-regexp
2658 'org-complex-heading-regexp org-complex-heading-regexp 2946 'org-complex-heading-regexp org-complex-heading-regexp
@@ -2794,7 +3082,7 @@ in `org-agenda-text-search-extra-files'."
2794 (when rtnall 3082 (when rtnall
2795 (insert (org-finalize-agenda-entries rtnall) "\n")) 3083 (insert (org-finalize-agenda-entries rtnall) "\n"))
2796 (goto-char (point-min)) 3084 (goto-char (point-min))
2797 (org-fit-agenda-window) 3085 (or org-agenda-multi (org-fit-agenda-window))
2798 (add-text-properties (point-min) (point-max) '(org-agenda-type search)) 3086 (add-text-properties (point-min) (point-max) '(org-agenda-type search))
2799 (org-finalize-agenda) 3087 (org-finalize-agenda)
2800 (setq buffer-read-only t))) 3088 (setq buffer-read-only t)))
@@ -2864,7 +3152,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
2864 (when rtnall 3152 (when rtnall
2865 (insert (org-finalize-agenda-entries rtnall) "\n")) 3153 (insert (org-finalize-agenda-entries rtnall) "\n"))
2866 (goto-char (point-min)) 3154 (goto-char (point-min))
2867 (org-fit-agenda-window) 3155 (or org-agenda-multi (org-fit-agenda-window))
2868 (add-text-properties (point-min) (point-max) '(org-agenda-type todo)) 3156 (add-text-properties (point-min) (point-max) '(org-agenda-type todo))
2869 (org-finalize-agenda) 3157 (org-finalize-agenda)
2870 (setq buffer-read-only t))) 3158 (setq buffer-read-only t)))
@@ -2879,7 +3167,8 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
2879 (org-compile-prefix-format 'tags) 3167 (org-compile-prefix-format 'tags)
2880 (org-set-sorting-strategy 'tags) 3168 (org-set-sorting-strategy 'tags)
2881 (let* ((org-tags-match-list-sublevels 3169 (let* ((org-tags-match-list-sublevels
2882 (if todo-only t org-tags-match-list-sublevels)) 3170;?????? (if todo-only t org-tags-match-list-sublevels))
3171 org-tags-match-list-sublevels)
2883 (completion-ignore-case t) 3172 (completion-ignore-case t)
2884 rtn rtnall files file pos matcher 3173 rtn rtnall files file pos matcher
2885 buffer) 3174 buffer)
@@ -2930,7 +3219,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
2930 (when rtnall 3219 (when rtnall
2931 (insert (org-finalize-agenda-entries rtnall) "\n")) 3220 (insert (org-finalize-agenda-entries rtnall) "\n"))
2932 (goto-char (point-min)) 3221 (goto-char (point-min))
2933 (org-fit-agenda-window) 3222 (or org-agenda-multi (org-fit-agenda-window))
2934 (add-text-properties (point-min) (point-max) '(org-agenda-type tags)) 3223 (add-text-properties (point-min) (point-max) '(org-agenda-type tags))
2935 (org-finalize-agenda) 3224 (org-finalize-agenda)
2936 (setq buffer-read-only t))) 3225 (setq buffer-read-only t)))
@@ -2943,7 +3232,21 @@ This is basically a temporary global variable that can be set and then
2943used by user-defined selections using `org-agenda-skip-function'.") 3232used by user-defined selections using `org-agenda-skip-function'.")
2944 3233
2945(defvar org-agenda-overriding-header nil 3234(defvar org-agenda-overriding-header nil
2946 "When this is set during todo and tags searches, will replace header.") 3235 "When this is set during todo and tags searches, will replace header.
3236This variable should not be set directly, but custom commands can bind it
3237in the options section.")
3238
3239(defun org-agenda-skip-entry-when-regexp-matches ()
3240 "Checks if the current entry contains match for `org-agenda-skip-regexp'.
3241If yes, it returns the end position of this entry, causing agenda commands
3242to skip the entry but continuing the search in the subtree. This is a
3243function that can be put into `org-agenda-skip-function' for the duration
3244of a command."
3245 (let ((end (save-excursion (org-end-of-subtree t)))
3246 skip)
3247 (save-excursion
3248 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
3249 (and skip end)))
2947 3250
2948(defun org-agenda-skip-subtree-when-regexp-matches () 3251(defun org-agenda-skip-subtree-when-regexp-matches ()
2949 "Checks if the current subtree contains match for `org-agenda-skip-regexp'. 3252 "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
2956 (setq skip (re-search-forward org-agenda-skip-regexp end t))) 3259 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
2957 (and skip end))) 3260 (and skip end)))
2958 3261
3262(defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
3263 "Checks if the current subtree contains match for `org-agenda-skip-regexp'.
3264If yes, it returns the end position of the current entry (NOT the tree),
3265causing agenda commands to skip the entry but continuing the search in
3266the subtree. This is a function that can be put into
3267`org-agenda-skip-function' for the duration of a command. An important
3268use of this function is for the stuck project list."
3269 (let ((end (save-excursion (org-end-of-subtree t)))
3270 (entry-end (save-excursion (outline-next-heading) (1- (point))))
3271 skip)
3272 (save-excursion
3273 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
3274 (and skip entry-end)))
3275
2959(defun org-agenda-skip-entry-if (&rest conditions) 3276(defun org-agenda-skip-entry-if (&rest conditions)
2960 "Skip entry if any of CONDITIONS is true. 3277 "Skip entry if any of CONDITIONS is true.
2961See `org-agenda-skip-if' for details." 3278See `org-agenda-skip-if' for details."
@@ -2978,6 +3295,8 @@ scheduled Check if there is a scheduled cookie
2978notscheduled Check if there is no scheduled cookie 3295notscheduled Check if there is no scheduled cookie
2979deadline Check if there is a deadline 3296deadline Check if there is a deadline
2980notdeadline Check if there is no deadline 3297notdeadline Check if there is no deadline
3298timestamp Check if there is a timestamp (also deadline or scheduled)
3299nottimestamp Check if there is no timestamp (also deadline or scheduled)
2981regexp Check if regexp matches 3300regexp Check if regexp matches
2982notregexp Check if regexp does not match. 3301notregexp Check if regexp does not match.
2983 3302
@@ -3004,6 +3323,10 @@ that can be put into `org-agenda-skip-function' for the duration of a command."
3004 (re-search-forward org-deadline-time-regexp end t)) 3323 (re-search-forward org-deadline-time-regexp end t))
3005 (and (memq 'notdeadline conditions) 3324 (and (memq 'notdeadline conditions)
3006 (not (re-search-forward org-deadline-time-regexp end t))) 3325 (not (re-search-forward org-deadline-time-regexp end t)))
3326 (and (memq 'timestamp conditions)
3327 (re-search-forward org-ts-regexp end t))
3328 (and (memq 'nottimestamp conditions)
3329 (not (re-search-forward org-ts-regexp end t)))
3007 (and (setq m (memq 'regexp conditions)) 3330 (and (setq m (memq 'regexp conditions))
3008 (stringp (nth 1 m)) 3331 (stringp (nth 1 m))
3009 (re-search-forward (nth 1 m) end t)) 3332 (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
3020`org-stuck-projects'. 3343`org-stuck-projects'.
3021MATCH is being ignored." 3344MATCH is being ignored."
3022 (interactive) 3345 (interactive)
3023 (let* ((org-agenda-skip-function 'org-agenda-skip-subtree-when-regexp-matches) 3346 (let* ((org-agenda-skip-function
3347 'org-agenda-skip-entry-when-regexp-matches-in-subtree)
3024 ;; We could have used org-agenda-skip-if here. 3348 ;; We could have used org-agenda-skip-if here.
3025 (org-agenda-overriding-header "List of stuck projects: ") 3349 (org-agenda-overriding-header
3350 (or org-agenda-overriding-header "List of stuck projects: "))
3026 (matcher (nth 0 org-stuck-projects)) 3351 (matcher (nth 0 org-stuck-projects))
3027 (todo (nth 1 org-stuck-projects)) 3352 (todo (nth 1 org-stuck-projects))
3028 (todo-wds (if (member "*" todo) 3353 (todo-wds (if (member "*" todo)
@@ -3039,9 +3364,10 @@ MATCH is being ignored."
3039 (tags (nth 2 org-stuck-projects)) 3364 (tags (nth 2 org-stuck-projects))
3040 (tags-re (if (member "*" tags) 3365 (tags-re (if (member "*" tags)
3041 (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$") 3366 (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$")
3042 (concat "^\\*+ .*:\\(" 3367 (if tags
3043 (mapconcat 'identity tags "\\|") 3368 (concat "^\\*+ .*:\\("
3044 (org-re "\\):[[:alnum:]_@:]*[ \t]*$")))) 3369 (mapconcat 'identity tags "\\|")
3370 (org-re "\\):[[:alnum:]_@:]*[ \t]*$")))))
3045 (gen-re (nth 3 org-stuck-projects)) 3371 (gen-re (nth 3 org-stuck-projects))
3046 (re-list 3372 (re-list
3047 (delq nil 3373 (delq nil
@@ -3110,6 +3436,9 @@ MATCH is being ignored."
3110 'type "diary" 'date date)) 3436 'type "diary" 'date date))
3111 entries))))) 3437 entries)))))
3112 3438
3439(defvar org-agenda-cleanup-fancy-diary-hook nil
3440 "Hook run when the fancy diary buffer is cleaned up.")
3441
3113(defun org-agenda-cleanup-fancy-diary () 3442(defun org-agenda-cleanup-fancy-diary ()
3114 "Remove unwanted stuff in buffer created by `fancy-diary-display'. 3443 "Remove unwanted stuff in buffer created by `fancy-diary-display'.
3115This gets rid of the date, the underline under the date, and 3444This gets rid of the date, the underline under the date, and
@@ -3129,7 +3458,8 @@ date. It also removes lines that contain only whitespace."
3129 (replace-match "")) 3458 (replace-match ""))
3130 (goto-char (point-min)) 3459 (goto-char (point-min))
3131 (if (re-search-forward "^Org-mode dummy\n?" nil t) 3460 (if (re-search-forward "^Org-mode dummy\n?" nil t)
3132 (replace-match ""))) 3461 (replace-match ""))
3462 (run-hooks 'org-agenda-cleanup-fancy-diary-hook))
3133 3463
3134;; Make sure entries from the diary have the right text properties. 3464;; Make sure entries from the diary have the right text properties.
3135(eval-after-load "diary-lib" 3465(eval-after-load "diary-lib"
@@ -3295,7 +3625,7 @@ the documentation of `org-diary'."
3295(defun org-agenda-get-todos () 3625(defun org-agenda-get-todos ()
3296 "Return the TODO information for agenda display." 3626 "Return the TODO information for agenda display."
3297 (let* ((props (list 'face nil 3627 (let* ((props (list 'face nil
3298 'done-face 'org-done 3628 'done-face 'org-agenda-done
3299 'org-not-done-regexp org-not-done-regexp 3629 'org-not-done-regexp org-not-done-regexp
3300 'org-todo-regexp org-todo-regexp 3630 'org-todo-regexp org-todo-regexp
3301 'org-complex-heading-regexp org-complex-heading-regexp 3631 'org-complex-heading-regexp org-complex-heading-regexp
@@ -3330,8 +3660,9 @@ the documentation of `org-diary'."
3330 (goto-char (match-beginning 1)) 3660 (goto-char (match-beginning 1))
3331 (setq marker (org-agenda-new-marker (match-beginning 0)) 3661 (setq marker (org-agenda-new-marker (match-beginning 0))
3332 category (org-get-category) 3662 category (org-get-category)
3663 txt (match-string 1)
3333 tags (org-get-tags-at (point)) 3664 tags (org-get-tags-at (point))
3334 txt (org-format-agenda-item "" (match-string 1) category tags) 3665 txt (org-format-agenda-item "" txt category tags)
3335 priority (1+ (org-get-priority txt)) 3666 priority (1+ (org-get-priority txt))
3336 todo-state (org-get-todo-state)) 3667 todo-state (org-get-todo-state))
3337 (org-add-props txt props 3668 (org-add-props txt props
@@ -3396,9 +3727,9 @@ the documentation of `org-diary'."
3396 "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) 3727 "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
3397 marker hdmarker deadlinep scheduledp clockp closedp inactivep 3728 marker hdmarker deadlinep scheduledp clockp closedp inactivep
3398 donep tmp priority category ee txt timestr tags b0 b3 e3 head 3729 donep tmp priority category ee txt timestr tags b0 b3 e3 head
3399 todo-state) 3730 todo-state end-of-match)
3400 (goto-char (point-min)) 3731 (goto-char (point-min))
3401 (while (re-search-forward regexp nil t) 3732 (while (setq end-of-match (re-search-forward regexp nil t))
3402 (setq b0 (match-beginning 0) 3733 (setq b0 (match-beginning 0)
3403 b3 (match-beginning 3) e3 (match-end 3)) 3734 b3 (match-beginning 3) e3 (match-end 3))
3404 (catch :skip 3735 (catch :skip
@@ -3412,9 +3743,7 @@ the documentation of `org-diary'."
3412 (if (and e3 3743 (if (and e3
3413 (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date))) 3744 (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date)))
3414 (throw :skip nil)) 3745 (throw :skip nil))
3415 (setq marker (org-agenda-new-marker b0) 3746 (setq tmp (buffer-substring (max (point-min)
3416 category (org-get-category b0)
3417 tmp (buffer-substring (max (point-min)
3418 (- b0 org-ds-keyword-length)) 3747 (- b0 org-ds-keyword-length))
3419 b0) 3748 b0)
3420 timestr (if b3 "" (buffer-substring b0 (point-at-eol))) 3749 timestr (if b3 "" (buffer-substring b0 (point-at-eol)))
@@ -3428,25 +3757,26 @@ the documentation of `org-diary'."
3428 (string-match "]-+\\'" tmp))) 3757 (string-match "]-+\\'" tmp)))
3429 todo-state (org-get-todo-state) 3758 todo-state (org-get-todo-state)
3430 donep (member todo-state org-done-keywords)) 3759 donep (member todo-state org-done-keywords))
3431 (if (or scheduledp deadlinep closedp clockp) 3760 (if (or scheduledp deadlinep closedp clockp
3761 (and donep org-agenda-skip-timestamp-if-done))
3432 (throw :skip t)) 3762 (throw :skip t))
3433 (if (string-match ">" timestr) 3763 (if (string-match ">" timestr)
3434 ;; substring should only run to end of time stamp 3764 ;; substring should only run to end of time stamp
3435 (setq timestr (substring timestr 0 (match-end 0)))) 3765 (setq timestr (substring timestr 0 (match-end 0))))
3766 (setq marker (org-agenda-new-marker b0)
3767 category (org-get-category b0))
3436 (save-excursion 3768 (save-excursion
3437 (if (re-search-backward "^\\*+ " nil t) 3769 (if (not (re-search-backward "^\\*+ " nil t))
3438 (progn 3770 (setq txt org-agenda-no-heading-message)
3439 (goto-char (match-beginning 0)) 3771 (goto-char (match-beginning 0))
3440 (setq hdmarker (org-agenda-new-marker) 3772 (setq hdmarker (org-agenda-new-marker)
3441 tags (org-get-tags-at)) 3773 tags (org-get-tags-at))
3442 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 3774 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
3443 (setq head (match-string 1)) 3775 (setq head (match-string 1))
3444 (and org-agenda-skip-timestamp-if-done donep (throw :skip t)) 3776 (setq txt (org-format-agenda-item
3445 (setq txt (org-format-agenda-item 3777 (if inactivep "[" nil)
3446 (if inactivep "[" nil) 3778 head category tags timestr nil
3447 head category tags timestr nil 3779 remove-re)))
3448 remove-re)))
3449 (setq txt org-agenda-no-heading-message))
3450 (setq priority (org-get-priority txt)) 3780 (setq priority (org-get-priority txt))
3451 (org-add-props txt props 3781 (org-add-props txt props
3452 'org-marker marker 'org-hd-marker hdmarker) 3782 'org-marker marker 'org-hd-marker hdmarker)
@@ -3455,7 +3785,9 @@ the documentation of `org-diary'."
3455 'todo-state todo-state 3785 'todo-state todo-state
3456 'type "timestamp") 3786 'type "timestamp")
3457 (push txt ee)) 3787 (push txt ee))
3458 (outline-next-heading))) 3788 (if org-agenda-skip-additional-timestamps-same-entry
3789 (outline-next-heading)
3790 (goto-char end-of-match))))
3459 (nreverse ee))) 3791 (nreverse ee)))
3460 3792
3461(defun org-agenda-get-sexps () 3793(defun org-agenda-get-sexps ()
@@ -3468,7 +3800,8 @@ the documentation of `org-diary'."
3468 (format "mouse-2 or RET jump to org file %s" 3800 (format "mouse-2 or RET jump to org file %s"
3469 (abbreviate-file-name buffer-file-name)))) 3801 (abbreviate-file-name buffer-file-name))))
3470 (regexp "^&?%%(") 3802 (regexp "^&?%%(")
3471 marker category ee txt tags entry result beg b sexp sexp-entry) 3803 marker category ee txt tags entry result beg b sexp sexp-entry
3804 todo-state)
3472 (goto-char (point-min)) 3805 (goto-char (point-min))
3473 (while (re-search-forward regexp nil t) 3806 (while (re-search-forward regexp nil t)
3474 (catch :skip 3807 (catch :skip
@@ -3484,7 +3817,8 @@ the documentation of `org-diary'."
3484 (setq result (org-diary-sexp-entry sexp sexp-entry date)) 3817 (setq result (org-diary-sexp-entry sexp sexp-entry date))
3485 (when result 3818 (when result
3486 (setq marker (org-agenda-new-marker beg) 3819 (setq marker (org-agenda-new-marker beg)
3487 category (org-get-category beg)) 3820 category (org-get-category beg)
3821 todo-state (org-get-todo-state))
3488 3822
3489 (if (string-match "\\S-" result) 3823 (if (string-match "\\S-" result)
3490 (setq txt result) 3824 (setq txt result)
@@ -3494,7 +3828,7 @@ the documentation of `org-diary'."
3494 "" txt category tags 'time)) 3828 "" txt category tags 'time))
3495 (org-add-props txt props 'org-marker marker) 3829 (org-add-props txt props 'org-marker marker)
3496 (org-add-props txt nil 3830 (org-add-props txt nil
3497 'org-category category 'date date 3831 'org-category category 'date date 'todo-state todo-state
3498 'type "sexp") 3832 'type "sexp")
3499 (push txt ee)))) 3833 (push txt ee))))
3500 (nreverse ee))) 3834 (nreverse ee)))
@@ -3518,7 +3852,7 @@ the documentation of `org-diary'."
3518 (list 3852 (list
3519 (if (memq 'closed items) (concat "\\<" org-closed-string)) 3853 (if (memq 'closed items) (concat "\\<" org-closed-string))
3520 (if (memq 'clock items) (concat "\\<" org-clock-string)) 3854 (if (memq 'clock items) (concat "\\<" org-clock-string))
3521 (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\"")))) 3855 (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?"))))
3522 (parts-re (if parts (mapconcat 'identity parts "\\|") 3856 (parts-re (if parts (mapconcat 'identity parts "\\|")
3523 (error "`org-agenda-log-mode-items' is empty"))) 3857 (error "`org-agenda-log-mode-items' is empty")))
3524 (regexp (concat 3858 (regexp (concat
@@ -3531,8 +3865,9 @@ the documentation of `org-diary'."
3531 (apply 'encode-time ; DATE bound by calendar 3865 (apply 'encode-time ; DATE bound by calendar
3532 (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 3866 (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
3533 1 11)))) 3867 1 11))))
3534 marker hdmarker priority category tags closedp statep state 3868 (org-agenda-search-headline-for-time nil)
3535 ee txt timestr rest clocked) 3869 marker hdmarker priority category tags closedp statep clockp state
3870 ee txt extra timestr rest clocked)
3536 (goto-char (point-min)) 3871 (goto-char (point-min))
3537 (while (re-search-forward regexp nil t) 3872 (while (re-search-forward regexp nil t)
3538 (catch :skip 3873 (catch :skip
@@ -3540,41 +3875,55 @@ the documentation of `org-diary'."
3540 (setq marker (org-agenda-new-marker (match-beginning 0)) 3875 (setq marker (org-agenda-new-marker (match-beginning 0))
3541 closedp (equal (match-string 1) org-closed-string) 3876 closedp (equal (match-string 1) org-closed-string)
3542 statep (equal (string-to-char (match-string 1)) ?-) 3877 statep (equal (string-to-char (match-string 1)) ?-)
3878 clockp (not (or closedp statep))
3543 state (and statep (match-string 2)) 3879 state (and statep (match-string 2))
3544 category (org-get-category (match-beginning 0)) 3880 category (org-get-category (match-beginning 0))
3545 timestr (buffer-substring (match-beginning 0) (point-at-eol)) 3881 timestr (buffer-substring (match-beginning 0) (point-at-eol))
3546 ;; donep (org-entry-is-done-p)
3547 ) 3882 )
3548 (when (string-match "\\]" timestr) 3883 (when (string-match "\\]" timestr)
3549 ;; substring should only run to end of time stamp 3884 ;; substring should only run to end of time stamp
3550 (setq rest (substring timestr (match-end 0)) 3885 (setq rest (substring timestr (match-end 0))
3551 timestr (substring timestr 0 (match-end 0))) 3886 timestr (substring timestr 0 (match-end 0)))
3552 (if (and (not closedp) (not statep) 3887 (if (and (not closedp) (not statep)
3553 (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest)) 3888 (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest))
3554 (progn (setq timestr (concat (substring timestr 0 -1) 3889 (progn (setq timestr (concat (substring timestr 0 -1)
3555 "-" (match-string 1 rest) "]")) 3890 "-" (match-string 1 rest) "]"))
3556 (setq clocked (match-string 2 rest))) 3891 (setq clocked (match-string 2 rest)))
3557 (setq clocked "-"))) 3892 (setq clocked "-")))
3558 (save-excursion 3893 (save-excursion
3559 (if (re-search-backward "^\\*+ " nil t) 3894 (cond
3560 (progn 3895 ((not org-agenda-log-mode-add-notes) (setq extra nil))
3561 (goto-char (match-beginning 0)) 3896 (statep
3562 (setq hdmarker (org-agenda-new-marker) 3897 (and (looking-at ".*\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
3563 tags (org-get-tags-at)) 3898 (setq extra (match-string 1))))
3564 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 3899 (clockp
3565 (setq txt (org-format-agenda-item 3900 (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
3566 (cond 3901 (setq extra (match-string 1))))
3567 (closedp "Closed: ") 3902 (t (setq extra nil)))
3903 (if (not (re-search-backward "^\\*+ " nil t))
3904 (setq txt org-agenda-no-heading-message)
3905 (goto-char (match-beginning 0))
3906 (setq hdmarker (org-agenda-new-marker)
3907 tags (org-get-tags-at))
3908 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
3909 (setq txt (match-string 1))
3910 (when extra
3911 (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
3912 (setq txt (concat (substring txt 0 (match-beginning 1))
3913 " - " extra " " (match-string 2 txt)))
3914 (setq txt (concat txt " - " extra))))
3915 (setq txt (org-format-agenda-item
3916 (cond
3917 (closedp "Closed: ")
3568 (statep (concat "State: (" state ")")) 3918 (statep (concat "State: (" state ")"))
3569 (t (concat "Clocked: (" clocked ")"))) 3919 (t (concat "Clocked: (" clocked ")")))
3570 (match-string 1) category tags timestr))) 3920 txt category tags timestr)))
3571 (setq txt org-agenda-no-heading-message))
3572 (setq priority 100000) 3921 (setq priority 100000)
3573 (org-add-props txt props 3922 (org-add-props txt props
3574 'org-marker marker 'org-hd-marker hdmarker 'face 'org-done 3923 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
3575 'priority priority 'org-category category 3924 'priority priority 'org-category category
3576 'type "closed" 'date date 3925 'type "closed" 'date date
3577 'undone-face 'org-warning 'done-face 'org-done) 3926 'undone-face 'org-warning 'done-face 'org-agenda-done)
3578 (push txt ee)) 3927 (push txt ee))
3579 (goto-char (point-at-eol)))) 3928 (goto-char (point-at-eol))))
3580 (nreverse ee))) 3929 (nreverse ee)))
@@ -3599,6 +3948,7 @@ the documentation of `org-diary'."
3599 (catch :skip 3948 (catch :skip
3600 (org-agenda-skip) 3949 (org-agenda-skip)
3601 (setq s (match-string 1) 3950 (setq s (match-string 1)
3951 txt nil
3602 pos (1- (match-beginning 1)) 3952 pos (1- (match-beginning 1))
3603 d2 (org-time-string-to-absolute 3953 d2 (org-time-string-to-absolute
3604 (match-string 1) d1 'past 3954 (match-string 1) d1 'past
@@ -3614,36 +3964,38 @@ the documentation of `org-diary'."
3614 (and todayp (not org-agenda-only-exact-dates))) 3964 (and todayp (not org-agenda-only-exact-dates)))
3615 (= diff 0)) 3965 (= diff 0))
3616 (save-excursion 3966 (save-excursion
3617 (setq category (org-get-category))
3618 (setq todo-state (org-get-todo-state)) 3967 (setq todo-state (org-get-todo-state))
3619 (if (re-search-backward "^\\*+[ \t]+" nil t) 3968 (setq donep (member todo-state org-done-keywords))
3620 (progn 3969 (if (and donep
3621 (goto-char (match-end 0)) 3970 (or org-agenda-skip-deadline-if-done
3622 (setq pos1 (match-beginning 0)) 3971 (not (= diff 0))))
3623 (setq tags (org-get-tags-at pos1)) 3972 (setq txt nil)
3624 (setq head (buffer-substring-no-properties 3973 (setq category (org-get-category))
3625 (point) 3974 (if (not (re-search-backward "^\\*+[ \t]+" nil t))
3626 (progn (skip-chars-forward "^\r\n") 3975 (setq txt org-agenda-no-heading-message)
3627 (point)))) 3976 (goto-char (match-end 0))
3628 (setq donep (member todo-state org-done-keywords)) 3977 (setq pos1 (match-beginning 0))
3629 (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) 3978 (setq tags (org-get-tags-at pos1))
3630 (setq timestr 3979 (setq head (buffer-substring-no-properties
3631 (concat (substring s (match-beginning 1)) " ")) 3980 (point)
3632 (setq timestr 'time)) 3981 (progn (skip-chars-forward "^\r\n")
3633 (if (and donep 3982 (point))))
3634 (or org-agenda-skip-deadline-if-done 3983 (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
3635 (not (= diff 0)))) 3984 (setq timestr
3636 (setq txt nil) 3985 (concat (substring s (match-beginning 1)) " "))
3637 (setq txt (org-format-agenda-item 3986 (setq timestr 'time))
3638 (if (= diff 0) 3987 (setq txt (org-format-agenda-item
3639 (car org-agenda-deadline-leaders) 3988 (if (= diff 0)
3640 (if (functionp (nth 1 org-agenda-deadline-leaders)) 3989 (car org-agenda-deadline-leaders)
3641 (funcall (nth 1 org-agenda-deadline-leaders) diff date) 3990 (if (functionp
3642 (format (nth 1 org-agenda-deadline-leaders) 3991 (nth 1 org-agenda-deadline-leaders))
3643 diff))) 3992 (funcall
3644 head category tags 3993 (nth 1 org-agenda-deadline-leaders)
3645 (if (not (= diff 0)) nil timestr))))) 3994 diff date)
3646 (setq txt org-agenda-no-heading-message)) 3995 (format (nth 1 org-agenda-deadline-leaders)
3996 diff)))
3997 head category tags
3998 (if (not (= diff 0)) nil timestr)))))
3647 (when txt 3999 (when txt
3648 (setq face (org-agenda-deadline-face dfrac wdays)) 4000 (setq face (org-agenda-deadline-face dfrac wdays))
3649 (org-add-props txt props 4001 (org-add-props txt props
@@ -3655,8 +4007,8 @@ the documentation of `org-diary'."
3655 'todo-state todo-state 4007 'todo-state todo-state
3656 'type (if upcomingp "upcoming-deadline" "deadline") 4008 'type (if upcomingp "upcoming-deadline" "deadline")
3657 'date (if upcomingp date d2) 4009 'date (if upcomingp date d2)
3658 'face (if donep 'org-done face) 4010 'face (if donep 'org-agenda-done face)
3659 'undone-face face 'done-face 'org-done) 4011 'undone-face face 'done-face 'org-agenda-done)
3660 (push txt ee)))))) 4012 (push txt ee))))))
3661 (nreverse ee))) 4013 (nreverse ee)))
3662 4014
@@ -3674,7 +4026,7 @@ FRACTION is what fraction of the head-warning time has passed."
3674 (let* ((props (list 'org-not-done-regexp org-not-done-regexp 4026 (let* ((props (list 'org-not-done-regexp org-not-done-regexp
3675 'org-todo-regexp org-todo-regexp 4027 'org-todo-regexp org-todo-regexp
3676 'org-complex-heading-regexp org-complex-heading-regexp 4028 'org-complex-heading-regexp org-complex-heading-regexp
3677 'done-face 'org-done 4029 'done-face 'org-agenda-done
3678 'mouse-face 'highlight 4030 'mouse-face 'highlight
3679 'keymap org-agenda-keymap 4031 'keymap org-agenda-keymap
3680 'help-echo 4032 'help-echo
@@ -3690,6 +4042,7 @@ FRACTION is what fraction of the head-warning time has passed."
3690 (catch :skip 4042 (catch :skip
3691 (org-agenda-skip) 4043 (org-agenda-skip)
3692 (setq s (match-string 1) 4044 (setq s (match-string 1)
4045 txt nil
3693 pos (1- (match-beginning 1)) 4046 pos (1- (match-beginning 1))
3694 d2 (org-time-string-to-absolute 4047 d2 (org-time-string-to-absolute
3695 (match-string 1) d1 'past 4048 (match-string 1) d1 'past
@@ -3703,33 +4056,32 @@ FRACTION is what fraction of the head-warning time has passed."
3703 (and todayp (not org-agenda-only-exact-dates))) 4056 (and todayp (not org-agenda-only-exact-dates)))
3704 (= diff 0)) 4057 (= diff 0))
3705 (save-excursion 4058 (save-excursion
3706 (setq category (org-get-category))
3707 (setq todo-state (org-get-todo-state)) 4059 (setq todo-state (org-get-todo-state))
3708 (if (re-search-backward "^\\*+[ \t]+" nil t) 4060 (setq donep (member todo-state org-done-keywords))
3709 (progn 4061 (if (and donep
3710 (goto-char (match-end 0)) 4062 (or org-agenda-skip-scheduled-if-done
3711 (setq pos1 (match-beginning 0)) 4063 (not (= diff 0))))
3712 (setq tags (org-get-tags-at)) 4064 (setq txt nil)
3713 (setq head (buffer-substring-no-properties 4065 (setq category (org-get-category))
3714 (point) 4066 (if (not (re-search-backward "^\\*+[ \t]+" nil t))
3715 (progn (skip-chars-forward "^\r\n") (point)))) 4067 (setq txt org-agenda-no-heading-message)
3716 (setq donep (member todo-state org-done-keywords)) 4068 (goto-char (match-end 0))
3717 (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) 4069 (setq pos1 (match-beginning 0))
3718 (setq timestr 4070 (setq tags (org-get-tags-at))
3719 (concat (substring s (match-beginning 1)) " ")) 4071 (setq head (buffer-substring-no-properties
3720 (setq timestr 'time)) 4072 (point)
3721 (if (and donep 4073 (progn (skip-chars-forward "^\r\n") (point))))
3722 (or org-agenda-skip-scheduled-if-done 4074 (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
3723 (not (= diff 0)))) 4075 (setq timestr
3724 (setq txt nil) 4076 (concat (substring s (match-beginning 1)) " "))
3725 (setq txt (org-format-agenda-item 4077 (setq timestr 'time))
3726 (if (= diff 0) 4078 (setq txt (org-format-agenda-item
3727 (car org-agenda-scheduled-leaders) 4079 (if (= diff 0)
3728 (format (nth 1 org-agenda-scheduled-leaders) 4080 (car org-agenda-scheduled-leaders)
3729 (- 1 diff))) 4081 (format (nth 1 org-agenda-scheduled-leaders)
3730 head category tags 4082 (- 1 diff)))
3731 (if (not (= diff 0)) nil timestr))))) 4083 head category tags
3732 (setq txt org-agenda-no-heading-message)) 4084 (if (not (= diff 0)) nil timestr)))))
3733 (when txt 4085 (when txt
3734 (setq face 4086 (setq face
3735 (cond 4087 (cond
@@ -3738,7 +4090,7 @@ FRACTION is what fraction of the head-warning time has passed."
3738 (t 'org-scheduled))) 4090 (t 'org-scheduled)))
3739 (org-add-props txt props 4091 (org-add-props txt props
3740 'undone-face face 4092 'undone-face face
3741 'face (if donep 'org-done face) 4093 'face (if donep 'org-agenda-done face)
3742 'org-marker (org-agenda-new-marker pos) 4094 'org-marker (org-agenda-new-marker pos)
3743 'org-hd-marker (org-agenda-new-marker pos1) 4095 'org-hd-marker (org-agenda-new-marker pos1)
3744 'type (if pastschedp "past-scheduled" "scheduled") 4096 'type (if pastschedp "past-scheduled" "scheduled")
@@ -3763,7 +4115,7 @@ FRACTION is what fraction of the head-warning time has passed."
3763 (regexp org-tr-regexp) 4115 (regexp org-tr-regexp)
3764 (d0 (calendar-absolute-from-gregorian date)) 4116 (d0 (calendar-absolute-from-gregorian date))
3765 marker hdmarker ee txt d1 d2 s1 s2 timestr category todo-state tags pos 4117 marker hdmarker ee txt d1 d2 s1 s2 timestr category todo-state tags pos
3766 head) 4118 head donep)
3767 (goto-char (point-min)) 4119 (goto-char (point-min))
3768 (while (re-search-forward regexp nil t) 4120 (while (re-search-forward regexp nil t)
3769 (catch :skip 4121 (catch :skip
@@ -3778,27 +4130,26 @@ FRACTION is what fraction of the head-warning time has passed."
3778 ;; Only allow days between the limits, because the normal 4130 ;; Only allow days between the limits, because the normal
3779 ;; date stamps will catch the limits. 4131 ;; date stamps will catch the limits.
3780 (save-excursion 4132 (save-excursion
4133 (setq todo-state (org-get-todo-state))
4134 (setq donep (member todo-state org-done-keywords))
4135 (if (and donep org-agenda-skip-timestamp-if-done)
4136 (throw :skip t))
3781 (setq marker (org-agenda-new-marker (point))) 4137 (setq marker (org-agenda-new-marker (point)))
3782 (setq category (org-get-category)) 4138 (setq category (org-get-category))
3783 (setq todo-state (org-get-todo-state)) 4139 (if (not (re-search-backward "^\\*+ " nil t))
3784 (if (re-search-backward "^\\*+ " nil t) 4140 (setq txt org-agenda-no-heading-message)
3785 (progn 4141 (goto-char (match-beginning 0))
3786 (goto-char (match-beginning 0)) 4142 (setq hdmarker (org-agenda-new-marker (point)))
3787 (setq hdmarker (org-agenda-new-marker (point))) 4143 (setq tags (org-get-tags-at))
3788 (setq tags (org-get-tags-at)) 4144 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
3789 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 4145 (setq head (match-string 1))
3790 (setq head (match-string 1)) 4146 (setq txt (org-format-agenda-item
3791 (and org-agenda-skip-timestamp-if-done 4147 (format
3792 (org-entry-is-done-p) 4148 (nth (if (= d1 d2) 0 1)
3793 (throw :skip t)) 4149 org-agenda-timerange-leaders)
3794 (setq txt (org-format-agenda-item 4150 (1+ (- d0 d1)) (1+ (- d2 d1)))
3795 (format 4151 head category tags
3796 (nth (if (= d1 d2) 0 1) 4152 (if (= d0 d1) timestr))))
3797 org-agenda-timerange-leaders)
3798 (1+ (- d0 d1)) (1+ (- d2 d1)))
3799 head category tags
3800 (if (= d0 d1) timestr))))
3801 (setq txt org-agenda-no-heading-message))
3802 (org-add-props txt props 4153 (org-add-props txt props
3803 'org-marker marker 'org-hd-marker hdmarker 4154 'org-marker marker 'org-hd-marker hdmarker
3804 'type "block" 'date date 4155 'type "block" 'date date
@@ -3850,7 +4201,9 @@ Any match of REMOVE-RE will be removed from TXT."
3850 ;; time, tag, effort are needed for the eval of the prefix format 4201 ;; time, tag, effort are needed for the eval of the prefix format
3851 (tag (if tags (nth (1- (length tags)) tags) "")) 4202 (tag (if tags (nth (1- (length tags)) tags) ""))
3852 time effort neffort 4203 time effort neffort
3853 (ts (if dotime (concat (if (stringp dotime) dotime "") txt))) 4204 (ts (if dotime (concat
4205 (if (stringp dotime) dotime "")
4206 (and org-agenda-search-headline-for-time txt))))
3854 (time-of-day (and dotime (org-get-time-of-day ts))) 4207 (time-of-day (and dotime (org-get-time-of-day ts)))
3855 stamp plain s0 s1 s2 t1 t2 rtn srp 4208 stamp plain s0 s1 s2 t1 t2 rtn srp
3856 duration) 4209 duration)
@@ -3939,6 +4292,7 @@ Any match of REMOVE-RE will be removed from TXT."
3939 (setq rtn (concat (eval org-prefix-format-compiled) txt))) 4292 (setq rtn (concat (eval org-prefix-format-compiled) txt)))
3940 4293
3941 ;; And finally add the text properties 4294 ;; And finally add the text properties
4295 (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
3942 (org-add-props rtn nil 4296 (org-add-props rtn nil
3943 'org-category (downcase category) 4297 'org-category (downcase category)
3944 'tags (mapcar 'org-downcase-keep-props tags) 4298 'tags (mapcar 'org-downcase-keep-props tags)
@@ -4104,7 +4458,7 @@ HH:MM."
4104 (setq re (get-text-property (point) 'org-todo-regexp)) 4458 (setq re (get-text-property (point) 'org-todo-regexp))
4105 (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) 4459 (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0)))
4106 (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) 4460 (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
4107 (add-text-properties (match-beginning 0) (match-end 0) 4461 (add-text-properties (match-beginning 0) (match-end 1)
4108 (list 'face (org-get-todo-face 1))) 4462 (list 'face (org-get-todo-face 1)))
4109 (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) 4463 (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
4110 (delete-region (match-beginning 1) (1- (match-end 0))) 4464 (delete-region (match-beginning 1) (1- (match-end 0)))
@@ -4153,10 +4507,19 @@ HH:MM."
4153 4507
4154(defsubst org-cmp-todo-state (a b) 4508(defsubst org-cmp-todo-state (a b)
4155 "Compare the todo states of strings A and B." 4509 "Compare the todo states of strings A and B."
4156 (let* ((ta (or (get-text-property 1 'todo-state a) "")) 4510 (let* ((ma (or (get-text-property 1 'org-marker a)
4511 (get-text-property 1 'org-hd-marker a)))
4512 (mb (or (get-text-property 1 'org-marker b)
4513 (get-text-property 1 'org-hd-marker b)))
4514 (fa (and ma (marker-buffer ma)))
4515 (fb (and mb (marker-buffer mb)))
4516 (todo-kwds
4517 (or (and fa (with-current-buffer fa org-todo-keywords-1))
4518 (and fb (with-current-buffer fb org-todo-keywords-1))))
4519 (ta (or (get-text-property 1 'todo-state a) ""))
4157 (tb (or (get-text-property 1 'todo-state b) "")) 4520 (tb (or (get-text-property 1 'todo-state b) ""))
4158 (la (- (length (member ta org-todo-keywords-for-agenda)))) 4521 (la (- (length (member ta todo-kwds))))
4159 (lb (- (length (member tb org-todo-keywords-for-agenda)))) 4522 (lb (- (length (member tb todo-kwds))))
4160 (donepa (member ta org-done-keywords-for-agenda)) 4523 (donepa (member ta org-done-keywords-for-agenda))
4161 (donepb (member tb org-done-keywords-for-agenda))) 4524 (donepb (member tb org-done-keywords-for-agenda)))
4162 (cond ((and donepa (not donepb)) -1) 4525 (cond ((and donepa (not donepb)) -1)
@@ -4200,7 +4563,13 @@ HH:MM."
4200 (tag-up (org-cmp-tag a b)) 4563 (tag-up (org-cmp-tag a b))
4201 (tag-down (if tag-up (- tag-up) nil)) 4564 (tag-down (if tag-up (- tag-up) nil))
4202 (todo-state-up (org-cmp-todo-state a b)) 4565 (todo-state-up (org-cmp-todo-state a b))
4203 (todo-state-down (if todo-state-up (- todo-state-up) nil))) 4566 (todo-state-down (if todo-state-up (- todo-state-up) nil))
4567 user-defined-up user-defined-down)
4568 (if (and org-agenda-cmp-user-defined
4569 (functionp org-agenda-cmp-user-defined))
4570 (setq user-defined-up
4571 (funcall org-agenda-cmp-user-defined a b)
4572 user-defined-down (if user-defined-up (- user-defined-up) nil)))
4204 (cdr (assoc 4573 (cdr (assoc
4205 (eval (cons 'or org-agenda-sorting-strategy-selected)) 4574 (eval (cons 'or org-agenda-sorting-strategy-selected))
4206 '((-1 . t) (1 . nil) (nil . nil)))))) 4575 '((-1 . t) (1 . nil) (nil . nil))))))
@@ -4294,7 +4663,9 @@ If ERROR is non-nil, throw an error, otherwise just return nil."
4294 (if org-agenda-columns-active 4663 (if org-agenda-columns-active
4295 (org-columns-quit) 4664 (org-columns-quit)
4296 (let ((buf (current-buffer))) 4665 (let ((buf (current-buffer)))
4297 (if (not (one-window-p)) (delete-window)) 4666 (and (not (eq org-agenda-window-setup 'current-window))
4667 (not (one-window-p))
4668 (delete-window))
4298 (kill-buffer buf) 4669 (kill-buffer buf)
4299 (org-agenda-reset-markers) 4670 (org-agenda-reset-markers)
4300 (org-columns-remove-overlays) 4671 (org-columns-remove-overlays)
@@ -4321,30 +4692,26 @@ So this is just a shortcut for `\\[org-agenda]', available in the agenda."
4321 (let ((org-agenda-window-setup 'current-window)) 4692 (let ((org-agenda-window-setup 'current-window))
4322 (org-agenda arg))) 4693 (org-agenda arg)))
4323 4694
4324(defun org-save-all-org-buffers ()
4325 "Save all Org-mode buffers without user confirmation."
4326 (interactive)
4327 (message "Saving all Org-mode buffers...")
4328 (save-some-buffers t 'org-mode-p)
4329 (message "Saving all Org-mode buffers... done"))
4330
4331(defun org-agenda-redo () 4695(defun org-agenda-redo ()
4332 "Rebuild Agenda. 4696 "Rebuild Agenda.
4333When this is the global TODO list, a prefix argument will be interpreted." 4697When this is the global TODO list, a prefix argument will be interpreted."
4334 (interactive) 4698 (interactive)
4335 (let* ((org-agenda-keep-modes t) 4699 (let* ((org-agenda-keep-modes t)
4336 (filter org-agenda-filter) 4700 (filter org-agenda-filter)
4701 (preset (get 'org-agenda-filter :preset-filter))
4337 (cols org-agenda-columns-active) 4702 (cols org-agenda-columns-active)
4338 (line (org-current-line)) 4703 (line (org-current-line))
4339 (window-line (- line (org-current-line (window-start)))) 4704 (window-line (- line (org-current-line (window-start))))
4340 (lprops (get 'org-agenda-redo-command 'org-lprops))) 4705 (lprops (get 'org-agenda-redo-command 'org-lprops)))
4706 (put 'org-agenda-filter :preset-filter nil)
4341 (and cols (org-columns-quit)) 4707 (and cols (org-columns-quit))
4342 (message "Rebuilding agenda buffer...") 4708 (message "Rebuilding agenda buffer...")
4343 (org-let lprops '(eval org-agenda-redo-command)) 4709 (org-let lprops '(eval org-agenda-redo-command))
4344 (setq org-agenda-undo-list nil 4710 (setq org-agenda-undo-list nil
4345 org-agenda-pending-undo-list nil) 4711 org-agenda-pending-undo-list nil)
4346 (message "Rebuilding agenda buffer...done") 4712 (message "Rebuilding agenda buffer...done")
4347 (and filter (org-agenda-filter-apply filter)) 4713 (put 'org-agenda-filter :preset-filter preset)
4714 (and (or filter preset) (org-agenda-filter-apply filter))
4348 (and cols (interactive-p) (org-agenda-columns)) 4715 (and cols (interactive-p) (org-agenda-columns))
4349 (goto-line line) 4716 (goto-line line)
4350 (recenter window-line))) 4717 (recenter window-line)))
@@ -4375,7 +4742,7 @@ to switch to narrowing."
4375 char a n tag) 4742 char a n tag)
4376 (unless char 4743 (unless char
4377 (message 4744 (message
4378 "%s by tag [%s ], [TAB], [/]:off, [+-]:narrow, [>=<]:effort: " 4745 "%s by tag [%s ], [TAB], [/]:off, [+-]:narrow, [>=<?]:effort: "
4379 (if narrow "Narrow" "Filter") tag-chars) 4746 (if narrow "Narrow" "Filter") tag-chars)
4380 (setq char (read-char))) 4747 (setq char (read-char)))
4381 (when (member char '(?+ ?-)) 4748 (when (member char '(?+ ?-))
@@ -4385,20 +4752,21 @@ to switch to narrowing."
4385 (message 4752 (message
4386 "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars) 4753 "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars)
4387 (setq char (read-char))) 4754 (setq char (read-char)))
4388 (when (member char '(?< ?> ?=)) 4755 (when (member char '(?< ?> ?= ??))
4389 ;; An effort operator 4756 ;; An effort operator
4390 (setq effort-op (char-to-string char)) 4757 (setq effort-op (char-to-string char))
4391 (loop for i from 0 to 9 do
4392 (setq effort-prompt
4393 (concat
4394 effort-prompt " ["
4395 (if (= i 9) "0" (int-to-string (1+ i)))
4396 "]" (nth i efforts))))
4397 (setq alist nil) ; to make sure it will be interpreted as effort. 4758 (setq alist nil) ; to make sure it will be interpreted as effort.
4398 (message "Effort%s: %s " effort-op effort-prompt) 4759 (unless (equal char ??)
4399 (setq char (read-char)) 4760 (loop for i from 0 to 9 do
4400 (when (or (< char ?0) (> char ?9)) 4761 (setq effort-prompt
4401 (error "Need 1-9,0 to select effort" ))) 4762 (concat
4763 effort-prompt " ["
4764 (if (= i 9) "0" (int-to-string (1+ i)))
4765 "]" (nth i efforts))))
4766 (message "Effort%s: %s " effort-op effort-prompt)
4767 (setq char (read-char))
4768 (when (or (< char ?0) (> char ?9))
4769 (error "Need 1-9,0 to select effort" ))))
4402 (when (equal char ?\t) 4770 (when (equal char ?\t)
4403 (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) 4771 (unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
4404 (org-set-local 'org-global-tags-completion-table 4772 (org-set-local 'org-global-tags-completion-table
@@ -4407,13 +4775,19 @@ to switch to narrowing."
4407 (setq tag (org-ido-completing-read 4775 (setq tag (org-ido-completing-read
4408 "Tag: " org-global-tags-completion-table)))) 4776 "Tag: " org-global-tags-completion-table))))
4409 (cond 4777 (cond
4410 ((equal char ?/) (org-agenda-filter-by-tag-show-all)) 4778 ((equal char ?/)
4779 (org-agenda-filter-by-tag-show-all)
4780 (when (get 'org-agenda-filter :preset-filter)
4781 (org-agenda-filter-apply org-agenda-filter)))
4411 ((or (equal char ?\ ) 4782 ((or (equal char ?\ )
4412 (setq a (rassoc char alist)) 4783 (setq a (rassoc char alist))
4413 (and (>= char ?0) (<= char ?9) 4784 (and (>= char ?0) (<= char ?9)
4414 (setq n (if (= char ?0) 9 (- char ?0 1)) 4785 (setq n (if (= char ?0) 9 (- char ?0 1))
4415 tag (concat effort-op (nth n efforts)) 4786 tag (concat effort-op (nth n efforts))
4416 a (cons tag nil))) 4787 a (cons tag nil)))
4788 (and (= char ??)
4789 (setq tag "?eff")
4790 a (cons tag nil))
4417 (and tag (setq a (cons tag nil)))) 4791 (and tag (setq a (cons tag nil))))
4418 (org-agenda-filter-by-tag-show-all) 4792 (org-agenda-filter-by-tag-show-all)
4419 (setq tag (car a)) 4793 (setq tag (car a))
@@ -4431,10 +4805,11 @@ to switch to narrowing."
4431(defun org-agenda-filter-make-matcher () 4805(defun org-agenda-filter-make-matcher ()
4432 "Create the form that tests a line for the agenda filter." 4806 "Create the form that tests a line for the agenda filter."
4433 (let (f f1) 4807 (let (f f1)
4434 (dolist (x org-agenda-filter) 4808 (dolist (x (append (get 'org-agenda-filter :preset-filter)
4809 org-agenda-filter))
4435 (if (member x '("-" "+")) 4810 (if (member x '("-" "+"))
4436 (setq f1 '(not tags)) 4811 (setq f1 '(not tags))
4437 (if (string-match "[<=>]" x) 4812 (if (string-match "[<=>?]" x)
4438 (setq f1 (org-agenda-filter-effort-form x)) 4813 (setq f1 (org-agenda-filter-effort-form x))
4439 (setq f1 (list 'member (downcase (substring x 1)) 'tags))) 4814 (setq f1 (list 'member (downcase (substring x 1)) 'tags)))
4440 (if (equal (string-to-char x) ?-) 4815 (if (equal (string-to-char x) ?-)
@@ -4448,7 +4823,10 @@ E looks line \"+<2:25\"."
4448 (let (op) 4823 (let (op)
4449 (setq e (substring e 1)) 4824 (setq e (substring e 1))
4450 (setq op (string-to-char e) e (substring e 1)) 4825 (setq op (string-to-char e) e (substring e 1))
4451 (setq op (if (equal op ?<) '<= (if (equal op ?>) '>= '=))) 4826 (setq op (cond ((equal op ?<) '<=)
4827 ((equal op ?>) '>=)
4828 ((equal op ??) op)
4829 (t '=)))
4452 (list 'org-agenda-compare-effort (list 'quote op) 4830 (list 'org-agenda-compare-effort (list 'quote op)
4453 (org-hh:mm-string-to-minutes e)))) 4831 (org-hh:mm-string-to-minutes e))))
4454 4832
@@ -4456,9 +4834,10 @@ E looks line \"+<2:25\"."
4456 "Compare the effort of the current line with VALUE, using OP. 4834 "Compare the effort of the current line with VALUE, using OP.
4457If the line does not have an effort defined, return nil." 4835If the line does not have an effort defined, return nil."
4458 (let ((eff (get-text-property (point) 'effort-minutes))) 4836 (let ((eff (get-text-property (point) 'effort-minutes)))
4459 (if (not eff) 4837 (if (equal op ??)
4460 0 ; we don't have an effort defined, treat as 0 4838 (not eff)
4461 (funcall op eff value)))) 4839 (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
4840 value))))
4462 4841
4463(defun org-agenda-filter-apply (filter) 4842(defun org-agenda-filter-apply (filter)
4464 "Set FILTER as the new agenda filter and apply it." 4843 "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."
4616 (interactive "p") 4995 (interactive "p")
4617 (org-agenda-later (- arg))) 4996 (org-agenda-later (- arg)))
4618 4997
4998(defun org-agenda-view-mode-dispatch ()
4999 "Call one of the view mode commands."
5000 (interactive)
5001 (message "View: [d]ay [w]eek [m]onth [y]ear [l]og [L]og-all [a]rch-trees [A]rch-files
5002 clock[R]eport time[G]rid include[D]iary")
5003 (let ((a (read-char-exclusive)))
5004 (case a
5005 (?d (call-interactively 'org-agenda-day-view))
5006 (?w (call-interactively 'org-agenda-week-view))
5007 (?m (call-interactively 'org-agenda-month-view))
5008 (?y (call-interactively 'org-agenda-year-view))
5009 (?l (call-interactively 'org-agenda-log-mode))
5010 (?a (call-interactively 'org-agenda-archives-mode))
5011 (?A (org-agenda-archives-mode 'files))
5012 (?R (call-interactively 'org-agenda-clockreport-mode))
5013 (?G (call-interactively 'org-agenda-toggle-time-grid))
5014 (?D (call-interactively 'org-agenda-toggle-diary))
5015 (?q (message "Abort"))
5016 (otherwise (error "Invalid key" )))))
5017
4619(defun org-agenda-day-view (&optional day-of-year) 5018(defun org-agenda-day-view (&optional day-of-year)
4620 "Switch to daily view for agenda. 5019 "Switch to daily view for agenda.
4621With argument DAY-OF-YEAR, switch to that day of the year." 5020With 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."
4800 (if org-agenda-show-log "on" "off"))) 5199 (if org-agenda-show-log "on" "off")))
4801 5200
4802(defun org-agenda-archives-mode (&optional with-files) 5201(defun org-agenda-archives-mode (&optional with-files)
4803 "Toggle log mode in an agenda buffer." 5202 "Toggle inclusion of items in trees marked with :ARCHIVE:.
5203When called with a prefix argument, include all archive files as well."
4804 (interactive "P") 5204 (interactive "P")
4805 (setq org-agenda-archives-mode 5205 (setq org-agenda-archives-mode
4806 (if with-files t (if org-agenda-archives-mode nil 'trees))) 5206 (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."
4848 (if org-agenda-use-time-grid " Grid" "") 5248 (if org-agenda-use-time-grid " Grid" "")
4849 (if (consp org-agenda-show-log) " LogAll" 5249 (if (consp org-agenda-show-log) " LogAll"
4850 (if org-agenda-show-log " Log" "")) 5250 (if org-agenda-show-log " Log" ""))
4851 (if org-agenda-filter 5251 (if (or org-agenda-filter (get 'org-agenda-filter
4852 (concat " {" (mapconcat 'identity org-agenda-filter "") "}") 5252 :preset-filter))
5253 (concat " {" (mapconcat
5254 'identity
5255 (append (get 'org-agenda-filter
5256 :preset-filter)
5257 org-agenda-filter) "") "}")
4853 "") 5258 "")
4854 (if org-agenda-archives-mode 5259 (if org-agenda-archives-mode
4855 (if (eq org-agenda-archives-mode t) 5260 (if (eq org-agenda-archives-mode t)
@@ -4998,11 +5403,33 @@ If this information is not given, the function uses the tree at point."
4998 (equal buf (marker-buffer m)) 5403 (equal buf (marker-buffer m))
4999 (setq p (marker-position m)) 5404 (setq p (marker-position m))
5000 (>= p beg) 5405 (>= p beg)
5001 (<= p end)) 5406 (< p end))
5002 (let ((inhibit-read-only t)) 5407 (let ((inhibit-read-only t))
5003 (delete-region (point-at-bol) (1+ (point-at-eol))))) 5408 (delete-region (point-at-bol) (1+ (point-at-eol)))))
5004 (beginning-of-line 0)))))) 5409 (beginning-of-line 0))))))
5005 5410
5411(defun org-agenda-refile (&optional goto rfloc)
5412 "Refile the item at point."
5413 (interactive "P")
5414 (let* ((marker (or (get-text-property (point) 'org-hd-marker)
5415 (org-agenda-error)))
5416 (buffer (marker-buffer marker))
5417 (pos (marker-position marker))
5418 (rfloc (or rfloc
5419 (org-refile-get-location
5420 (if goto "Goto: " "Refile to: ") buffer
5421 org-refile-allow-creating-parent-nodes))))
5422 (with-current-buffer buffer
5423 (save-excursion
5424 (save-restriction
5425 (widen)
5426 (goto-char marker)
5427 (org-remove-subtree-entries-from-agenda)
5428 (org-refile goto buffer rfloc))))))
5429
5430
5431
5432
5006(defun org-agenda-open-link () 5433(defun org-agenda-open-link ()
5007 "Follow the link in the current line, if any." 5434 "Follow the link in the current line, if any."
5008 (interactive) 5435 (interactive)
@@ -5054,6 +5481,78 @@ if it was hidden in the outline."
5054 (org-agenda-goto t)) 5481 (org-agenda-goto t))
5055 (select-window win))) 5482 (select-window win)))
5056 5483
5484(defun org-agenda-show-1 (&optional more)
5485 "Display the Org-mode file which contains the item at point.
5486The prefix arg causes further revieling:
5487
54880 hide the subtree
54891 just show the entry according to defaults.
54902 show the text below the heading
54913 show the entire subtree
54924 show the entire subtree and any LOGBOOK drawers
54935 show the entire subtree and any drawers
5494With prefix argument FULL-ENTRY, make the entire entry visible
5495if it was hidden in the outline."
5496 (interactive "p")
5497 (let ((win (selected-window)))
5498 (org-agenda-goto t)
5499 (org-recenter-heading 1)
5500 (cond
5501 ((= more 0)
5502 (hide-subtree)
5503 (message "Remote: hide subtree"))
5504 ((and (interactive-p) (= more 1))
5505 (message "Remote: show with default settings"))
5506 ((= more 2)
5507 (show-entry)
5508 (save-excursion
5509 (org-back-to-heading)
5510 (org-cycle-hide-drawers 'children))
5511 (message "Remote: show entry"))
5512 ((= more 3)
5513 (show-subtree)
5514 (save-excursion
5515 (org-back-to-heading)
5516 (org-cycle-hide-drawers 'subtree))
5517 (message "Remote: show subtree"))
5518 ((= more 4)
5519 (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers)))
5520 (org-drawer-regexp
5521 (concat "^[ \t]*:\\("
5522 (mapconcat 'regexp-quote org-drawers "\\|")
5523 "\\):[ \t]*$")))
5524 (show-subtree)
5525 (save-excursion
5526 (org-back-to-heading)
5527 (org-cycle-hide-drawers 'subtree)))
5528 (message "Remote: show subtree and LOGBOOK"))
5529 ((> more 4)
5530 (show-subtree)
5531 (message "Remote: show subtree and LOGBOOK")))
5532 (select-window win)))
5533
5534(defun org-recenter-heading (n)
5535 (save-excursion
5536 (org-back-to-heading)
5537 (recenter n)))
5538
5539(defvar org-agenda-cycle-counter nil)
5540(defun org-agenda-cycle-show (n)
5541 "Show the current entry in another window, with default settings.
5542Default settings are taken from `org-show-hierarchy-above' and siblings.
5543When use repeadedly in immediate succession, the remote entry will cycle
5544through visibility
5545
5546entry -> subtree -> subtree with logbook"
5547 (interactive "p")
5548 (when (and (= n 1)
5549 (not (eq last-command this-command)))
5550 (setq org-agenda-cycle-counter 0))
5551 (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter))
5552 (if (> org-agenda-cycle-counter 4)
5553 (setq org-agenda-cycle-counter 0))
5554 (org-agenda-show-1 org-agenda-cycle-counter))
5555
5057(defun org-agenda-recenter (arg) 5556(defun org-agenda-recenter (arg)
5058 "Display the Org-mode file which contains the item at point and recenter." 5557 "Display the Org-mode file which contains the item at point and recenter."
5059 (interactive "P") 5558 (interactive "P")
@@ -5266,6 +5765,8 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
5266This changes the line at point, all other lines in the agenda referring to 5765This changes the line at point, all other lines in the agenda referring to
5267the same tree node, and the headline of the tree node in the Org-mode file." 5766the same tree node, and the headline of the tree node in the Org-mode file."
5268 (interactive) 5767 (interactive)
5768 (unless org-enable-priority-commands
5769 (error "Priority commands are disabled"))
5269 (org-agenda-check-no-diary) 5770 (org-agenda-check-no-diary)
5270 (let* ((marker (or (get-text-property (point) 'org-marker) 5771 (let* ((marker (or (get-text-property (point) 'org-marker)
5271 (org-agenda-error))) 5772 (org-agenda-error)))
@@ -5289,7 +5790,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
5289 (beginning-of-line 1)))) 5790 (beginning-of-line 1))))
5290 5791
5291;; FIXME: should fix the tags property of the agenda line. 5792;; FIXME: should fix the tags property of the agenda line.
5292(defun org-agenda-set-tags () 5793(defun org-agenda-set-tags (&optional tag onoff)
5293 "Set tags for the current headline." 5794 "Set tags for the current headline."
5294 (interactive) 5795 (interactive)
5295 (org-agenda-check-no-diary) 5796 (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."
5312 (and (outline-next-heading) 5813 (and (outline-next-heading)
5313 (org-flag-heading nil))) ; show the next heading 5814 (org-flag-heading nil))) ; show the next heading
5314 (goto-char pos) 5815 (goto-char pos)
5315 (call-interactively 'org-set-tags) 5816 (if tag
5817 (org-toggle-tag tag onoff)
5818 (call-interactively 'org-set-tags))
5316 (end-of-line 1) 5819 (end-of-line 1)
5317 (setq newhead (org-get-heading))) 5820 (setq newhead (org-get-heading)))
5318 (org-agenda-change-all-lines newhead hdmarker) 5821 (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."
5343 (org-agenda-change-all-lines newhead hdmarker) 5846 (org-agenda-change-all-lines newhead hdmarker)
5344 (beginning-of-line 1)))) 5847 (beginning-of-line 1))))
5345 5848
5849(defun org-agenda-do-date-later (arg)
5850 (interactive "P")
5851 (cond
5852 ((or (equal arg '(16))
5853 (memq last-command
5854 '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
5855 (setq this-command 'org-agenda-date-later-minutes)
5856 (org-agenda-date-later-minutes 1))
5857 ((or (equal arg '(4))
5858 (memq last-command
5859 '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
5860 (setq this-command 'org-agenda-date-later-hours)
5861 (org-agenda-date-later-hours 1))
5862 (t
5863 (org-agenda-date-later (prefix-numeric-value arg)))))
5864
5865(defun org-agenda-do-date-earlier (arg)
5866 (interactive "P")
5867 (cond
5868 ((or (equal arg '(16))
5869 (memq last-command
5870 '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
5871 (setq this-command 'org-agenda-date-earlier-minutes)
5872 (org-agenda-date-earlier-minutes 1))
5873 ((or (equal arg '(4))
5874 (memq last-command
5875 '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
5876 (setq this-command 'org-agenda-date-earlier-hours)
5877 (org-agenda-date-earlier-hours 1))
5878 (t
5879 (org-agenda-date-earlier (prefix-numeric-value arg)))))
5880
5346(defun org-agenda-date-later (arg &optional what) 5881(defun org-agenda-date-later (arg &optional what)
5347 "Change the date of this item to one day later." 5882 "Change the date of this item to one day later."
5348 (interactive "p") 5883 (interactive "p")
@@ -5367,6 +5902,28 @@ the same tree node, and the headline of the tree node in the Org-mode file."
5367 (interactive "p") 5902 (interactive "p")
5368 (org-agenda-date-later (- arg) what)) 5903 (org-agenda-date-later (- arg) what))
5369 5904
5905(defun org-agenda-date-later-minutes (arg)
5906 "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
5907 (interactive "p")
5908 (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
5909 (org-agenda-date-later arg 'minute))
5910
5911(defun org-agenda-date-earlier-minutes (arg)
5912 "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
5913 (interactive "p")
5914 (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
5915 (org-agenda-date-earlier arg 'minute))
5916
5917(defun org-agenda-date-later-hours (arg)
5918 "Change the time of this item, in hour steps."
5919 (interactive "p")
5920 (org-agenda-date-later arg 'hour))
5921
5922(defun org-agenda-date-earlier-hours (arg)
5923 "Change the time of this item, in hour steps."
5924 (interactive "p")
5925 (org-agenda-date-earlier arg 'hour))
5926
5370(defun org-agenda-show-new-time (marker stamp &optional prefix) 5927(defun org-agenda-show-new-time (marker stamp &optional prefix)
5371 "Show new date stamp via text properties." 5928 "Show new date stamp via text properties."
5372 ;; We use text properties to make this undoable 5929 ;; We use text properties to make this undoable
@@ -5426,7 +5983,6 @@ be used to request time specification in the time stamp."
5426 (pos (marker-position marker)) 5983 (pos (marker-position marker))
5427 (org-insert-labeled-timestamps-at-point nil) 5984 (org-insert-labeled-timestamps-at-point nil)
5428 ts) 5985 ts)
5429 (when type (message "%s" type) (sit-for 3))
5430 (set-marker-insertion-type marker t) 5986 (set-marker-insertion-type marker t)
5431 (org-with-remote-undo buffer 5987 (org-with-remote-undo buffer
5432 (with-current-buffer buffer 5988 (with-current-buffer buffer
@@ -5539,15 +6095,26 @@ The cursor may be at a date in the calendar, or in the Org agenda."
5539 (org-cycle-hide-drawers 'children) 6095 (org-cycle-hide-drawers 'children)
5540 (org-clock-in arg) 6096 (org-clock-in arg)
5541 (setq newhead (org-get-heading))) 6097 (setq newhead (org-get-heading)))
5542 (org-agenda-change-all-lines newhead hdmarker t))))) 6098 (org-agenda-change-all-lines newhead hdmarker)))))
5543 6099
5544(defun org-agenda-clock-out (&optional arg) 6100(defun org-agenda-clock-out (&optional arg)
5545 "Stop the currently running clock." 6101 "Stop the currently running clock."
5546 (interactive "P") 6102 (interactive "P")
5547 (unless (marker-buffer org-clock-marker) 6103 (unless (marker-buffer org-clock-marker)
5548 (error "No running clock")) 6104 (error "No running clock"))
5549 (org-with-remote-undo (marker-buffer org-clock-marker) 6105 (let ((marker (make-marker)) newhead)
5550 (org-clock-out))) 6106 (org-with-remote-undo (marker-buffer org-clock-marker)
6107 (with-current-buffer (marker-buffer org-clock-marker)
6108 (save-excursion
6109 (save-restriction
6110 (widen)
6111 (goto-char org-clock-marker)
6112 (org-back-to-heading t)
6113 (move-marker marker (point))
6114 (org-clock-out)
6115 (setq newhead (org-get-heading))))))
6116 (org-agenda-change-all-lines newhead marker)
6117 (move-marker marker nil)))
5551 6118
5552(defun org-agenda-clock-cancel (&optional arg) 6119(defun org-agenda-clock-cancel (&optional arg)
5553 "Cancel the currently running clock." 6120 "Cancel the currently running clock."
@@ -5701,6 +6268,159 @@ This is a command that has to be installed in `calendar-mode-map'."
5701 (princ s)) 6268 (princ s))
5702 (org-fit-window-to-buffer (get-buffer-window "*Dates*")))) 6269 (org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
5703 6270
6271;;; Bulk commands
6272
6273(defvar org-agenda-bulk-marked-entries nil
6274 "List of markers that refer to marked entries in the agenda.")
6275
6276(defun org-agenda-bulk-mark ()
6277 "Mark the entry at point for future bulk action."
6278 (interactive)
6279 (org-agenda-check-no-diary)
6280 (let* ((m (get-text-property (point) 'org-hd-marker))
6281 ov)
6282 (unless (eq (get-char-property (point-at-bol) 'type)
6283 'org-marked-entry-overlay)
6284 (unless m (error "Nothing to mark at point"))
6285 (push m org-agenda-bulk-marked-entries)
6286 (setq ov (org-make-overlay (point-at-bol) (+ 2 (point-at-bol))))
6287 (org-overlay-display ov ">>"
6288 (org-get-todo-face "TODO")
6289 'evaporate)
6290 (org-overlay-put ov 'type 'org-marked-entry-overlay))
6291 (beginning-of-line 2)
6292 (message "%d entries marked for bulk action"
6293 (length org-agenda-bulk-marked-entries))))
6294
6295(defun org-agenda-bulk-unmark ()
6296 "Unmark the entry at point for future bulk action."
6297 (interactive)
6298 (when (eq (get-char-property (point-at-bol) 'type)
6299 'org-marked-entry-overlay)
6300 (org-agenda-bulk-remove-overlays
6301 (point-at-bol) (+ 2 (point-at-bol)))
6302 (setq org-agenda-bulk-marked-entries
6303 (delete (get-text-property (point-at-bol) 'org-hd-marker)
6304 org-agenda-bulk-marked-entries)))
6305 (beginning-of-line 2)
6306 (message "%d entries marked for bulk action"
6307 (length org-agenda-bulk-marked-entries)))
6308
6309
6310(defun org-agenda-bulk-remove-overlays (&optional beg end)
6311 "Remove the mark overlays between BEG and END in the agenda buffer.
6312BEG and END default to the buffer limits.
6313
6314This only removes the overlays, it does not remove the markers
6315from the list in `org-agenda-bulk-marked-entries'."
6316 (interactive)
6317 (mapc (lambda (ov)
6318 (and (eq (org-overlay-get ov 'type) 'org-marked-entry-overlay)
6319 (org-delete-overlay ov)))
6320 (org-overlays-in (or beg (point-min)) (or end (point-max)))))
6321
6322(defun org-agenda-bulk-remove-all-marks ()
6323 "Remove all marks in the agenda buffer.
6324This will remove the markers, and the overlays."
6325 (interactive)
6326 (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries)
6327 (setq org-agenda-bulk-marked-entries nil)
6328 (org-agenda-bulk-remove-overlays (point-min) (point-max)))
6329
6330(defun org-agenda-bulk-action ()
6331 "Execute an remote-editing action on all marked entries."
6332 (interactive)
6333 (unless org-agenda-bulk-marked-entries
6334 (error "No entries are marked"))
6335 (message "Bulk: [r]efile [$]archive [A]rch->sib [t]odo [+/-]tag [s]chedule [d]eadline")
6336 (let* ((action (read-char-exclusive))
6337 (entries (reverse org-agenda-bulk-marked-entries))
6338 cmd rfloc state e tag pos (cnt 0) (cntskip 0))
6339 (cond
6340 ((equal action ?$)
6341 (setq cmd '(org-agenda-archive)))
6342
6343 ((equal action ?A)
6344 (setq cmd '(org-agenda-archive-to-archive-sibling)))
6345
6346 ((member action '(?r ?w))
6347 (setq rfloc (org-refile-get-location
6348 "Refile to: "
6349 (marker-buffer (car org-agenda-bulk-marked-entries))
6350 org-refile-allow-creating-parent-nodes))
6351 (setcar (nthcdr 3 rfloc)
6352 (move-marker (make-marker) (nth 3 rfloc)
6353 (or (get-file-buffer (nth 1 rfloc))
6354 (find-buffer-visiting (nth 1 rfloc))
6355 (error "This should not happen"))))
6356
6357 (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc))))
6358
6359 ((equal action ?t)
6360 (setq state (org-ido-completing-read
6361 "Todo state: "
6362 (with-current-buffer (marker-buffer (car entries))
6363 (mapcar 'list org-todo-keywords-1))))
6364 (setq cmd `(let ((org-inhibit-blocking t)
6365 (org-inhibit-logging 'note))
6366 (org-agenda-todo ,state))))
6367
6368 ((memq action '(?- ?+))
6369 (setq tag (org-ido-completing-read
6370 (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
6371 (with-current-buffer (marker-buffer (car entries))
6372 (delq nil
6373 (mapcar (lambda (x)
6374 (if (stringp (car x)) x)) org-tag-alist)))))
6375 (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
6376
6377 ((memq action '(?s ?d))
6378 (let* ((date (org-read-date
6379 nil nil nil
6380 (if (eq action ?s) "(Re)Schedule to" "Set Deadline to")))
6381 (ans org-read-date-final-answer)
6382 (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline)))
6383 (setq cmd `(let* ((bound (fboundp 'read-string))
6384 (old (and bound (symbol-function 'read-string))))
6385 (unwind-protect
6386 (progn
6387 (fset 'read-string (lambda (&rest ignore) ,ans))
6388 (call-interactively ',c1))
6389 (if bound
6390 (fset 'read-string old)
6391 (fmakunbound 'read-string)))))))
6392 (t (error "Invalid bulk action")))
6393
6394 ;; Sort the markers, to make sure that parents are handled before children
6395 (setq entries (sort entries
6396 (lambda (a b)
6397 (cond
6398 ((equal (marker-buffer a) (marker-buffer b))
6399 (< (marker-position a) (marker-position b)))
6400 (t
6401 (string< (buffer-name (marker-buffer a))
6402 (buffer-name (marker-buffer b))))))))
6403
6404 ;; Now loop over all markers and apply cmd
6405 (while (setq e (pop entries))
6406 (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e))
6407 (if (not pos)
6408 (progn (message "Skipping removed entry at %s" e)
6409 (setq cntskip (1+ cntskip)))
6410 (goto-char pos)
6411 (eval cmd)
6412 (setq org-agenda-bulk-marked-entries
6413 (delete e org-agenda-bulk-marked-entries))
6414 (setq cnt (1+ cnt))))
6415 (setq org-agenda-bulk-marked-entries nil)
6416 (org-agenda-bulk-remove-all-marks)
6417 (message "Acted on %d entries%s"
6418 cnt
6419 (if (= cntskip 0)
6420 ""
6421 (format ", skipped %d (disappeared before their turn)"
6422 cntskip)))))
6423
5704;;; Appointment reminders 6424;;; Appointment reminders
5705 6425
5706(defvar appt-time-msg-list) 6426(defvar appt-time-msg-list)
@@ -5735,6 +6455,7 @@ belonging to the \"Work\" category."
5735 (org-deadline-warning-days 0) 6455 (org-deadline-warning-days 0)
5736 (today (org-date-to-gregorian 6456 (today (org-date-to-gregorian
5737 (time-to-days (current-time)))) 6457 (time-to-days (current-time))))
6458 (org-agenda-restrict nil)
5738 (files (org-agenda-files 'unrestricted)) entries file) 6459 (files (org-agenda-files 'unrestricted)) entries file)
5739 ;; Get all entries which may contain an appt 6460 ;; Get all entries which may contain an appt
5740 (org-prepare-agenda-buffers files) 6461 (org-prepare-agenda-buffers files)
@@ -5788,4 +6509,3 @@ belonging to the \"Work\" category."
5788;; arch-tag: 77f7565d-7c4b-44af-a2df-9f6f7070cff1 6509;; arch-tag: 77f7565d-7c4b-44af-a2df-9f6f7070cff1
5789 6510
5790;;; org-agenda.el ends here 6511;;; org-agenda.el ends here
5791
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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -32,6 +32,8 @@
32 32
33(require 'org) 33(require 'org)
34 34
35(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
36
35(defcustom org-archive-sibling-heading "Archive" 37(defcustom org-archive-sibling-heading "Archive"
36 "Name of the local archive sibling that is used to archive entries locally. 38 "Name of the local archive sibling that is used to archive entries locally.
37Locally means: in the tree, under a sibling. 39Locally means: in the tree, under a sibling.
@@ -270,7 +272,7 @@ this heading."
270 ;; No specific heading, just go to end of file. 272 ;; No specific heading, just go to end of file.
271 (goto-char (point-max)) (insert "\n")) 273 (goto-char (point-max)) (insert "\n"))
272 ;; Paste 274 ;; Paste
273 (org-paste-subtree (org-get-valid-level level 1)) 275 (org-paste-subtree (org-get-valid-level level (and heading 1)))
274 276
275 ;; Mark the entry as done 277 ;; Mark the entry as done
276 (when (and org-archive-mark-done 278 (when (and org-archive-mark-done
@@ -303,12 +305,16 @@ this heading."
303 ;; Here we are back in the original buffer. Everything seems to have 305 ;; Here we are back in the original buffer. Everything seems to have
304 ;; worked. So now cut the tree and finish up. 306 ;; worked. So now cut the tree and finish up.
305 (let (this-command) (org-cut-subtree)) 307 (let (this-command) (org-cut-subtree))
308 (when (featurep 'org-inlinetask)
309 (org-inlinetask-remove-END-maybe))
306 (setq org-markers-to-move nil) 310 (setq org-markers-to-move nil)
307 (message "Subtree archived %s" 311 (message "Subtree archived %s"
308 (if (eq this-buffer buffer) 312 (if (eq this-buffer buffer)
309 (concat "under heading: " heading) 313 (concat "under heading: " heading)
310 (concat "in file: " (abbreviate-file-name afile)))))) 314 (concat "in file: " (abbreviate-file-name afile))))))
311 (org-reveal)) 315 (org-reveal)
316 (if (looking-at "^[ \t]*$")
317 (outline-next-visible-heading 1)))
312 318
313(defun org-archive-to-archive-sibling () 319(defun org-archive-to-archive-sibling ()
314 "Archive the current heading by moving it under the archive sibling. 320 "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."
360 (hide-subtree) 366 (hide-subtree)
361 (org-cycle-show-empty-lines 'folded) 367 (org-cycle-show-empty-lines 'folded)
362 (goto-char pos))) 368 (goto-char pos)))
363 (org-reveal)) 369 (org-reveal)
370 (if (looking-at "^[ \t]*$")
371 (outline-next-visible-heading 1)))
364 372
365(defun org-archive-all-done (&optional tag) 373(defun org-archive-all-done (&optional tag)
366 "Archive sublevels of the current tree without open TODO items. 374 "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 @@
1;;; org-ascii.el --- ASCII export for Org-mode
2
3;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
4;; Free Software Foundation, Inc.
5
6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org
9;; Version: 6.29c
10;;
11;; This file is part of GNU Emacs.
12;;
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;
27;;; Commentary:
28
29(require 'org-exp)
30
31(defgroup org-export-ascii nil
32 "Options specific for ASCII export of Org-mode files."
33 :tag "Org Export ASCII"
34 :group 'org-export)
35
36(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-)
37 "Characters for underlining headings in ASCII export.
38In the given sequence, these characters will be used for level 1, 2, ..."
39 :group 'org-export-ascii
40 :type '(repeat character))
41
42(defcustom org-export-ascii-bullets '(?* ?+ ?-)
43 "Bullet characters for headlines converted to lists in ASCII export.
44The first character is used for the first lest level generated in this
45way, and so on. If there are more levels than characters given here,
46the list will be repeated.
47Note that plain lists will keep the same bullets as the have in the
48Org-mode file."
49 :group 'org-export-ascii
50 :type '(repeat character))
51
52(defcustom org-export-ascii-links-to-notes t
53 "Non-nil means, convert links to notes before the next headline.
54When nil, the link will be exported in place. If the line becomes long
55in this way, it will be wrapped."
56 :group 'org-export-ascii
57 :type 'boolean)
58
59;;; ASCII export
60
61(defvar org-ascii-current-indentation nil) ; For communication
62
63;;;###autoload
64(defun org-export-as-ascii-to-buffer (arg)
65 "Call `org-export-as-ascii` with output to a temporary buffer.
66No file is created. The prefix ARG is passed through to `org-export-as-ascii'."
67 (interactive "P")
68 (org-export-as-ascii arg nil nil "*Org ASCII Export*")
69 (when org-export-show-temporary-export-buffer
70 (switch-to-buffer-other-window "*Org ASCII Export*")))
71
72;;;###autoload
73(defun org-replace-region-by-ascii (beg end)
74 "Assume the current region has org-mode syntax, and convert it to plain ASCII.
75This can be used in any buffer. For example, you could write an
76itemized list in org-mode syntax in a Mail buffer and then use this
77command to convert it."
78 (interactive "r")
79 (let (reg ascii buf pop-up-frames)
80 (save-window-excursion
81 (if (org-mode-p)
82 (setq ascii (org-export-region-as-ascii
83 beg end t 'string))
84 (setq reg (buffer-substring beg end)
85 buf (get-buffer-create "*Org tmp*"))
86 (with-current-buffer buf
87 (erase-buffer)
88 (insert reg)
89 (org-mode)
90 (setq ascii (org-export-region-as-ascii
91 (point-min) (point-max) t 'string)))
92 (kill-buffer buf)))
93 (delete-region beg end)
94 (insert ascii)))
95
96;;;###autoload
97(defun org-export-region-as-ascii (beg end &optional body-only buffer)
98 "Convert region from BEG to END in org-mode buffer to plain ASCII.
99If prefix arg BODY-ONLY is set, omit file header, footer, and table of
100contents, and only produce the region of converted text, useful for
101cut-and-paste operations.
102If BUFFER is a buffer or a string, use/create that buffer as a target
103of the converted ASCII. If BUFFER is the symbol `string', return the
104produced ASCII as a string and leave not buffer behind. For example,
105a Lisp program could call this function in the following way:
106
107 (setq ascii (org-export-region-as-ascii beg end t 'string))
108
109When called interactively, the output buffer is selected, and shown
110in a window. A non-interactive call will only return the buffer."
111 (interactive "r\nP")
112 (when (interactive-p)
113 (setq buffer "*Org ASCII Export*"))
114 (let ((transient-mark-mode t) (zmacs-regions t)
115 ext-plist rtn)
116 (setq ext-plist (plist-put ext-plist :ignore-subree-p t))
117 (goto-char end)
118 (set-mark (point)) ;; to activate the region
119 (goto-char beg)
120 (setq rtn (org-export-as-ascii
121 nil nil ext-plist
122 buffer body-only))
123 (if (fboundp 'deactivate-mark) (deactivate-mark))
124 (if (and (interactive-p) (bufferp rtn))
125 (switch-to-buffer-other-window rtn)
126 rtn)))
127
128;;;###autoload
129(defun org-export-as-ascii (arg &optional hidden ext-plist
130 to-buffer body-only pub-dir)
131 "Export the outline as a pretty ASCII file.
132If there is an active region, export only the region.
133The prefix ARG specifies how many levels of the outline should become
134underlined headlines, default is 3. Lower levels will become bulleted
135lists. When HIDDEN is non-nil, don't display the ASCII buffer.
136EXT-PLIST is a property list with external parameters overriding
137org-mode's default settings, but still inferior to file-local
138settings. When TO-BUFFER is non-nil, create a buffer with that
139name and export to that buffer. If TO-BUFFER is the symbol
140`string', don't leave any buffer behind but just return the
141resulting ASCII as a string. When BODY-ONLY is set, don't produce
142the file header and footer. When PUB-DIR is set, use this as the
143publishing directory."
144 (interactive "P")
145 (setq-default org-todo-line-regexp org-todo-line-regexp)
146 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
147 ext-plist
148 (org-infile-export-plist)))
149 (region-p (org-region-active-p))
150 (rbeg (and region-p (region-beginning)))
151 (rend (and region-p (region-end)))
152 (subtree-p
153 (if (plist-get opt-plist :ignore-subree-p)
154 nil
155 (when region-p
156 (save-excursion
157 (goto-char rbeg)
158 (and (org-at-heading-p)
159 (>= (org-end-of-subtree t t) rend))))))
160 (level-offset (if subtree-p
161 (save-excursion
162 (goto-char rbeg)
163 (+ (funcall outline-level)
164 (if org-odd-levels-only 1 0)))
165 0))
166 (opt-plist (setq org-export-opt-plist
167 (if subtree-p
168 (org-export-add-subtree-options opt-plist rbeg)
169 opt-plist)))
170 (custom-times org-display-custom-times)
171 (org-ascii-current-indentation '(0 . 0))
172 (level 0) line txt
173 (umax nil)
174 (umax-toc nil)
175 (case-fold-search nil)
176 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
177 (filename (if to-buffer
178 nil
179 (concat (file-name-as-directory
180 (or pub-dir
181 (org-export-directory :ascii opt-plist)))
182 (file-name-sans-extension
183 (or (and subtree-p
184 (org-entry-get (region-beginning)
185 "EXPORT_FILE_NAME" t))
186 (file-name-nondirectory bfname)))
187 ".txt")))
188 (filename (and filename
189 (if (equal (file-truename filename)
190 (file-truename bfname))
191 (concat filename ".txt")
192 filename)))
193 (buffer (if to-buffer
194 (cond
195 ((eq to-buffer 'string)
196 (get-buffer-create "*Org ASCII Export*"))
197 (t (get-buffer-create to-buffer)))
198 (find-file-noselect filename)))
199 (org-levels-open (make-vector org-level-max nil))
200 (odd org-odd-levels-only)
201 (date (plist-get opt-plist :date))
202 (author (plist-get opt-plist :author))
203 (title (or (and subtree-p (org-export-get-title-from-subtree))
204 (plist-get opt-plist :title)
205 (and (not
206 (plist-get opt-plist :skip-before-1st-heading))
207 (org-export-grab-title-from-buffer))
208 (file-name-sans-extension
209 (file-name-nondirectory bfname))))
210 (email (plist-get opt-plist :email))
211 (language (plist-get opt-plist :language))
212 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
213 (todo nil)
214 (lang-words nil)
215 (region
216 (buffer-substring
217 (if (org-region-active-p) (region-beginning) (point-min))
218 (if (org-region-active-p) (region-end) (point-max))))
219 (lines (org-split-string
220 (org-export-preprocess-string
221 region
222 :for-ascii t
223 :skip-before-1st-heading
224 (plist-get opt-plist :skip-before-1st-heading)
225 :drawers (plist-get opt-plist :drawers)
226 :tags (plist-get opt-plist :tags)
227 :priority (plist-get opt-plist :priority)
228 :footnotes (plist-get opt-plist :footnotes)
229 :timestamps (plist-get opt-plist :timestamps)
230 :todo-keywords (plist-get opt-plist :todo-keywords)
231 :verbatim-multiline t
232 :select-tags (plist-get opt-plist :select-tags)
233 :exclude-tags (plist-get opt-plist :exclude-tags)
234 :archived-trees
235 (plist-get opt-plist :archived-trees)
236 :add-text (plist-get opt-plist :text))
237 "\n"))
238 thetoc have-headings first-heading-pos
239 table-open table-buffer link-buffer link desc desc0 rpl wrap)
240 (let ((inhibit-read-only t))
241 (org-unmodified
242 (remove-text-properties (point-min) (point-max)
243 '(:org-license-to-kill t))))
244
245 (setq org-min-level (org-get-min-level lines level-offset))
246 (setq org-last-level org-min-level)
247 (org-init-section-numbers)
248 (setq lang-words (or (assoc language org-export-language-setup)
249 (assoc "en" org-export-language-setup)))
250 (set-buffer buffer)
251 (erase-buffer)
252 (fundamental-mode)
253 (org-install-letbind)
254 ;; create local variables for all options, to make sure all called
255 ;; functions get the correct information
256 (mapc (lambda (x)
257 (set (make-local-variable (nth 2 x))
258 (plist-get opt-plist (car x))))
259 org-export-plist-vars)
260 (org-set-local 'org-odd-levels-only odd)
261 (setq umax (if arg (prefix-numeric-value arg)
262 org-export-headline-levels))
263 (setq umax-toc (if (integerp org-export-with-toc)
264 (min org-export-with-toc umax)
265 umax))
266
267 ;; File header
268 (unless body-only
269 (if title (org-insert-centered title ?=))
270 (insert "\n")
271 (if (and (or author email)
272 org-export-author-info)
273 (insert (concat (nth 1 lang-words) ": " (or author "")
274 (if email (concat " <" email ">") "")
275 "\n")))
276
277 (cond
278 ((and date (string-match "%" date))
279 (setq date (format-time-string date)))
280 (date)
281 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
282
283 (if (and date org-export-time-stamp-file)
284 (insert (concat (nth 2 lang-words) ": " date"\n")))
285
286 (insert "\n\n"))
287
288 (if (and org-export-with-toc (not body-only))
289 (progn
290 (push (concat (nth 3 lang-words) "\n") thetoc)
291 (push (concat (make-string (string-width (nth 3 lang-words)) ?=)
292 "\n") thetoc)
293 (mapc '(lambda (line)
294 (if (string-match org-todo-line-regexp
295 line)
296 ;; This is a headline
297 (progn
298 (setq have-headings t)
299 (setq level (- (match-end 1) (match-beginning 1)
300 level-offset)
301 level (org-tr-level level)
302 txt (match-string 3 line)
303 todo
304 (or (and org-export-mark-todo-in-toc
305 (match-beginning 2)
306 (not (member (match-string 2 line)
307 org-done-keywords)))
308 ; TODO, not DONE
309 (and org-export-mark-todo-in-toc
310 (= level umax-toc)
311 (org-search-todo-below
312 line lines level))))
313 (setq txt (org-html-expand-for-ascii txt))
314
315 (while (string-match org-bracket-link-regexp txt)
316 (setq txt
317 (replace-match
318 (match-string (if (match-end 2) 3 1) txt)
319 t t txt)))
320
321 (if (and (memq org-export-with-tags '(not-in-toc nil))
322 (string-match
323 (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
324 txt))
325 (setq txt (replace-match "" t t txt)))
326 (if (string-match quote-re0 txt)
327 (setq txt (replace-match "" t t txt)))
328
329 (if org-export-with-section-numbers
330 (setq txt (concat (org-section-number level)
331 " " txt)))
332 (if (<= level umax-toc)
333 (progn
334 (push
335 (concat
336 (make-string
337 (* (max 0 (- level org-min-level)) 4) ?\ )
338 (format (if todo "%s (*)\n" "%s\n") txt))
339 thetoc)
340 (setq org-last-level level))
341 ))))
342 lines)
343 (setq thetoc (if have-headings (nreverse thetoc) nil))))
344
345 (org-init-section-numbers)
346 (while (setq line (pop lines))
347 (when (and link-buffer (string-match "^\\*+ " line))
348 (org-export-ascii-push-links (nreverse link-buffer))
349 (setq link-buffer nil))
350 (setq wrap nil)
351 ;; Remove the quoted HTML tags.
352 (setq line (org-html-expand-for-ascii line))
353 ;; Replace links with the description when possible
354 (while (string-match org-bracket-link-regexp line)
355 (setq link (match-string 1 line)
356 desc0 (match-string 3 line)
357 desc (or desc0 (match-string 1 line)))
358 (if (and (> (length link) 8)
359 (equal (substring link 0 8) "coderef:"))
360 (setq line (replace-match
361 (format (org-export-get-coderef-format (substring link 8) desc)
362 (cdr (assoc
363 (substring link 8)
364 org-export-code-refs)))
365 t t line))
366 (setq rpl (concat "["
367 (or (match-string 3 line) (match-string 1 line))
368 "]"))
369 (when (and desc0 (not (equal desc0 link)))
370 (if org-export-ascii-links-to-notes
371 (push (cons desc0 link) link-buffer)
372 (setq rpl (concat rpl " (" link ")")
373 wrap (+ (length line) (- (length (match-string 0 line)))
374 (length desc)))))
375 (setq line (replace-match rpl t t line))))
376 (when custom-times
377 (setq line (org-translate-time line)))
378 (cond
379 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
380 ;; a Headline
381 (setq first-heading-pos (or first-heading-pos (point)))
382 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
383 level-offset))
384 txt (match-string 2 line))
385 (org-ascii-level-start level txt umax lines))
386
387 ((and org-export-with-tables
388 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
389 (if (not table-open)
390 ;; New table starts
391 (setq table-open t table-buffer nil))
392 ;; Accumulate lines
393 (setq table-buffer (cons line table-buffer))
394 (when (or (not lines)
395 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
396 (car lines))))
397 (setq table-open nil
398 table-buffer (nreverse table-buffer))
399 (insert (mapconcat
400 (lambda (x)
401 (org-fix-indentation x org-ascii-current-indentation))
402 (org-format-table-ascii table-buffer)
403 "\n") "\n")))
404 (t
405 (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
406 (setq line (replace-match "\\1\\3:" t nil line)))
407 (setq line (org-fix-indentation line org-ascii-current-indentation))
408 ;; Remove forced line breaks
409 (if (string-match "\\\\\\\\[ \t]*$" line)
410 (setq line (replace-match "" t t line)))
411 (if (and org-export-with-fixed-width
412 (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line))
413 (setq line (replace-match "\\1" nil nil line))
414 (if wrap (setq line (org-export-ascii-wrap line wrap))))
415 (insert line "\n"))))
416
417 (org-export-ascii-push-links (nreverse link-buffer))
418
419 (normal-mode)
420
421 ;; insert the table of contents
422 (when thetoc
423 (goto-char (point-min))
424 (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
425 (progn
426 (goto-char (match-beginning 0))
427 (replace-match ""))
428 (goto-char first-heading-pos))
429 (mapc 'insert thetoc)
430 (or (looking-at "[ \t]*\n[ \t]*\n")
431 (insert "\n\n")))
432
433 ;; Convert whitespace place holders
434 (goto-char (point-min))
435 (let (beg end)
436 (while (setq beg (next-single-property-change (point) 'org-whitespace))
437 (setq end (next-single-property-change beg 'org-whitespace))
438 (goto-char beg)
439 (delete-region beg end)
440 (insert (make-string (- end beg) ?\ ))))
441
442 ;; remove display and invisible chars
443 (let (beg end)
444 (goto-char (point-min))
445 (while (setq beg (next-single-property-change (point) 'display))
446 (setq end (next-single-property-change beg 'display))
447 (delete-region beg end)
448 (goto-char beg)
449 (insert "=>"))
450 (goto-char (point-min))
451 (while (setq beg (next-single-property-change (point) 'org-cwidth))
452 (setq end (next-single-property-change beg 'org-cwidth))
453 (delete-region beg end)
454 (goto-char beg)))
455 (or to-buffer (save-buffer))
456 (goto-char (point-min))
457 (or (org-export-push-to-kill-ring "ASCII")
458 (message "Exporting... done"))
459 ;; Return the buffer or a string, according to how this function was called
460 (if (eq to-buffer 'string)
461 (prog1 (buffer-substring (point-min) (point-max))
462 (kill-buffer (current-buffer)))
463 (current-buffer))))
464
465(defun org-export-ascii-preprocess (parameters)
466 "Do extra work for ASCII export"
467 ;; Put quotes around verbatim text
468 (goto-char (point-min))
469 (while (re-search-forward org-verbatim-re nil t)
470 (goto-char (match-end 2))
471 (backward-delete-char 1) (insert "'")
472 (goto-char (match-beginning 2))
473 (delete-char 1) (insert "`")
474 (goto-char (match-end 2)))
475 ;; Remove target markers
476 (goto-char (point-min))
477 (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
478 (replace-match "\\1\\2")))
479
480(defun org-html-expand-for-ascii (line)
481 "Handle quoted HTML for ASCII export."
482 (if org-export-html-expand
483 (while (string-match "@<[^<>\n]*>" line)
484 ;; We just remove the tags for now.
485 (setq line (replace-match "" nil nil line))))
486 line)
487
488(defun org-export-ascii-wrap (line where)
489 "Wrap LINE at or before WHERE."
490 (let ((ind (org-get-indentation line))
491 pos)
492 (catch 'found
493 (loop for i from where downto (/ where 2) do
494 (and (equal (aref line i) ?\ )
495 (setq pos i)
496 (throw 'found t))))
497 (if pos
498 (concat (substring line 0 pos) "\n"
499 (make-string ind ?\ )
500 (substring line (1+ pos)))
501 line)))
502
503(defun org-export-ascii-push-links (link-buffer)
504 "Push out links in the buffer."
505 (when link-buffer
506 ;; We still have links to push out.
507 (insert "\n")
508 (let ((ind ""))
509 (save-match-data
510 (if (save-excursion
511 (re-search-backward
512 "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t))
513 (setq ind (or (match-string 2)
514 (make-string (length (match-string 3)) ?\ )))))
515 (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
516 link-buffer))
517 (insert "\n")))
518
519(defun org-ascii-level-start (level title umax &optional lines)
520 "Insert a new level in ASCII export."
521 (let (char (n (- level umax 1)) (ind 0))
522 (if (> level umax)
523 (progn
524 (insert (make-string (* 2 n) ?\ )
525 (char-to-string (nth (% n (length org-export-ascii-bullets))
526 org-export-ascii-bullets))
527 " " title "\n")
528 ;; find the indentation of the next non-empty line
529 (catch 'stop
530 (while lines
531 (if (string-match "^\\* " (car lines)) (throw 'stop nil))
532 (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
533 (throw 'stop (setq ind (org-get-indentation (car lines)))))
534 (pop lines)))
535 (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind)))
536 (if (or (not (equal (char-before) ?\n))
537 (not (equal (char-before (1- (point))) ?\n)))
538 (insert "\n"))
539 (setq char (nth (- umax level) (reverse org-export-ascii-underline)))
540 (unless org-export-with-tags
541 (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
542 (setq title (replace-match "" t t title))))
543 (if org-export-with-section-numbers
544 (setq title (concat (org-section-number level) " " title)))
545 (insert title "\n" (make-string (string-width title) char) "\n")
546 (setq org-ascii-current-indentation '(0 . 0)))))
547
548(defun org-insert-centered (s &optional underline)
549 "Insert the string S centered and underline it with character UNDERLINE."
550 (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
551 (insert (make-string ind ?\ ) s "\n")
552 (if underline
553 (insert (make-string ind ?\ )
554 (make-string (string-width s) underline)
555 "\n"))))
556
557(defvar org-table-colgroup-info nil)
558(defun org-format-table-ascii (lines)
559 "Format a table for ascii export."
560 (if (stringp lines)
561 (setq lines (org-split-string lines "\n")))
562 (if (not (string-match "^[ \t]*|" (car lines)))
563 ;; Table made by table.el - test for spanning
564 lines
565
566 ;; A normal org table
567 ;; Get rid of hlines at beginning and end
568 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
569 (setq lines (nreverse lines))
570 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
571 (setq lines (nreverse lines))
572 (when org-export-table-remove-special-lines
573 ;; Check if the table has a marking column. If yes remove the
574 ;; column and the special lines
575 (setq lines (org-table-clean-before-export lines)))
576 ;; Get rid of the vertical lines except for grouping
577 (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
578 rtn line vl1 start)
579 (while (setq line (pop lines))
580 (if (string-match org-table-hline-regexp line)
581 (and (string-match "|\\(.*\\)|" line)
582 (setq line (replace-match " \\1" t nil line)))
583 (setq start 0 vl1 vl)
584 (while (string-match "|" line start)
585 (setq start (match-end 0))
586 (or (pop vl1) (setq line (replace-match " " t t line)))))
587 (push line rtn))
588 (nreverse rtn))))
589
590(defun org-colgroup-info-to-vline-list (info)
591 (let (vl new last)
592 (while info
593 (setq last new new (pop info))
594 (if (or (memq last '(:end :startend))
595 (memq new '(:start :startend)))
596 (push t vl)
597 (push nil vl)))
598 (setq vl (nreverse vl))
599 (and vl (setcar vl nil))
600 vl))
601
602(provide 'org-ascii)
603
604;; arch-tag: aa96f882-f477-4e13-86f5-70d43e7adf3c
605
606;;; 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 @@
4 4
5;; Author: John Wiegley <johnw@newartisans.com> 5;; Author: John Wiegley <johnw@newartisans.com>
6;; Keywords: org data task 6;; Keywords: org data task
7;; Version: 6.21b 7;; Version: 6.29c
8 8
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
10;; 10;;
@@ -26,7 +26,7 @@
26;; See the Org-mode manual for information on how to use it. 26;; See the Org-mode manual for information on how to use it.
27;; 27;;
28;; Attachments are managed in a special directory called "data", which 28;; Attachments are managed in a special directory called "data", which
29;; lives in the directory given by `org-directory'. If this data 29;; lives in the same directory as the org file itself. If this data
30;; directory is initialized as a Git repository, then org-attach will 30;; directory is initialized as a Git repository, then org-attach will
31;; automatically commit changes when it sees them. 31;; automatically commit changes when it sees them.
32;; 32;;
@@ -95,7 +95,7 @@ ln create a hard link. Note that this is not supported
95 "Non-nil means, allow attachment directories be inherited." 95 "Non-nil means, allow attachment directories be inherited."
96 :group 'org-attach 96 :group 'org-attach
97 :type 'boolean) 97 :type 'boolean)
98 98
99 99
100(defvar org-attach-inherited nil 100(defvar org-attach-inherited nil
101 "Indicates if the last access to the attachment directory was inherited.") 101 "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 @@
7;; Thomas Baumann <thomas dot baumann at ch dot tum dot de> 7;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
8;; Keywords: outlines, hypermedia, calendar, wp 8;; Keywords: outlines, hypermedia, calendar, wp
9;; Homepage: http://orgmode.org 9;; Homepage: http://orgmode.org
10;; Version: 6.21b 10;; Version: 6.29c
11;; 11;;
12;; This file is part of GNU Emacs. 12;; This file is part of GNU Emacs.
13;; 13;;
@@ -49,25 +49,37 @@
49;; %%(org-bbdb-anniversaries) 49;; %%(org-bbdb-anniversaries)
50;; 50;;
51;; 51;;
52;; The anniversaries are stored in BBDB in the field `anniversary' 52;; To add an anniversary to a BBDB record, press `C-o' in the record.
53;; in the format 53;; You will be prompted for the field name, in this case it must be
54;; "anniversary". If this is the first time you are using this field,
55;; you need to confirm that it should be created.
54;; 56;;
55;; YYYY-MM-DD{ CLASS-OR-FORMAT-STRING}* 57;; The format of an anniversary field stored in BBDB is the following
56;; {\nYYYY-MM-DD CLASS-OR-FORMAT-STRING}* 58;; (items in {} are optional):
59;;
60;; YYYY-MM-DD{ CLASS-OR-FORMAT-STRING}
61;; {\nYYYY-MM-DD CLASS-OR-FORMAT-STRING}...
57;; 62;;
58;; CLASS-OR-FORMAT-STRING is one of two things: 63;; CLASS-OR-FORMAT-STRING is one of two things:
59;; 64;;
60;; * an identifier for a class of anniversaries (eg. birthday or 65;; - an identifier for a class of anniversaries (eg. birthday or
61;; wedding) from `org-bbdb-anniversary-format-alist'. 66;; wedding) from `org-bbdb-anniversary-format-alist' which then
62;; * the (format) string displayed in the diary. 67;; defines the format tring for this class
68;; - the (format) string displayed in the diary.
69;;
70;; You can enter multiple anniversaries for a single BBDB record by
71;; separating them with a newline character. At the BBDB prompt for
72;; the field value, type `C-q C-j' to enter a newline between two
73;; anniversaries.
63;; 74;;
64;; It defaults to the value of `org-bbdb-default-anniversary-format' 75;; If you omit the CLASS-OR-FORMAT-STRING entirely, it defaults to the
65;; ("birthday" by default). 76;; value of `org-bbdb-default-anniversary-format' ("birthday" by
77;; default).
66;; 78;;
67;; The substitutions in the format string are (in order): 79;; The substitutions in the format string are (in order):
68;; * the name of the record containing this anniversary 80;; - the name of the record containing this anniversary
69;; * the number of years 81;; - the number of years
70;; * an ordinal suffix (st, nd, rd, th) for the year 82;; - an ordinal suffix (st, nd, rd, th) for the year
71;; 83;;
72;; See the documentation of `org-bbdb-anniversary-format-alist' for 84;; See the documentation of `org-bbdb-anniversary-format-alist' for
73;; further options. 85;; further options.
@@ -94,12 +106,15 @@
94(declare-function bbdb-current-record "ext:bbdb-com" 106(declare-function bbdb-current-record "ext:bbdb-com"
95 (&optional planning-on-modifying)) 107 (&optional planning-on-modifying))
96(declare-function bbdb-name "ext:bbdb-com" (string elidep)) 108(declare-function bbdb-name "ext:bbdb-com" (string elidep))
109(declare-function bbdb-completing-read-record "ext:bbdb-com"
110 (prompt &optional omit-records))
97(declare-function bbdb-record-getprop "ext:bbdb" (record property)) 111(declare-function bbdb-record-getprop "ext:bbdb" (record property))
98(declare-function bbdb-record-name "ext:bbdb" (record)) 112(declare-function bbdb-record-name "ext:bbdb" (record))
99(declare-function bbdb-records "ext:bbdb" 113(declare-function bbdb-records "ext:bbdb"
100 (&optional dont-check-disk already-in-db-buffer)) 114 (&optional dont-check-disk already-in-db-buffer))
101(declare-function bbdb-split "ext:bbdb" (string separators)) 115(declare-function bbdb-split "ext:bbdb" (string separators))
102(declare-function bbdb-string-trim "ext:bbdb" (string)) 116(declare-function bbdb-string-trim "ext:bbdb" (string))
117
103(declare-function calendar-leap-year-p "calendar" (year)) 118(declare-function calendar-leap-year-p "calendar" (year))
104(declare-function diary-ordinal-suffix "diary-lib" (n)) 119(declare-function diary-ordinal-suffix "diary-lib" (n))
105 120
@@ -326,6 +341,45 @@ This is used by Org to re-create the anniversary hash table."
326 (when text 341 (when text
327 (mapconcat 'identity text "; ")))) 342 (mapconcat 'identity text "; "))))
328 343
344(defun org-bbdb-complete-link ()
345 "Read a bbdb link with name completion."
346 (require 'bbdb-com)
347 (concat "bbdb:"
348 (bbdb-record-name (car (bbdb-completing-read-record "Name: ")))))
349
350(defun org-bbdb-anniv-export-ical ()
351 "Extract anniversaries from BBDB and convert them to icalendar format."
352 (require 'bbdb)
353 (require 'diary-lib)
354 (unless (hash-table-p org-bbdb-anniv-hash)
355 (setq org-bbdb-anniv-hash
356 (make-hash-table :test 'equal :size 366)))
357 (when (or org-bbdb-updated-p
358 (= 0 (hash-table-count org-bbdb-anniv-hash)))
359 (org-bbdb-make-anniv-hash))
360 (maphash 'org-bbdb-format-vevent org-bbdb-anniv-hash))
361
362(defun org-bbdb-format-vevent (key recs)
363 (let (rec categ)
364 (while (setq rec (pop recs))
365 (setq categ (or (nth 2 rec) org-bbdb-default-anniversary-format))
366 (princ (format "BEGIN:VEVENT
367UID: ANNIV-%4i%02i%02i-%s
368DTSTART:%4i%02i%02i
369SUMMARY:%s
370DESCRIPTION:%s
371CATEGORIES:%s
372RRULE:FREQ=YEARLY
373END:VEVENT\n"
374 (nth 0 rec) (nth 0 key) (nth 1 key)
375 (mapconcat 'identity
376 (org-split-string (nth 1 rec) "[^a-zA-Z0-90]+")
377 "-")
378 (nth 0 rec) (nth 0 key) (nth 1 key)
379 (nth 1 rec)
380 (concat (capitalize categ) " " (nth 1 rec))
381 categ)))))
382
329(provide 'org-bbdb) 383(provide 'org-bbdb)
330 384
331;; arch-tag: 9e4f275d-d080-48c1-b040-62247f66b5c2 385;; 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 @@
5;; Author: Bastien Guerry <bzg at altern dot org> 5;; Author: Bastien Guerry <bzg at altern dot org>
6;; Carsten Dominik <carsten dot dominik at gmail dot com> 6;; Carsten Dominik <carsten dot dominik at gmail dot com>
7;; Keywords: org, wp, remember 7;; Keywords: org, wp, remember
8;; Version: 6.21b 8;; Version: 6.29c
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -41,22 +41,28 @@
41 :tag "Org Clock" 41 :tag "Org Clock"
42 :group 'org-progress) 42 :group 'org-progress)
43 43
44(defcustom org-clock-into-drawer 2 44(defcustom org-clock-into-drawer org-log-into-drawer
45 "Should clocking info be wrapped into a drawer? 45 "Should clocking info be wrapped into a drawer?
46When t, clocking info will always be inserted into a :CLOCK: drawer. 46When t, clocking info will always be inserted into a :LOGBOOK: drawer.
47If necessary, the drawer will be created. 47If necessary, the drawer will be created.
48When nil, the drawer will not be created, but used when present. 48When nil, the drawer will not be created, but used when present.
49When an integer and the number of clocking entries in an item 49When an integer and the number of clocking entries in an item
50reaches or exceeds this number, a drawer will be created." 50reaches or exceeds this number, a drawer will be created.
51When a string, it names the drawer to be used.
52
53The default for this variable is the value of `org-log-into-drawer',
54which see."
51 :group 'org-todo 55 :group 'org-todo
52 :group 'org-clock 56 :group 'org-clock
53 :type '(choice 57 :type '(choice
54 (const :tag "Always" t) 58 (const :tag "Always" t)
55 (const :tag "Only when drawer exists" nil) 59 (const :tag "Only when drawer exists" nil)
56 (integer :tag "When at least N clock entries"))) 60 (integer :tag "When at least N clock entries")
61 (const :tag "Into LOGBOOK drawer" "LOGBOOK")
62 (string :tag "Into Drawer named...")))
57 63
58(defcustom org-clock-out-when-done t 64(defcustom org-clock-out-when-done t
59 "When non-nil, the clock will be stopped when the relevant entry is marked DONE. 65 "When non-nil, clock will be stopped when the clocked entry is marked DONE.
60A nil value means, clock will keep running until stopped explicitly with 66A nil value means, clock will keep running until stopped explicitly with
61`C-c C-x C-o', or until the clock is started in a different item." 67`C-c C-x C-o', or until the clock is started in a different item."
62 :group 'org-clock 68 :group 'org-clock
@@ -80,11 +86,29 @@ state to switch it to."
80 (string :tag "State") 86 (string :tag "State")
81 (symbol :tag "Function"))) 87 (symbol :tag "Function")))
82 88
89(defcustom org-clock-out-switch-to-state nil
90 "Set task to a special todo state after clocking out.
91The value should be the state to which the entry should be
92switched. If the value is a function, it must take one
93parameter (the current TODO state of the item) and return the
94state to switch it to."
95 :group 'org-clock
96 :group 'org-todo
97 :type '(choice
98 (const :tag "Don't force a state" nil)
99 (string :tag "State")
100 (symbol :tag "Function")))
101
83(defcustom org-clock-history-length 5 102(defcustom org-clock-history-length 5
84 "Number of clock tasks to remember in history." 103 "Number of clock tasks to remember in history."
85 :group 'org-clock 104 :group 'org-clock
86 :type 'integer) 105 :type 'integer)
87 106
107(defcustom org-clock-goto-may-find-recent-task t
108 "Non-nil means, `org-clock-goto' can go to recent task if no active clock."
109 :group 'org-clock
110 :type 'boolean)
111
88(defcustom org-clock-heading-function nil 112(defcustom org-clock-heading-function nil
89 "When non-nil, should be a function to create `org-clock-heading'. 113 "When non-nil, should be a function to create `org-clock-heading'.
90This is the string shown in the mode line when a clock is running. 114This 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."
93 :type 'function) 117 :type 'function)
94 118
95(defcustom org-clock-string-limit 0 119(defcustom org-clock-string-limit 0
96 "Maximum length of clock strings in the modeline. 0 means no limit" 120 "Maximum length of clock strings in the modeline. 0 means no limit."
97 :group 'org-clock 121 :group 'org-clock
98 :type 'integer) 122 :type 'integer)
99 123
100(defcustom org-clock-in-resume nil 124(defcustom org-clock-in-resume nil
101 "If non-nil, when clocking into a task with a clock entry which 125 "If non-nil, resume clock when clocking into task with open clock.
102has not been closed, resume the clock from that point" 126When clocking into a task with a clock entry which has not been closed,
127the clock can be resumed from that point."
103 :group 'org-clock 128 :group 'org-clock
104 :type 'boolean) 129 :type 'boolean)
105 130
106(defcustom org-clock-persist nil 131(defcustom org-clock-persist nil
107 "When non-nil, save the running clock when emacs is closed, and 132 "When non-nil, save the running clock when emacs is closed.
108 resume it next time emacs is started. 133The clock is resumed when emacs restarts.
109When this is t, both the running clock, and the entire clock 134When this is t, both the running clock, and the entire clock
110history are saved. When this is the symbol `clock', only the 135history are saved. When this is the symbol `clock', only the
111running clock is saved. 136running clock is saved.
112 137
113When Emacs restarts with saved clock information, the file containing the 138When Emacs restarts with saved clock information, the file containing the
114running clock as well as all files mentioned in the clock history will 139running clock as well as all files mentioned in the clock history will
115be visited." 140be visited.
141All this depends on running `org-clock-persistence-insinuate' in .emacs"
116 :group 'org-clock 142 :group 'org-clock
117 :type '(choice 143 :type '(choice
118 (const :tag "Just the running clock" clock) 144 (const :tag "Just the running clock" clock)
@@ -121,21 +147,75 @@ be visited."
121 147
122(defcustom org-clock-persist-file (convert-standard-filename 148(defcustom org-clock-persist-file (convert-standard-filename
123 "~/.emacs.d/org-clock-save.el") 149 "~/.emacs.d/org-clock-save.el")
124 "File to save clock data to" 150 "File to save clock data to."
125 :group 'org-clock 151 :group 'org-clock
126 :type 'string) 152 :type 'string)
127 153
128(defcustom org-clock-persist-query-save nil 154(defcustom org-clock-persist-query-save nil
129 "When non-nil, ask before saving the current clock on exit" 155 "When non-nil, ask before saving the current clock on exit."
130 :group 'org-clock 156 :group 'org-clock
131 :type 'boolean) 157 :type 'boolean)
132 158
133(defcustom org-clock-persist-query-resume t 159(defcustom org-clock-persist-query-resume t
134 "When non-nil, ask before resuming any stored clock during 160 "When non-nil, ask before resuming any stored clock during load."
135load."
136 :group 'org-clock 161 :group 'org-clock
137 :type 'boolean) 162 :type 'boolean)
138 163
164(defcustom org-clock-sound nil
165 "Sound that will used for notifications.
166Possible values:
167
168nil no sound played.
169t standard Emacs beep
170file name play this sound file. If not possible, fall back to beep"
171 :group 'org-clock
172 :type '(choice
173 (const :tag "No sound" nil)
174 (const :tag "Standard beep" t)
175 (file :tag "Play sound file")))
176
177(defcustom org-clock-modeline-total 'auto
178 "Default setting for the time included for the modeline clock.
179This can be overruled locally using the CLOCK_MODELINE_TOTAL property.
180Allowed values are:
181
182current Only the time in the current instance of the clock
183today All time clocked inot this task today
184repeat All time clocked into this task since last repeat
185all All time ever recorded for this task
186auto Automtically, either `all', or `repeat' for repeating tasks"
187 :group 'org-clock
188 :type '(choice
189 (const :tag "Current clock" current)
190 (const :tag "Today's task time" today)
191 (const :tag "Since last repeat" repeat)
192 (const :tag "All task time" all)
193 (const :tag "Automatically, `all' or since `repeat'" auto)))
194
195(defcustom org-show-notification-handler nil
196 "Function or program to send notification with.
197The function or program will be called with the notification
198string as argument."
199 :group 'org-clock
200 :type '(choice
201 (string :tag "Program")
202 (function :tag "Function")))
203
204(defvar org-clock-in-prepare-hook nil
205 "Hook run when preparing the clock.
206This hook is run before anything happens to the task that
207you want to clock in. For example, you can use this hook
208to add an effort property.")
209(defvar org-clock-in-hook nil
210 "Hook run when starting the clock.")
211(defvar org-clock-out-hook nil
212 "Hook run when stopping the current clock.")
213
214(defvar org-clock-cancel-hook nil
215 "Hook run when cancelling the current clock.")
216(defvar org-clock-goto-hook nil
217 "Hook run when selecting the currently clocked-in entry.")
218
139;;; The clock for measuring work time. 219;;; The clock for measuring work time.
140 220
141(defvar org-mode-line-string "") 221(defvar org-mode-line-string "")
@@ -146,6 +226,13 @@ load."
146(defvar org-clock-heading-for-remember "") 226(defvar org-clock-heading-for-remember "")
147(defvar org-clock-start-time "") 227(defvar org-clock-start-time "")
148 228
229(defvar org-clock-effort ""
230 "Effort estimate of the currently clocking task")
231
232(defvar org-clock-total-time nil
233 "Holds total time, spent previously on currently clocked item.
234This does not include the time in the currently running clock.")
235
149(defvar org-clock-history nil 236(defvar org-clock-history nil
150 "List of marker pointing to recent clocked tasks.") 237 "List of marker pointing to recent clocked tasks.")
151 238
@@ -159,6 +246,16 @@ of a different task.")
159 246
160(defvar org-clock-mode-line-map (make-sparse-keymap)) 247(defvar org-clock-mode-line-map (make-sparse-keymap))
161(define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto) 248(define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto)
249(define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu)
250
251(defun org-clock-menu ()
252 (interactive)
253 (popup-menu
254 '("Clock"
255 ["Clock out" org-clock-out t]
256 ["Change effort estimate" org-clock-modify-effort-estimate t]
257 ["Go to clock entry" org-clock-goto t]
258 ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"])))
162 259
163(defun org-clock-history-push (&optional pos buffer) 260(defun org-clock-history-push (&optional pos buffer)
164 "Push a marker to the clock history." 261 "Push a marker to the clock history."
@@ -226,8 +323,11 @@ of a different task.")
226 (t (error "Invalid task choice %c" rpl)))))) 323 (t (error "Invalid task choice %c" rpl))))))
227 324
228(defun org-clock-insert-selection-line (i marker) 325(defun org-clock-insert-selection-line (i marker)
326 "Insert a line for the clock selection menu.
327And return a cons cell with the selection character integer and the marker
328pointing to it."
229 (when (marker-buffer marker) 329 (when (marker-buffer marker)
230 (let (file cat task) 330 (let (file cat task heading prefix)
231 (with-current-buffer (org-base-buffer (marker-buffer marker)) 331 (with-current-buffer (org-base-buffer (marker-buffer marker))
232 (save-excursion 332 (save-excursion
233 (save-restriction 333 (save-restriction
@@ -237,29 +337,148 @@ of a different task.")
237 cat (or (org-get-category) 337 cat (or (org-get-category)
238 (progn (org-refresh-category-properties) 338 (progn (org-refresh-category-properties)
239 (org-get-category))) 339 (org-get-category)))
240 task (org-get-heading 'notags))))) 340 heading (org-get-heading 'notags)
341 prefix (save-excursion
342 (org-back-to-heading t)
343 (looking-at "\\*+ ")
344 (match-string 0))
345 task (substring
346 (org-fontify-like-in-org-mode
347 (concat prefix heading)
348 org-odd-levels-only)
349 (length prefix))))))
241 (when (and cat task) 350 (when (and cat task)
242 (insert (format "[%c] %-15s %s\n" i cat task)) 351 (insert (format "[%c] %-15s %s\n" i cat task))
243 (cons i marker))))) 352 (cons i marker)))))
244 353
354(defun org-clock-get-clock-string ()
355 "Form a clock-string, that will be show in the mode line.
356If an effort estimate was defined for current item, use
35701:30/01:50 format (clocked/estimated).
358If not, show simply the clocked time like 01:50."
359 (let* ((clocked-time (org-clock-get-clocked-time))
360 (h (floor clocked-time 60))
361 (m (- clocked-time (* 60 h))))
362 (if (and org-clock-effort)
363 (let* ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort))
364 (effort-h (floor effort-in-minutes 60))
365 (effort-m (- effort-in-minutes (* effort-h 60))))
366 (format (concat "-[" org-time-clocksum-format "/" org-time-clocksum-format " (%s)]")
367 h m effort-h effort-m org-clock-heading))
368 (format (concat "-[" org-time-clocksum-format " (%s)]")
369 h m org-clock-heading))))
370
245(defun org-clock-update-mode-line () 371(defun org-clock-update-mode-line ()
246 (let* ((delta (- (time-to-seconds (current-time)) 372 (setq org-mode-line-string
247 (time-to-seconds org-clock-start-time))) 373 (org-propertize
248 (h (floor delta 3600)) 374 (let ((clock-string (org-clock-get-clock-string))
249 (m (floor (- delta (* 3600 h)) 60))) 375 (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task"))
250 (setq org-mode-line-string 376 (if (and (> org-clock-string-limit 0)
251 (org-propertize 377 (> (length clock-string) org-clock-string-limit))
252 (let ((clock-string (format (concat "-[" org-time-clocksum-format " (%s)]") 378 (org-propertize (substring clock-string 0 org-clock-string-limit)
253 h m org-clock-heading)) 379 'help-echo (concat help-text ": " org-clock-heading))
254 (help-text "Org-mode clock is running. Mouse-2 to go there.")) 380 (org-propertize clock-string 'help-echo help-text)))
255 (if (and (> org-clock-string-limit 0) 381 'local-map org-clock-mode-line-map
256 (> (length clock-string) org-clock-string-limit)) 382 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)
257 (org-propertize (substring clock-string 0 org-clock-string-limit) 383 'face 'org-mode-line-clock))
258 'help-echo (concat help-text ": " org-clock-heading)) 384 (if org-clock-effort (org-clock-notify-once-if-expired))
259 (org-propertize clock-string 'help-echo help-text))) 385 (force-mode-line-update))
260 'local-map org-clock-mode-line-map 386
261 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight))) 387(defun org-clock-get-clocked-time ()
262 (force-mode-line-update))) 388 "Get the clocked time for the current item in minutes.
389The time returned includes the the time spent on this task in
390previous clocking intervals."
391 (let ((currently-clocked-time
392 (floor (- (time-to-seconds (current-time))
393 (time-to-seconds org-clock-start-time)) 60)))
394 (+ currently-clocked-time (or org-clock-total-time 0))))
395
396(defun org-clock-modify-effort-estimate (&optional value)
397 "Add to or set the effort estimate of the item currently being clocked.
398VALUE can be a number of minutes, or a string with forat hh:mm or mm.
399WHen the strig starts with a + or a - sign, the current value of the effort
400property will be changed by that amount.
401This will update the \"Effort\" property of currently clocked item, and
402the mode line."
403 (interactive)
404 (when (org-clock-is-active)
405 (let ((current org-clock-effort) sign)
406 (unless value
407 ;; Prompt user for a value or a change
408 (setq value
409 (read-string
410 (format "Set effort (hh:mm or mm%s): "
411 (if current
412 (format ", prefix + to add to %s" org-clock-effort)
413 "")))))
414 (when (stringp value)
415 ;; A string. See if it is a delta
416 (setq sign (string-to-char value))
417 (if (member sign '(?- ?+))
418 (setq current (org-hh:mm-string-to-minutes (substring current 1)))
419 (setq current 0))
420 (setq value (org-hh:mm-string-to-minutes value))
421 (if (equal ?- sign)
422 (setq value (- current value))
423 (if (equal ?+ sign) (setq value (+ current value)))))
424 (setq value (max 0 value)
425 org-clock-effort (org-minutes-to-hh:mm-string value))
426 (org-entry-put org-clock-marker "Effort" org-clock-effort)
427 (org-clock-update-mode-line))))
428
429(defvar org-clock-notification-was-shown nil
430 "Shows if we have shown notification already.")
431
432(defun org-clock-notify-once-if-expired ()
433 "Show notification if we spent more time than we estimated before.
434Notification is shown only once."
435 (when (marker-buffer org-clock-marker)
436 (let ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort))
437 (clocked-time (org-clock-get-clocked-time)))
438 (if (>= clocked-time effort-in-minutes)
439 (unless org-clock-notification-was-shown
440 (setq org-clock-notification-was-shown t)
441 (org-clock-play-sound)
442 (org-show-notification
443 (format "Task '%s' should be finished by now. (%s)"
444 org-clock-heading org-clock-effort)))
445 (setq org-clock-notification-was-shown nil)))))
446
447(defun org-show-notification (notification)
448 "Show notification.
449Use `org-show-notification-handler' if defined,
450use libnotify if available, or fall back on a message."
451 (cond ((functionp org-show-notification-handler)
452 (funcall org-show-notification-handler notification))
453 ((stringp org-show-notification-handler)
454 (start-process "emacs-timer-notification" nil
455 org-show-notification-handler notification))
456 ((org-program-exists "notify-send")
457 (start-process "emacs-timer-notification" nil
458 "notify-send" notification))
459 ;; Maybe the handler will send a message, so only use message as
460 ;; a fall back option
461 (t (message notification))))
462
463(defun org-clock-play-sound ()
464 "Play sound as configured by `org-clock-sound'.
465Use alsa's aplay tool if available."
466 (cond
467 ((not org-clock-sound))
468 ((eq org-clock-sound t) (beep t) (beep t))
469 ((stringp org-clock-sound)
470 (if (file-exists-p org-clock-sound)
471 (if (org-program-exists "aplay")
472 (start-process "org-clock-play-notification" nil
473 "aplay" org-clock-sound)
474 (condition-case nil
475 (play-sound-file org-clock-sound)
476 (error (beep t) (beep t))))))))
477
478(defun org-program-exists (program-name)
479 "Checks whenever we can locate program and launch it."
480 (if (eq system-type 'gnu/linux)
481 (= 0 (call-process "which" nil nil nil program-name))))
263 482
264(defvar org-clock-mode-line-entry nil 483(defvar org-clock-mode-line-entry nil
265 "Information for the modeline about the running clock.") 484 "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
272is as the default task, a special task that will always be offered in 491is as the default task, a special task that will always be offered in
273the clocking selection, associated with the letter `d'." 492the clocking selection, associated with the letter `d'."
274 (interactive "P") 493 (interactive "P")
494 (setq org-clock-notification-was-shown nil)
275 (catch 'abort 495 (catch 'abort
276 (let ((interrupting (marker-buffer org-clock-marker)) 496 (let ((interrupting (marker-buffer org-clock-marker))
277 ts selected-task target-pos) 497 ts selected-task target-pos (msg-extra ""))
278 (when (equal select '(4)) 498 (when (equal select '(4))
279 (setq selected-task (org-clock-select-task "Clock-in on task: ")) 499 (setq selected-task (org-clock-select-task "Clock-in on task: "))
280 (if selected-task 500 (if selected-task
@@ -290,11 +510,10 @@ the clocking selection, associated with the letter `d'."
290 510
291 (when (equal select '(16)) 511 (when (equal select '(16))
292 ;; Mark as default clocking task 512 ;; Mark as default clocking task
293 (save-excursion 513 (org-clock-mark-default-task))
294 (org-back-to-heading t)
295 (move-marker org-clock-default-task (point))))
296 514
297 (setq target-pos (point)) ;; we want to clock in at this location 515 (setq target-pos (point)) ;; we want to clock in at this location
516 (run-hooks 'org-clock-in-prepare-hook)
298 (save-excursion 517 (save-excursion
299 (when (and selected-task (marker-buffer selected-task)) 518 (when (and selected-task (marker-buffer selected-task))
300 ;; There is a selected task, move to the correct buffer 519 ;; There is a selected task, move to the correct buffer
@@ -333,19 +552,22 @@ the clocking selection, associated with the letter `d'."
333 (t "???"))) 552 (t "???")))
334 (setq org-clock-heading (org-propertize org-clock-heading 553 (setq org-clock-heading (org-propertize org-clock-heading
335 'face nil)) 554 'face nil))
336 (org-clock-find-position) 555 (org-clock-find-position org-clock-in-resume)
337 (cond 556 (cond
338 ((and org-clock-in-resume 557 ((and org-clock-in-resume
339 (looking-at 558 (looking-at
340 (concat "^[ \\t]* " org-clock-string 559 (concat "^[ \t]* " org-clock-string
341 " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" 560 " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
342 " +\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) 561 " +\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
343 (message "Matched %s" (match-string 1)) 562 (message "Matched %s" (match-string 1))
344 (setq ts (concat "[" (match-string 1) "]")) 563 (setq ts (concat "[" (match-string 1) "]"))
345 (goto-char (match-end 1)) 564 (goto-char (match-end 1))
346 (setq org-clock-start-time 565 (setq org-clock-start-time
347 (apply 'encode-time 566 (apply 'encode-time
348 (org-parse-time-string (match-string 1))))) 567 (org-parse-time-string (match-string 1))))
568 (setq org-clock-effort (org-get-effort))
569 (setq org-clock-total-time (org-clock-sum-current-item
570 (org-clock-get-sum-start))))
349 ((eq org-clock-in-resume 'auto-restart) 571 ((eq org-clock-in-resume 'auto-restart)
350 ;; called from org-clock-load during startup, 572 ;; called from org-clock-load during startup,
351 ;; do not interrupt, but warn! 573 ;; do not interrupt, but warn!
@@ -354,11 +576,21 @@ the clocking selection, associated with the letter `d'."
354 (sit-for 2) 576 (sit-for 2)
355 (throw 'abort nil)) 577 (throw 'abort nil))
356 (t 578 (t
357 (insert "\n") (backward-char 1) 579 (insert-before-markers "\n")
580 (backward-char 1)
358 (org-indent-line-function) 581 (org-indent-line-function)
582 (when (and (save-excursion
583 (end-of-line 0)
584 (org-in-item-p)))
585 (beginning-of-line 1)
586 (org-indent-line-to (- (org-get-indentation) 2)))
359 (insert org-clock-string " ") 587 (insert org-clock-string " ")
588 (setq org-clock-effort (org-get-effort))
589 (setq org-clock-total-time (org-clock-sum-current-item
590 (org-clock-get-sum-start)))
360 (setq org-clock-start-time (current-time)) 591 (setq org-clock-start-time (current-time))
361 (setq ts (org-insert-time-stamp org-clock-start-time 'with-hm 'inactive)))) 592 (setq ts (org-insert-time-stamp org-clock-start-time
593 'with-hm 'inactive))))
362 (move-marker org-clock-marker (point) (buffer-base-buffer)) 594 (move-marker org-clock-marker (point) (buffer-base-buffer))
363 (or global-mode-string (setq global-mode-string '(""))) 595 (or global-mode-string (setq global-mode-string '("")))
364 (or (memq 'org-mode-line-string global-mode-string) 596 (or (memq 'org-mode-line-string global-mode-string)
@@ -367,10 +599,56 @@ the clocking selection, associated with the letter `d'."
367 (org-clock-update-mode-line) 599 (org-clock-update-mode-line)
368 (setq org-clock-mode-line-timer 600 (setq org-clock-mode-line-timer
369 (run-with-timer 60 60 'org-clock-update-mode-line)) 601 (run-with-timer 60 60 'org-clock-update-mode-line))
370 (message "Clock started at %s" ts))))))) 602 (message "Clock starts at %s - %s" ts msg-extra)
603 (run-hooks 'org-clock-in-hook)))))))
371 604
372(defun org-clock-find-position () 605(defun org-clock-mark-default-task ()
373 "Find the location where the next clock line should be inserted." 606 "Mark current task as default task."
607 (interactive)
608 (save-excursion
609 (org-back-to-heading t)
610 (move-marker org-clock-default-task (point))))
611
612(defvar msg-extra)
613(defun org-clock-get-sum-start ()
614 "Return the time from which clock times should be counted.
615This is for the currently running clock as it is displayed
616in the mode line. This function looks at the properties
617LAST_REPEAT and in particular CLOCK_MODELINE_TOTAL and the
618corresponding variable `org-clock-modeline-total' and then
619decides which time to use."
620 (let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL")
621 (symbol-name org-clock-modeline-total)))
622 (lr (org-entry-get nil "LAST_REPEAT")))
623 (cond
624 ((equal cmt "current")
625 (setq msg-extra "showing time in current clock instance")
626 (current-time))
627 ((equal cmt "today")
628 (setq msg-extra "showing today's task time.")
629 (let* ((dt (decode-time (current-time))))
630 (setq dt (append (list 0 0 0) (nthcdr 3 dt)))
631 (if org-extend-today-until
632 (setf (nth 2 dt) org-extend-today-until))
633 (apply 'encode-time dt)))
634 ((or (equal cmt "all")
635 (and (or (not cmt) (equal cmt "auto"))
636 (not lr)))
637 (setq msg-extra "showing entire task time.")
638 nil)
639 ((or (equal cmt "repeat")
640 (and (or (not cmt) (equal cmt "auto"))
641 lr))
642 (setq msg-extra "showing task time since last repeat.")
643 (if (not lr)
644 nil
645 (org-time-string-to-time lr)))
646 (t nil))))
647
648(defun org-clock-find-position (find-unclosed)
649 "Find the location where the next clock line should be inserted.
650When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock
651line and position cursor in that line."
374 (org-back-to-heading t) 652 (org-back-to-heading t)
375 (catch 'exit 653 (catch 'exit
376 (let ((beg (save-excursion 654 (let ((beg (save-excursion
@@ -380,12 +658,25 @@ the clocking selection, associated with the letter `d'."
380 (end (progn (outline-next-heading) (point))) 658 (end (progn (outline-next-heading) (point)))
381 (re (concat "^[ \t]*" org-clock-string)) 659 (re (concat "^[ \t]*" org-clock-string))
382 (cnt 0) 660 (cnt 0)
383 first last) 661 (drawer (if (stringp org-clock-into-drawer)
662 org-clock-into-drawer "LOGBOOK"))
663 first last ind-last)
384 (goto-char beg) 664 (goto-char beg)
665 (when (and find-unclosed
666 (re-search-forward
667 (concat "^[ \t]* " org-clock-string
668 " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
669 " +\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")
670 end t))
671 (beginning-of-line 1)
672 (throw 'exit t))
385 (when (eobp) (newline) (setq end (max (point) end))) 673 (when (eobp) (newline) (setq end (max (point) end)))
386 (when (re-search-forward "^[ \t]*:CLOCK:" end t) 674 (when (re-search-forward (concat "^[ \t]*:" drawer ":") end t)
387 ;; we seem to have a CLOCK drawer, so go there. 675 ;; we seem to have a CLOCK drawer, so go there.
388 (beginning-of-line 2) 676 (beginning-of-line 2)
677 (or org-log-states-order-reversed
678 (and (re-search-forward org-property-end-re nil t)
679 (goto-char (match-beginning 0))))
389 (throw 'exit t)) 680 (throw 'exit t))
390 ;; Lets count the CLOCK lines 681 ;; Lets count the CLOCK lines
391 (goto-char beg) 682 (goto-char beg)
@@ -394,20 +685,27 @@ the clocking selection, associated with the letter `d'."
394 last (match-beginning 0) 685 last (match-beginning 0)
395 cnt (1+ cnt))) 686 cnt (1+ cnt)))
396 (when (and (integerp org-clock-into-drawer) 687 (when (and (integerp org-clock-into-drawer)
688 last
397 (>= (1+ cnt) org-clock-into-drawer)) 689 (>= (1+ cnt) org-clock-into-drawer))
398 ;; Wrap current entries into a new drawer 690 ;; Wrap current entries into a new drawer
399 (goto-char last) 691 (goto-char last)
692 (setq ind-last (org-get-indentation))
400 (beginning-of-line 2) 693 (beginning-of-line 2)
401 (if (org-at-item-p) (org-end-of-item)) 694 (if (and (>= (org-get-indentation) ind-last)
695 (org-at-item-p))
696 (org-end-of-item))
402 (insert ":END:\n") 697 (insert ":END:\n")
403 (beginning-of-line 0) 698 (beginning-of-line 0)
404 (org-indent-line-function) 699 (org-indent-line-to ind-last)
405 (goto-char first) 700 (goto-char first)
406 (insert ":CLOCK:\n") 701 (insert ":" drawer ":\n")
407 (beginning-of-line 0) 702 (beginning-of-line 0)
408 (org-indent-line-function) 703 (org-indent-line-function)
409 (org-flag-drawer t) 704 (org-flag-drawer t)
410 (beginning-of-line 2) 705 (beginning-of-line 2)
706 (or org-log-states-order-reversed
707 (and (re-search-forward org-property-end-re nil t)
708 (goto-char (match-beginning 0))))
411 (throw 'exit nil)) 709 (throw 'exit nil))
412 710
413 (goto-char beg) 711 (goto-char beg)
@@ -416,62 +714,84 @@ the clocking selection, associated with the letter `d'."
416 ;; Planning info, skip to after it 714 ;; Planning info, skip to after it
417 (beginning-of-line 2) 715 (beginning-of-line 2)
418 (or (bolp) (newline))) 716 (or (bolp) (newline)))
419 (when (eq t org-clock-into-drawer) 717 (when (or (eq org-clock-into-drawer t)
420 (insert ":CLOCK:\n:END:\n") 718 (stringp org-clock-into-drawer)
421 (beginning-of-line 0) 719 (and (integerp org-clock-into-drawer)
720 (< org-clock-into-drawer 2)))
721 (insert ":" drawer ":\n:END:\n")
722 (beginning-of-line -1)
422 (org-indent-line-function) 723 (org-indent-line-function)
423 (beginning-of-line 0)
424 (org-flag-drawer t) 724 (org-flag-drawer t)
725 (beginning-of-line 2)
425 (org-indent-line-function) 726 (org-indent-line-function)
426 (beginning-of-line 2))))) 727 (beginning-of-line)
728 (or org-log-states-order-reversed
729 (and (re-search-forward org-property-end-re nil t)
730 (goto-char (match-beginning 0))))))))
427 731
428(defun org-clock-out (&optional fail-quietly) 732(defun org-clock-out (&optional fail-quietly)
429 "Stop the currently running clock. 733 "Stop the currently running clock.
430If there is no running clock, throw an error, unless FAIL-QUIETLY is set." 734If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
431 (interactive) 735 (interactive)
432 (catch 'exit 736 (catch 'exit
433 (if (not (marker-buffer org-clock-marker)) 737 (if (not (marker-buffer org-clock-marker))
434 (if fail-quietly (throw 'exit t) (error "No active clock"))) 738 (if fail-quietly (throw 'exit t) (error "No active clock")))
435 (let (ts te s h m remove) 739 (let (ts te s h m remove)
436 (save-excursion 740 (save-excursion
437 (set-buffer (marker-buffer org-clock-marker)) 741 (set-buffer (marker-buffer org-clock-marker))
438 (save-restriction 742 (save-restriction
439 (widen) 743 (widen)
440 (goto-char org-clock-marker) 744 (goto-char org-clock-marker)
441 (beginning-of-line 1)
442 (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
443 (equal (match-string 1) org-clock-string))
444 (setq ts (match-string 2))
445 (if fail-quietly (throw 'exit nil) (error "Clock start time is gone")))
446 (goto-char (match-end 0))
447 (delete-region (point) (point-at-eol))
448 (insert "--")
449 (setq te (org-insert-time-stamp (current-time) 'with-hm 'inactive))
450 (setq s (- (time-to-seconds (apply 'encode-time (org-parse-time-string te)))
451 (time-to-seconds (apply 'encode-time (org-parse-time-string ts))))
452 h (floor (/ s 3600))
453 s (- s (* 3600 h))
454 m (floor (/ s 60))
455 s (- s (* 60 s)))
456 (insert " => " (format "%2d:%02d" h m))
457 (when (setq remove (and org-clock-out-remove-zero-time-clocks
458 (= (+ h m) 0)))
459 (beginning-of-line 1) 745 (beginning-of-line 1)
746 (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
747 (equal (match-string 1) org-clock-string))
748 (setq ts (match-string 2))
749 (if fail-quietly (throw 'exit nil) (error "Clock start time is gone")))
750 (goto-char (match-end 0))
460 (delete-region (point) (point-at-eol)) 751 (delete-region (point) (point-at-eol))
461 (and (looking-at "\n") (> (point-max) (1+ (point))) 752 (insert "--")
462 (delete-char 1))) 753 (setq te (org-insert-time-stamp (current-time) 'with-hm 'inactive))
463 (move-marker org-clock-marker nil) 754 (setq s (- (time-to-seconds (apply 'encode-time (org-parse-time-string te)))
464 (when org-log-note-clock-out 755 (time-to-seconds (apply 'encode-time (org-parse-time-string ts))))
465 (org-add-log-setup 'clock-out nil nil nil 756 h (floor (/ s 3600))
466 (concat "# Task: " (org-get-heading t) "\n\n"))) 757 s (- s (* 3600 h))
467 (when org-clock-mode-line-timer 758 m (floor (/ s 60))
468 (cancel-timer org-clock-mode-line-timer) 759 s (- s (* 60 s)))
469 (setq org-clock-mode-line-timer nil)) 760 (insert " => " (format "%2d:%02d" h m))
470 (setq global-mode-string 761 (when (setq remove (and org-clock-out-remove-zero-time-clocks
471 (delq 'org-mode-line-string global-mode-string)) 762 (= (+ h m) 0)))
472 (force-mode-line-update) 763 (beginning-of-line 1)
473 (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m 764 (delete-region (point) (point-at-eol))
474 (if remove " => LINE REMOVED" ""))))))) 765 (and (looking-at "\n") (> (point-max) (1+ (point)))
766 (delete-char 1)))
767 (move-marker org-clock-marker nil)
768 (when org-log-note-clock-out
769 (org-add-log-setup 'clock-out nil nil nil nil
770 (concat "# Task: " (org-get-heading t) "\n\n")))
771 (when org-clock-mode-line-timer
772 (cancel-timer org-clock-mode-line-timer)
773 (setq org-clock-mode-line-timer nil))
774 (setq global-mode-string
775 (delq 'org-mode-line-string global-mode-string))
776 (when org-clock-out-switch-to-state
777 (save-excursion
778 (org-back-to-heading t)
779 (let ((org-inhibit-logging t))
780 (cond
781 ((functionp org-clock-out-switch-to-state)
782 (looking-at org-complex-heading-regexp)
783 (let ((newstate (funcall org-clock-out-switch-to-state
784 (match-string 2))))
785 (if newstate (org-todo newstate))))
786 ((and org-clock-out-switch-to-state
787 (not (looking-at (concat outline-regexp "[ \t]*"
788 org-clock-out-switch-to-state
789 "\\>"))))
790 (org-todo org-clock-out-switch-to-state))))))
791 (force-mode-line-update)
792 (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m
793 (if remove " => LINE REMOVED" ""))
794 (run-hooks 'org-clock-out-hook))))))
475 795
476(defun org-clock-cancel () 796(defun org-clock-cancel ()
477 "Cancel the running clock be removing the start timestamp." 797 "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."
485 (setq global-mode-string 805 (setq global-mode-string
486 (delq 'org-mode-line-string global-mode-string)) 806 (delq 'org-mode-line-string global-mode-string))
487 (force-mode-line-update) 807 (force-mode-line-update)
488 (message "Clock canceled")) 808 (message "Clock canceled")
809 (run-hooks 'org-clock-cancel-hook))
489 810
490(defun org-clock-goto (&optional select) 811(defun org-clock-goto (&optional select)
491 "Go to the currently clocked-in entry. 812 "Go to the currently clocked-in entry, or to the most recently clocked one.
492With prefix arg SELECT, offer recently clocked tasks." 813With prefix arg SELECT, offer recently clocked tasks for selection."
493 (interactive "P") 814 (interactive "@P")
494 (let ((m (if select 815 (let* ((recent nil)
495 (org-clock-select-task "Select task to go to: ") 816 (m (cond
496 org-clock-marker))) 817 (select
497 (if (not (marker-buffer m)) 818 (or (org-clock-select-task "Select task to go to: ")
498 (if select 819 (error "No task selected")))
499 (error "No task selected") 820 ((marker-buffer org-clock-marker) org-clock-marker)
500 (error "No active clock"))) 821 ((and org-clock-goto-may-find-recent-task
822 (car org-clock-history)
823 (marker-buffer (car org-clock-history)))
824 (setq recent t)
825 (car org-clock-history))
826 (t (error "No active or recent clock task")))))
501 (switch-to-buffer (marker-buffer m)) 827 (switch-to-buffer (marker-buffer m))
502 (if (or (< m (point-min)) (> m (point-max))) (widen)) 828 (if (or (< m (point-min)) (> m (point-max))) (widen))
503 (goto-char m) 829 (goto-char m)
504 (org-show-entry) 830 (org-show-entry)
505 (org-back-to-heading) 831 (org-back-to-heading t)
506 (org-cycle-hide-drawers 'children) 832 (org-cycle-hide-drawers 'children)
507 (recenter))) 833 (recenter)
834 (if recent
835 (message "No running clock, this is the most recently clocked task"))
836 (run-hooks 'org-clock-goto-hook)))
508 837
509(defvar org-clock-file-total-minutes nil 838(defvar org-clock-file-total-minutes nil
510 "Holds the file total time in minutes, after a call to `org-clock-sum'.") 839 "Holds the file total time in minutes, after a call to `org-clock-sum'.")
511 (make-variable-buffer-local 'org-clock-file-total-minutes) 840(make-variable-buffer-local 'org-clock-file-total-minutes)
512 841
513(defun org-clock-sum (&optional tstart tend) 842(defun org-clock-sum (&optional tstart tend)
514 "Sum the times for each subtree. 843 "Sum the times for each subtree.
515Puts the resulting times in minutes as a text property on each headline." 844Puts the resulting times in minutes as a text property on each headline.
845TSTART and TEND can mark a time range to be considered."
516 (interactive) 846 (interactive)
517 (let* ((bmp (buffer-modified-p)) 847 (let* ((bmp (buffer-modified-p))
518 (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" 848 (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
@@ -524,6 +854,10 @@ Puts the resulting times in minutes as a text property on each headline."
524 (level 0) 854 (level 0)
525 ts te dt 855 ts te dt
526 time) 856 time)
857 (if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart)))
858 (if (stringp tend) (setq tend (org-time-string-to-seconds tend)))
859 (if (consp tstart) (setq tstart (time-to-seconds tstart)))
860 (if (consp tend) (setq tend (time-to-seconds tend)))
527 (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) 861 (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t))
528 (save-excursion 862 (save-excursion
529 (goto-char (point-max)) 863 (goto-char (point-max))
@@ -558,6 +892,14 @@ Puts the resulting times in minutes as a text property on each headline."
558 (setq org-clock-file-total-minutes (aref ltimes 0))) 892 (setq org-clock-file-total-minutes (aref ltimes 0)))
559 (set-buffer-modified-p bmp))) 893 (set-buffer-modified-p bmp)))
560 894
895(defun org-clock-sum-current-item (&optional tstart)
896 "Returns time, clocked on current item in total"
897 (save-excursion
898 (save-restriction
899 (org-narrow-to-subtree)
900 (org-clock-sum tstart)
901 org-clock-file-total-minutes)))
902
561(defun org-clock-display (&optional total-only) 903(defun org-clock-display (&optional total-only)
562 "Show subtree times in the entire buffer. 904 "Show subtree times in the entire buffer.
563If TOTAL-ONLY is non-nil, only show the total time for the entire file 905If 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,
633and is only done if the variable `org-clock-out-when-done' is not nil." 975and is only done if the variable `org-clock-out-when-done' is not nil."
634 (when (and org-clock-out-when-done 976 (when (and org-clock-out-when-done
635 (member state org-done-keywords) 977 (member state org-done-keywords)
636 (equal (marker-buffer org-clock-marker) (current-buffer)) 978 (equal (or (buffer-base-buffer (marker-buffer org-clock-marker))
979 (marker-buffer org-clock-marker))
980 (or (buffer-base-buffer (current-buffer))
981 (current-buffer)))
637 (< (point) org-clock-marker) 982 (< (point) org-clock-marker)
638 (> (save-excursion (outline-next-heading) (point)) 983 (> (save-excursion (outline-next-heading) (point))
639 org-clock-marker)) 984 org-clock-marker))
@@ -801,7 +1146,7 @@ the currently selected interval size."
801 ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) 1146 ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
802 ;; 1 1 2 3 3 4 4 5 6 6 5 2 1147 ;; 1 1 2 3 3 4 4 5 6 6 5 2
803 (setq y (string-to-number (match-string 1 s)) 1148 (setq y (string-to-number (match-string 1 s))
804 wp (and (match-end 3) (match-string 3 s)) 1149 wp (and (match-end 3) (match-string 3 s))
805 mw (and (match-end 4) (string-to-number (match-string 4 s))) 1150 mw (and (match-end 4) (string-to-number (match-string 4 s)))
806 d (and (match-end 6) (string-to-number (match-string 6 s)))) 1151 d (and (match-end 6) (string-to-number (match-string 6 s))))
807 (cond 1152 (cond
@@ -842,11 +1187,12 @@ the currently selected interval size."
842 (maxlevel (or (plist-get params :maxlevel) 3)) 1187 (maxlevel (or (plist-get params :maxlevel) 3))
843 (step (plist-get params :step)) 1188 (step (plist-get params :step))
844 (emph (plist-get params :emphasize)) 1189 (emph (plist-get params :emphasize))
1190 (timestamp (plist-get params :timestamp))
845 (ts (plist-get params :tstart)) 1191 (ts (plist-get params :tstart))
846 (te (plist-get params :tend)) 1192 (te (plist-get params :tend))
847 (block (plist-get params :block)) 1193 (block (plist-get params :block))
848 (link (plist-get params :link)) 1194 (link (plist-get params :link))
849 ipos time p level hlc hdl content recalc formula pcol 1195 ipos time p level hlc hdl tsp props content recalc formula pcol
850 cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list st) 1196 cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list st)
851 (setq org-clock-file-total-minutes nil) 1197 (setq org-clock-file-total-minutes nil)
852 (when step 1198 (when step
@@ -951,10 +1297,18 @@ the currently selected interval size."
951 (save-match-data 1297 (save-match-data
952 (org-make-org-heading-search-string 1298 (org-make-org-heading-search-string
953 (match-string 2)))) 1299 (match-string 2))))
954 (match-string 2)))) 1300 (match-string 2)))
1301 tsp (when timestamp
1302 (setq props (org-entry-properties (point)))
1303 (or (cdr (assoc "SCHEDULED" props))
1304 (cdr (assoc "TIMESTAMP" props))
1305 (cdr (assoc "DEADLINE" props))
1306 (cdr (assoc "TIMESTAMP_IA" props)))))
955 (if (and (not multifile) (= level 1)) (push "|-" tbl)) 1307 (if (and (not multifile) (= level 1)) (push "|-" tbl))
956 (push (concat 1308 (push (concat
957 "| " (int-to-string level) "|" hlc hdl hlc " |" 1309 "| " (int-to-string level) "|"
1310 (if timestamp (concat tsp "|") "")
1311 hlc hdl hlc " |"
958 (make-string (1- level) ?|) 1312 (make-string (1- level) ?|)
959 hlc (org-minutes-to-hh:mm-string time) hlc 1313 hlc (org-minutes-to-hh:mm-string time) hlc
960 " |") tbl)))))) 1314 " |") tbl))))))
@@ -973,12 +1327,12 @@ the currently selected interval size."
973 (if block (concat ", for " range-text ".") "") 1327 (if block (concat ", for " range-text ".") "")
974 "\n\n")) 1328 "\n\n"))
975 (if scope-is-list "|File" "") 1329 (if scope-is-list "|File" "")
976 "|L|Headline|Time|\n") 1330 "|L|" (if timestamp "Timestamp|" "") "Headline|Time|\n")
977 (setq total-time (or total-time org-clock-file-total-minutes)) 1331 (setq total-time (or total-time org-clock-file-total-minutes))
978 (insert-before-markers 1332 (insert-before-markers
979 "|-\n|" 1333 "|-\n|"
980 (if scope-is-list "|" "") 1334 (if scope-is-list "|" "")
981 "|" 1335 (if timestamp "|Timestamp|" "|")
982 "*Total time*| *" 1336 "*Total time*| *"
983 (org-minutes-to-hh:mm-string (or total-time 0)) 1337 (org-minutes-to-hh:mm-string (or total-time 0))
984 "*|\n|-\n") 1338 "*|\n|-\n")
@@ -1009,7 +1363,7 @@ the currently selected interval size."
1009 (t (error "invalid formula in clocktable"))) 1363 (t (error "invalid formula in clocktable")))
1010 ;; Should we rescue an old formula? 1364 ;; Should we rescue an old formula?
1011 (when (stringp (setq content (plist-get params :content))) 1365 (when (stringp (setq content (plist-get params :content)))
1012 (when (string-match "^\\(#\\+TBLFM:.*\\)" content) 1366 (when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content)
1013 (setq recalc t) 1367 (setq recalc t)
1014 (insert "\n" (match-string 1 (plist-get params :content))) 1368 (insert "\n" (match-string 1 (plist-get params :content)))
1015 (beginning-of-line 0)))) 1369 (beginning-of-line 0))))
@@ -1046,10 +1400,10 @@ the currently selected interval size."
1046 (while (< ts te) 1400 (while (< ts te)
1047 (or (bolp) (insert "\n")) 1401 (or (bolp) (insert "\n"))
1048 (setq p1 (plist-put p1 :tstart (format-time-string 1402 (setq p1 (plist-put p1 :tstart (format-time-string
1049 (car org-time-stamp-formats) 1403 (org-time-stamp-format nil t)
1050 (seconds-to-time ts)))) 1404 (seconds-to-time ts))))
1051 (setq p1 (plist-put p1 :tend (format-time-string 1405 (setq p1 (plist-put p1 :tend (format-time-string
1052 (car org-time-stamp-formats) 1406 (org-time-stamp-format nil t)
1053 (seconds-to-time (setq ts (+ ts step)))))) 1407 (seconds-to-time (setq ts (+ ts step))))))
1054 (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ") 1408 (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ")
1055 (plist-get p1 :tstart) "\n") 1409 (plist-get p1 :tstart) "\n")
@@ -1139,8 +1493,7 @@ The details of what will be saved are regulated by the variable
1139 "Was the clock file loaded?") 1493 "Was the clock file loaded?")
1140 1494
1141(defun org-clock-load () 1495(defun org-clock-load ()
1142 "Load various clock-related data from disk, optionally resuming 1496 "Load clock-related data from disk, maybe resuming a stored clock."
1143a stored clock"
1144 (when (and org-clock-persist (not org-clock-loaded)) 1497 (when (and org-clock-persist (not org-clock-loaded))
1145 (let ((filename (expand-file-name org-clock-persist-file)) 1498 (let ((filename (expand-file-name org-clock-persist-file))
1146 (org-clock-in-resume 'auto-restart) 1499 (org-clock-in-resume 'auto-restart)
@@ -1186,6 +1539,9 @@ a stored clock"
1186 (add-hook 'org-mode-hook 'org-clock-load) 1539 (add-hook 'org-mode-hook 'org-clock-load)
1187 (add-hook 'kill-emacs-hook 'org-clock-save)) 1540 (add-hook 'kill-emacs-hook 'org-clock-save))
1188 1541
1542;; Suggested bindings
1543(org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate)
1544
1189(provide 'org-clock) 1545(provide 'org-clock)
1190 1546
1191;; arch-tag: 7b42c5d4-9b36-48be-97c0-66a869daed4c 1547;; 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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -81,8 +81,24 @@ This is the compiled version of the format.")
81(org-defkey org-columns-map "\M-b" 'backward-char) 81(org-defkey org-columns-map "\M-b" 'backward-char)
82(org-defkey org-columns-map "a" 'org-columns-edit-allowed) 82(org-defkey org-columns-map "a" 'org-columns-edit-allowed)
83(org-defkey org-columns-map "s" 'org-columns-edit-attributes) 83(org-defkey org-columns-map "s" 'org-columns-edit-attributes)
84(org-defkey org-columns-map "\M-f" (lambda () (interactive) (goto-char (1+ (point))))) 84(org-defkey org-columns-map "\M-f"
85(org-defkey org-columns-map [right] (lambda () (interactive) (goto-char (1+ (point))))) 85 (lambda () (interactive) (goto-char (1+ (point)))))
86(org-defkey org-columns-map [right]
87 (lambda () (interactive) (goto-char (1+ (point)))))
88(org-defkey org-columns-map [down]
89 (lambda () (interactive)
90 (let ((col (current-column)))
91 (beginning-of-line 2)
92 (while (and (org-invisible-p2) (not (eobp)))
93 (beginning-of-line 2))
94 (move-to-column col))))
95(org-defkey org-columns-map [up]
96 (lambda () (interactive)
97 (let ((col (current-column)))
98 (beginning-of-line 0)
99 (while (and (org-invisible-p2) (not (bobp)))
100 (beginning-of-line 0))
101 (move-to-column col))))
86(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value) 102(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value)
87(org-defkey org-columns-map "n" 'org-columns-next-allowed-value) 103(org-defkey org-columns-map "n" 'org-columns-next-allowed-value)
88(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value) 104(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value)
@@ -279,6 +295,9 @@ for the duration of the command.")
279 org-columns-previous-hscroll (window-hscroll)) 295 org-columns-previous-hscroll (window-hscroll))
280 (force-mode-line-update))) 296 (force-mode-line-update)))
281 297
298(defvar org-colview-initial-truncate-line-value nil
299 "Remember the value of `truncate-lines' across colview.")
300
282(defun org-columns-remove-overlays () 301(defun org-columns-remove-overlays ()
283 "Remove all currently active column overlays." 302 "Remove all currently active column overlays."
284 (interactive) 303 (interactive)
@@ -296,7 +315,9 @@ for the duration of the command.")
296 (let ((inhibit-read-only t)) 315 (let ((inhibit-read-only t))
297 (remove-text-properties (point-min) (point-max) '(read-only t)))) 316 (remove-text-properties (point-min) (point-max) '(read-only t))))
298 (when org-columns-flyspell-was-active 317 (when org-columns-flyspell-was-active
299 (flyspell-mode 1))))) 318 (flyspell-mode 1))
319 (when (local-variable-p 'org-colview-initial-truncate-line-value)
320 (setq truncate-lines org-colview-initial-truncate-line-value)))))
300 321
301(defun org-columns-cleanup-item (item fmt) 322(defun org-columns-cleanup-item (item fmt)
302 "Remove from ITEM what is a column in the format FMT." 323 "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."
404 (setq eval '(org-with-point-at pom 425 (setq eval '(org-with-point-at pom
405 (org-edit-headline)))) 426 (org-edit-headline))))
406 ((equal key "TODO") 427 ((equal key "TODO")
407 (setq eval '(org-with-point-at pom 428 (setq eval '(org-with-point-at
408 (call-interactively 'org-todo)))) 429 pom
430 (call-interactively 'org-todo))))
409 ((equal key "PRIORITY") 431 ((equal key "PRIORITY")
410 (setq eval '(org-with-point-at pom 432 (setq eval '(org-with-point-at pom
411 (call-interactively 'org-priority)))) 433 (call-interactively 'org-priority))))
@@ -656,7 +678,10 @@ around it."
656 (narrow-to-region beg end) 678 (narrow-to-region beg end)
657 (org-clock-sum)))) 679 (org-clock-sum))))
658 (while (re-search-forward (concat "^" outline-regexp) end t) 680 (while (re-search-forward (concat "^" outline-regexp) end t)
659 (push (cons (org-current-line) (org-entry-properties)) cache)) 681 (if (and org-columns-skip-arrchived-trees
682 (looking-at (concat ".*:" org-archive-tag ":")))
683 (org-end-of-subtree t)
684 (push (cons (org-current-line) (org-entry-properties)) cache)))
660 (when cache 685 (when cache
661 (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) 686 (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
662 (org-set-local 'org-columns-current-maxwidths maxwidths) 687 (org-set-local 'org-columns-current-maxwidths maxwidths)
@@ -664,12 +689,34 @@ around it."
664 (when (org-set-local 'org-columns-flyspell-was-active 689 (when (org-set-local 'org-columns-flyspell-was-active
665 (org-bound-and-true-p flyspell-mode)) 690 (org-bound-and-true-p flyspell-mode))
666 (flyspell-mode 0)) 691 (flyspell-mode 0))
692 (unless (local-variable-p 'org-colview-initial-truncate-line-value)
693 (org-set-local 'org-colview-initial-truncate-line-value
694 truncate-lines))
695 (setq truncate-lines t)
667 (mapc (lambda (x) 696 (mapc (lambda (x)
668 (goto-line (car x)) 697 (goto-line (car x))
669 (org-columns-display-here (cdr x))) 698 (org-columns-display-here (cdr x)))
670 cache))))) 699 cache)))))
671 700
672(defun org-columns-new (&optional prop title width op fmt &rest rest) 701(defvar org-columns-compile-map
702 '(("none" none +)
703 (":" add_times +)
704 ("+" add_numbers +)
705 ("$" currency +)
706 ("X" checkbox +)
707 ("X/" checkbox-n-of-m +)
708 ("X%" checkbox-percent +)
709 ("max" max_numbers max)
710 ("min" min_numbers min)
711 ("mean" mean_numbers (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
712 (":max" max_times max)
713 (":min" min_times min)
714 (":mean" mean_times (lambda (&rest x) (/ (apply '+ x) (float (length x))))))
715 "Operator <-> format,function map.
716Used to compile/uncompile columns format and completing read in
717interactive function org-columns-new.")
718
719(defun org-columns-new (&optional prop title width op fmt fun &rest rest)
673 "Insert a new column, to the left of the current column." 720 "Insert a new column, to the left of the current column."
674 (interactive) 721 (interactive)
675 (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) 722 (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
@@ -682,20 +729,21 @@ around it."
682 (if (string-match "\\S-" width) 729 (if (string-match "\\S-" width)
683 (setq width (string-to-number width)) 730 (setq width (string-to-number width))
684 (setq width nil)) 731 (setq width nil))
685 (setq fmt (org-ido-completing-read "Summary [none]: " 732 (setq fmt (org-ido-completing-read
686 '(("none") ("add_numbers") ("currency") ("add_times") ("checkbox") ("checkbox-n-of-m") ("checkbox-percent")) 733 "Summary [none]: "
687 nil t)) 734 (mapcar (lambda (x) (list (symbol-name (cadr x))))
688 (if (string-match "\\S-" fmt) 735 org-columns-compile-map)
689 (setq fmt (intern fmt)) 736 nil t))
690 (setq fmt nil)) 737 (setq fmt (intern fmt)
738 fun (cadr (assoc fmt (mapcar 'cdr org-columns-compile-map))))
691 (if (eq fmt 'none) (setq fmt nil)) 739 (if (eq fmt 'none) (setq fmt nil))
692 (if editp 740 (if editp
693 (progn 741 (progn
694 (setcar editp prop) 742 (setcar editp prop)
695 (setcdr editp (list title width nil fmt))) 743 (setcdr editp (list title width nil fmt nil fun)))
696 (setq cell (nthcdr (1- (current-column)) 744 (setq cell (nthcdr (1- (current-column))
697 org-columns-current-fmt-compiled)) 745 org-columns-current-fmt-compiled))
698 (setcdr cell (cons (list prop title width nil fmt) 746 (setcdr cell (cons (list prop title width nil fmt nil fun)
699 (cdr cell)))) 747 (cdr cell))))
700 (org-columns-store-format) 748 (org-columns-store-format)
701 (org-columns-redo))) 749 (org-columns-redo)))
@@ -840,12 +888,13 @@ Don't set this, this is meant for dynamic scoping.")
840 (interactive) 888 (interactive)
841 (let* ((re (concat "^" outline-regexp)) 889 (let* ((re (concat "^" outline-regexp))
842 (lmax 30) ; Does anyone use deeper levels??? 890 (lmax 30) ; Does anyone use deeper levels???
843 (lsum (make-vector lmax 0)) 891 (lvals (make-vector lmax nil))
844 (lflag (make-vector lmax nil)) 892 (lflag (make-vector lmax nil))
845 (level 0) 893 (level 0)
846 (ass (assoc property org-columns-current-fmt-compiled)) 894 (ass (assoc property org-columns-current-fmt-compiled))
847 (format (nth 4 ass)) 895 (format (nth 4 ass))
848 (printf (nth 5 ass)) 896 (printf (nth 5 ass))
897 (fun (nth 6 ass))
849 (beg org-columns-top-level-marker) 898 (beg org-columns-top-level-marker)
850 last-level val valflag flag end sumpos sum-alist sum str str1 useval) 899 last-level val valflag flag end sumpos sum-alist sum str str1 useval)
851 (save-excursion 900 (save-excursion
@@ -863,7 +912,8 @@ Don't set this, this is meant for dynamic scoping.")
863 (cond 912 (cond
864 ((< level last-level) 913 ((< level last-level)
865 ;; put the sum of lower levels here as a property 914 ;; put the sum of lower levels here as a property
866 (setq sum (aref lsum last-level) ; current sum 915 (setq sum (when (aref lvals last-level)
916 (apply fun (aref lvals last-level)))
867 flag (aref lflag last-level) ; any valid entries from children? 917 flag (aref lflag last-level) ; any valid entries from children?
868 str (org-columns-number-to-string sum format printf) 918 str (org-columns-number-to-string sum format printf)
869 str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) 919 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.")
879 (org-entry-put nil property (if flag str val))) 929 (org-entry-put nil property (if flag str val)))
880 ;; add current to current level accumulator 930 ;; add current to current level accumulator
881 (when (or flag valflag) 931 (when (or flag valflag)
882 (aset lsum level (+ (aref lsum level) 932 (push (if flag sum
883 (if flag sum (org-column-string-to-number 933 (org-column-string-to-number (if flag str val) format))
884 (if flag str val) format)))) 934 (aref lvals level))
885 (aset lflag level t)) 935 (aset lflag level t))
886 ;; clear accumulators for deeper levels 936 ;; clear accumulators for deeper levels
887 (loop for l from (1+ level) to (1- lmax) do 937 (loop for l from (1+ level) to (1- lmax) do
888 (aset lsum l 0) 938 (aset lvals l nil)
889 (aset lflag l nil))) 939 (aset lflag l nil)))
890 ((>= level last-level) 940 ((>= level last-level)
891 ;; add what we have here to the accumulator for this level 941 ;; add what we have here to the accumulator for this level
892 (aset lsum level (+ (aref lsum level) 942 (when valflag
893 (org-column-string-to-number (or val "0") format))) 943 (push (org-column-string-to-number val format)
894 (and valflag (aset lflag level t))) 944 (aref lvals level))
945 (aset lflag level t)))
895 (t (error "This should not happen"))))))) 946 (t (error "This should not happen")))))))
896 947
897(defun org-columns-redo () 948(defun org-columns-redo ()
@@ -929,7 +980,8 @@ Don't set this, this is meant for dynamic scoping.")
929(defun org-columns-number-to-string (n fmt &optional printf) 980(defun org-columns-number-to-string (n fmt &optional printf)
930 "Convert a computed column number to a string value, according to FMT." 981 "Convert a computed column number to a string value, according to FMT."
931 (cond 982 (cond
932 ((eq fmt 'add_times) 983 ((not (numberp n)) "")
984 ((memq fmt '(add_times max_times min_times mean_times))
933 (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h)))))) 985 (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h))))))
934 (format org-time-clocksum-format h m))) 986 (format org-time-clocksum-format h m)))
935 ((eq fmt 'checkbox) 987 ((eq fmt 'checkbox)
@@ -963,21 +1015,17 @@ Don't set this, this is meant for dynamic scoping.")
963 1015
964(defun org-columns-uncompile-format (cfmt) 1016(defun org-columns-uncompile-format (cfmt)
965 "Turn the compiled columns format back into a string representation." 1017 "Turn the compiled columns format back into a string representation."
966 (let ((rtn "") e s prop title op width fmt printf) 1018 (let ((rtn "") e s prop title op op-match width fmt printf)
967 (while (setq e (pop cfmt)) 1019 (while (setq e (pop cfmt))
968 (setq prop (car e) 1020 (setq prop (car e)
969 title (nth 1 e) 1021 title (nth 1 e)
970 width (nth 2 e) 1022 width (nth 2 e)
971 op (nth 3 e) 1023 op (nth 3 e)
972 fmt (nth 4 e) 1024 fmt (nth 4 e)
973 printf (nth 5 e)) 1025 printf (nth 5 e)
974 (cond 1026 fun (nth 6 e))
975 ((eq fmt 'add_times) (setq op ":")) 1027 (when (setq op-match (rassoc (list fmt fun) org-columns-compile-map))
976 ((eq fmt 'checkbox) (setq op "X")) 1028 (setq op (car op-match)))
977 ((eq fmt 'checkbox-n-of-m) (setq op "X/"))
978 ((eq fmt 'checkbox-percent) (setq op "X%"))
979 ((eq fmt 'add_numbers) (setq op "+"))
980 ((eq fmt 'currency) (setq op "$")))
981 (if (and op printf) (setq op (concat op ";" printf))) 1029 (if (and op printf) (setq op (concat op ";" printf)))
982 (if (equal title prop) (setq title nil)) 1030 (if (equal title prop) (setq title nil))
983 (setq s (concat "%" (if width (number-to-string width)) 1031 (setq s (concat "%" (if width (number-to-string width))
@@ -996,8 +1044,9 @@ title the title field for the columns
996width the column width in characters, can be nil for automatic 1044width the column width in characters, can be nil for automatic
997operator the operator if any 1045operator the operator if any
998format the output format for computed results, derived from operator 1046format the output format for computed results, derived from operator
999printf a printf format for computed values" 1047printf a printf format for computed values
1000 (let ((start 0) width prop title op f printf) 1048fun the lisp function to compute values, derived from operator"
1049 (let ((start 0) width prop title op op-match f printf fun)
1001 (setq org-columns-current-fmt-compiled nil) 1050 (setq org-columns-current-fmt-compiled nil)
1002 (while (string-match 1051 (while (string-match
1003 (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") 1052 (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*")
@@ -1008,20 +1057,16 @@ printf a printf format for computed values"
1008 title (or (match-string 3 fmt) prop) 1057 title (or (match-string 3 fmt) prop)
1009 op (match-string 4 fmt) 1058 op (match-string 4 fmt)
1010 f nil 1059 f nil
1011 printf nil) 1060 printf nil
1061 fun '+)
1012 (if width (setq width (string-to-number width))) 1062 (if width (setq width (string-to-number width)))
1013 (when (and op (string-match ";" op)) 1063 (when (and op (string-match ";" op))
1014 (setq printf (substring op (match-end 0)) 1064 (setq printf (substring op (match-end 0))
1015 op (substring op 0 (match-beginning 0)))) 1065 op (substring op 0 (match-beginning 0))))
1016 (cond 1066 (when (setq op-match (assoc op org-columns-compile-map))
1017 ((equal op "+") (setq f 'add_numbers)) 1067 (setq f (cadr op-match)
1018 ((equal op "$") (setq f 'currency)) 1068 fun (caddr op-match)))
1019 ((equal op ":") (setq f 'add_times)) 1069 (push (list prop title width op f printf fun) org-columns-current-fmt-compiled))
1020 ((equal op "X") (setq f 'checkbox))
1021 ((equal op "X/") (setq f 'checkbox-n-of-m))
1022 ((equal op "X%") (setq f 'checkbox-percent))
1023 )
1024 (push (list prop title width op f printf) org-columns-current-fmt-compiled))
1025 (setq org-columns-current-fmt-compiled 1070 (setq org-columns-current-fmt-compiled
1026 (nreverse org-columns-current-fmt-compiled)))) 1071 (nreverse org-columns-current-fmt-compiled))))
1027 1072
@@ -1038,25 +1083,36 @@ containing the title row and all other rows. Each row is a list
1038of fields." 1083of fields."
1039 (save-excursion 1084 (save-excursion
1040 (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) 1085 (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
1086 (re-comment (concat "\\*+[ \t]+" org-comment-string "\\>"))
1087 (re-archive (concat ".*:" org-archive-tag ":"))
1041 (n (length title)) row tbl) 1088 (n (length title)) row tbl)
1042 (goto-char (point-min)) 1089 (goto-char (point-min))
1043 (while (re-search-forward "^\\(\\*+\\) " nil t) 1090 (while (re-search-forward "^\\(\\*+\\) " nil t)
1044 (when (and (or (null maxlevel) 1091 (catch 'next
1045 (>= maxlevel 1092 (when (and (or (null maxlevel)
1046 (if org-odd-levels-only 1093 (>= maxlevel
1047 (/ (1+ (length (match-string 1))) 2) 1094 (if org-odd-levels-only
1048 (length (match-string 1))))) 1095 (/ (1+ (length (match-string 1))) 2)
1049 (get-char-property (match-beginning 0) 'org-columns-key)) 1096 (length (match-string 1)))))
1050 (setq row nil) 1097 (get-char-property (match-beginning 0) 'org-columns-key))
1051 (loop for i from 0 to (1- n) do 1098 (when (save-excursion
1052 (push (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified) 1099 (goto-char (point-at-bol))
1053 (get-char-property (+ (match-beginning 0) i) 'org-columns-value) 1100 (or (looking-at re-comment)
1054 "") 1101 (looking-at re-archive)))
1055 row)) 1102 (org-end-of-subtree t)
1056 (setq row (nreverse row)) 1103 (throw 'next t))
1057 (unless (and skip-empty-rows 1104 (setq row nil)
1058 (eq 1 (length (delete "" (delete-dups row))))) 1105 (loop for i from 0 to (1- n) do
1059 (push row tbl)))) 1106 (push
1107 (org-quote-vert
1108 (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified)
1109 (get-char-property (+ (match-beginning 0) i) 'org-columns-value)
1110 ""))
1111 row))
1112 (setq row (nreverse row))
1113 (unless (and skip-empty-rows
1114 (eq 1 (length (delete "" (delete-dups (copy-sequence row))))))
1115 (push row tbl)))))
1060 (append (list title 'hline) (nreverse tbl))))) 1116 (append (list title 'hline) (nreverse tbl)))))
1061 1117
1062(defun org-dblock-write:columnview (params) 1118(defun org-dblock-write:columnview (params)
@@ -1148,7 +1204,7 @@ PARAMS is a property list of parameters:
1148 (while (setq line (pop content-lines)) 1204 (while (setq line (pop content-lines))
1149 (when (string-match "^#" line) 1205 (when (string-match "^#" line)
1150 (insert "\n" line) 1206 (insert "\n" line)
1151 (when (string-match "^#\\+TBLFM" line) 1207 (when (string-match "^[ \t]*#\\+TBLFM" line)
1152 (setq recalc t)))) 1208 (setq recalc t))))
1153 (if recalc 1209 (if recalc
1154 (progn (goto-char pos) (org-table-recalculate 'all)) 1210 (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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -31,8 +31,13 @@
31 31
32;;; Code: 32;;; Code:
33 33
34(eval-when-compile
35 (require 'cl))
36
34(require 'org-macs) 37(require 'org-macs)
35 38
39(declare-function find-library-name "find-func" (library))
40
36(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself 41(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself
37(defconst org-format-transports-properties-p 42(defconst org-format-transports-properties-p
38 (let ((x "a")) 43 (let ((x "a"))
@@ -43,17 +48,25 @@
43(defun org-compatible-face (inherits specs) 48(defun org-compatible-face (inherits specs)
44 "Make a compatible face specification. 49 "Make a compatible face specification.
45If INHERITS is an existing face and if the Emacs version supports it, 50If INHERITS is an existing face and if the Emacs version supports it,
46just inherit the face. If not, use SPECS to define the face. 51just inherit the face. If INHERITS is set and the Emacs version does
52not support it, copy the face specification from the inheritance face.
53If INHERITS is not given and SPECS is, use SPECS to define the face.
47XEmacs and Emacs 21 do not know about the `min-colors' attribute. 54XEmacs and Emacs 21 do not know about the `min-colors' attribute.
48For them we convert a (min-colors 8) entry to a `tty' entry and move it 55For them we convert a (min-colors 8) entry to a `tty' entry and move it
49to the top of the list. The `min-colors' attribute will be removed from 56to the top of the list. The `min-colors' attribute will be removed from
50any other entries, and any resulting duplicates will be removed entirely." 57any other entries, and any resulting duplicates will be removed entirely."
58 (when (and inherits (facep inherits) (not specs))
59 (setq specs (or specs
60 (get inherits 'saved-face)
61 (get inherits 'face-defface-spec))))
51 (cond 62 (cond
52 ((and inherits (facep inherits) 63 ((and inherits (facep inherits)
53 (not (featurep 'xemacs)) (> emacs-major-version 22)) 64 (not (featurep 'xemacs))
54 ;; In Emacs 23, we use inheritance where possible. 65 (>= emacs-major-version 22)
55 ;; We only do this in Emacs 23, because only there the outline 66 ;; do not inherit outline faces before Emacs 23
56 ;; faces have been changed to the original org-mode-level-faces. 67 (or (>= emacs-major-version 23)
68 (not (string-match "\\`outline-[0-9]+"
69 (symbol-name inherits)))))
57 (list (list t :inherit inherits))) 70 (list (list t :inherit inherits)))
58 ((or (featurep 'xemacs) (< emacs-major-version 22)) 71 ((or (featurep 'xemacs) (< emacs-major-version 22))
59 ;; These do not understand the `min-colors' attribute. 72 ;; These do not understand the `min-colors' attribute.
@@ -185,6 +198,11 @@ Works on both Emacs and XEmacs."
185 (use-region-p) 198 (use-region-p)
186 (and transient-mark-mode mark-active))))) ; Emacs 22 and before 199 (and transient-mark-mode mark-active))))) ; Emacs 22 and before
187 200
201(defun org-cursor-to-region-beginning ()
202 (when (and (org-region-active-p)
203 (> (point) (region-beginning)))
204 (exchange-point-and-mark)))
205
188;; Invisibility compatibility 206;; Invisibility compatibility
189 207
190(defun org-add-to-invisibility-spec (arg) 208(defun org-add-to-invisibility-spec (arg)
@@ -290,6 +308,16 @@ that can be added."
290 (org-no-properties (substring string (or from 0) to)) 308 (org-no-properties (substring string (or from 0) to))
291 (substring-no-properties string from to))) 309 (substring-no-properties string from to)))
292 310
311(defun org-find-library-name (library)
312 (if (fboundp 'find-library-name)
313 (file-name-directory (find-library-name library))
314 ; XEmacs does not have `find-library-name'
315 (flet ((find-library-name-helper (filename ignored-codesys)
316 filename)
317 (find-library-name (library)
318 (find-library library nil 'find-library-name-helper)))
319 (file-name-directory (find-library-name library)))))
320
293(defun org-count-lines (s) 321(defun org-count-lines (s)
294 "How many lines in string S?" 322 "How many lines in string S?"
295 (let ((start 0) (n 1)) 323 (let ((start 0) (n 1))
@@ -299,6 +327,11 @@ that can be added."
299 (setq n (1- n))) 327 (setq n (1- n)))
300 n)) 328 n))
301 329
330(defun org-kill-new (string &rest args)
331 (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t)
332 string)
333 (apply 'kill-new string args))
334
302(provide 'org-compat) 335(provide 'org-compat)
303 336
304;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe 337;; 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 @@
1;;; org-docbook.el --- DocBook exporter for org-mode
2;;
3;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
4;;
5;; Emacs Lisp Archive Entry
6;; Filename: org-docbook.el
7;; Version: 6.29c
8;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
9;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
10;; Keywords: org, wp, docbook
11;; Description: Converts an org-mode buffer into DocBook
12;; $Id: org-docbook.el 35 2009-03-23 01:03:21Z baoqiu $
13;; URL:
14
15;; This file is NOT part of GNU Emacs.
16
17;; GNU Emacs is free software: you can redistribute it and/or modify
18;; it under the terms of the GNU General Public License as published by
19;; the Free Software Foundation, either version 3 of the License, or
20;; (at your option) any later version.
21
22;; GNU Emacs is distributed in the hope that it will be useful,
23;; but WITHOUT ANY WARRANTY; without even the implied warranty of
24;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25;; GNU General Public License for more details.
26
27;; You should have received a copy of the GNU General Public License
28;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29
30;; Commentary:
31;;
32;; This library implements a DocBook exporter for org-mode. The basic
33;; idea and design is very similar to what `org-export-as-html' has.
34;; Code prototype was also started with `org-export-as-html'.
35;;
36;; Put this file into your load-path and the following line into your
37;; ~/.emacs:
38;;
39;; (require 'org-docbook)
40;;
41;; The interactive functions are similar to those of the HTML and LaTeX
42;; exporters:
43;;
44;; M-x `org-export-as-docbook'
45;; M-x `org-export-as-docbook-pdf'
46;; M-x `org-export-as-docbook-pdf-and-open'
47;; M-x `org-export-as-docbook-batch'
48;; M-x `org-export-as-docbook-to-buffer'
49;; M-x `org-export-region-as-docbook'
50;; M-x `org-replace-region-by-docbook'
51;;
52;; Note that, in order to generate PDF files using the DocBook XML files
53;; created by DocBook exporter, the following two variables have to be
54;; set based on what DocBook tools you use for XSLT processor and XSL-FO
55;; processor:
56;;
57;; org-export-docbook-xslt-proc-command
58;; org-export-docbook-xsl-fo-proc-command
59;;
60;; Check the document of these two variables to see examples of how they
61;; can be set.
62;;
63;; If the Org file to be exported contains special characters written in
64;; TeX-like syntax, like \alpha and \beta, you need to include the right
65;; entity file(s) in the DOCTYPE declaration for the DocBook XML file.
66;; This is required to make the DocBook XML file valid. The DOCTYPE
67;; declaration string can be set using the following variable:
68;;
69;; org-export-docbook-doctype
70;;
71;;; Code:
72
73(eval-when-compile
74 (require 'cl))
75
76(require 'footnote)
77(require 'org)
78(require 'org-exp)
79(require 'org-html)
80
81;;; Variables:
82
83(defvar org-docbook-para-open nil)
84(defvar org-export-docbook-inline-images t)
85(defvar org-export-docbook-link-org-files-as-docbook nil)
86
87(declare-function org-id-find-id-file "org-id" (id))
88
89;;; User variables:
90
91(defgroup org-export-docbook nil
92 "Options for exporting Org-mode files to DocBook."
93 :tag "Org Export DocBook"
94 :group 'org-export)
95
96(defcustom org-export-docbook-extension ".xml"
97 "Extension of DocBook XML files."
98 :group 'org-export-docbook
99 :type 'string)
100
101(defcustom org-export-docbook-header "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
102 "Header of DocBook XML files."
103 :group 'org-export-docbook
104 :type 'string)
105
106(defcustom org-export-docbook-doctype nil
107 "DOCTYPE declaration string for DocBook XML files.
108This can be used to include entities that are needed to handle
109special characters in Org files.
110
111For example, if the Org file to be exported contains XHTML
112entities, you can set this variable to:
113
114\"<!DOCTYPE article [
115<!ENTITY % xhtml1-symbol PUBLIC
116\"-//W3C//ENTITIES Symbol for HTML//EN//XML\"
117\"http://www.w3.org/2003/entities/2007/xhtml1-symbol.ent\"
118>
119%xhtml1-symbol;
120]>
121\"
122
123If you want to process DocBook documents without internet
124connection, it is suggested that you download the required entity
125file(s) and use system identifier(s) (external files) in the
126DOCTYPE declaration."
127 :group 'org-export-docbook
128 :type 'string)
129
130(defcustom org-export-docbook-article-header "<article xmlns=\"http://docbook.org/ns/docbook\"
131 xmlns:xlink=\"http://www.w3.org/1999/xlink\" version=\"5.0\" xml:lang=\"en\">"
132 "Article header of DocBook XML files."
133 :group 'org-export-docbook
134 :type 'string)
135
136(defcustom org-export-docbook-section-id-prefix "sec-"
137 "Prefix of section IDs used during exporting.
138This can be set before exporting to avoid same set of section IDs
139being used again and again, which can be a problem when multiple
140people work on the same document."
141 :group 'org-export-docbook
142 :type 'string)
143
144(defcustom org-export-docbook-footnote-id-prefix "fn-"
145 "The prefix of footnote IDs used during exporting. Like
146`org-export-docbook-section-id-prefix', this variable can help
147avoid same set of footnote IDs being used multiple times."
148 :group 'org-export-docbook
149 :type 'string)
150
151(defcustom org-export-docbook-emphasis-alist
152 `(("*" "<emphasis role=\"bold\">" "</emphasis>")
153 ("/" "<emphasis>" "</emphasis>")
154 ("_" "<emphasis role=\"underline\">" "</emphasis>")
155 ("=" "<code>" "</code>")
156 ("~" "<literal>" "</literal>")
157 ("+" "<emphasis role=\"strikethrough\">" "</emphasis>"))
158 "Alist of DocBook expressions to convert emphasis fontifiers.
159Each element of the list is a list of three elements.
160The first element is the character used as a marker for fontification.
161The second element is a formatting string to wrap fontified text with.
162The third element decides whether to protect converted text from other
163conversions."
164 :group 'org-export-docbook
165 :type 'alist)
166
167(defcustom org-export-docbook-default-image-attributes
168 `(("align" . "\"center\"")
169 ("valign". "\"middle\""))
170 "Alist of default DocBook image attributes.
171These attributes will be inserted into element <imagedata> by
172default, but users can override them using `#+ATTR_DocBook:'."
173 :group 'org-export-docbook
174 :type 'alist)
175
176(defcustom org-export-docbook-inline-image-extensions
177 '("jpeg" "jpg" "png" "gif" "svg")
178 "Extensions of image files that can be inlined into DocBook."
179 :group 'org-export-docbook
180 :type '(repeat (string :tag "Extension")))
181
182(defcustom org-export-docbook-coding-system nil
183 "Coding system for DocBook XML files."
184 :group 'org-export-docbook
185 :type 'coding-system)
186
187(defcustom org-export-docbook-xslt-proc-command nil
188 "XSLT processor command used by DocBook exporter.
189This is the command used to process a DocBook XML file to
190generate the formatting object (FO) file.
191
192The value of this variable should be a format control string that
193includes two `%s' arguments: the first one is for the output FO
194file name, and the second one is for the input DocBook XML file
195name.
196
197For example, if you use Saxon as the XSLT processor, you may want
198to set the variable to
199
200 \"java com.icl.saxon.StyleSheet -o %s %s /path/to/docbook.xsl\"
201
202If you use Xalan, you can set it to
203
204 \"java org.apache.xalan.xslt.Process -out %s -in %s -xsl /path/to/docbook.xsl\"
205
206For xsltproc, the following string should work:
207
208 \"xsltproc --output %s /path/to/docbook.xsl %s\"
209
210You need to replace \"/path/to/docbook.xsl\" with the actual path
211to the DocBook stylesheet file on your machine. You can also
212replace it with your own customization layer if you have one.
213
214You can include additional stylesheet parameters in this command.
215Just make sure that they meet the syntax requirement of each
216processor."
217 :group 'org-export-docbook
218 :type 'string)
219
220(defcustom org-export-docbook-xsl-fo-proc-command nil
221 "XSL-FO processor command used by DocBook exporter.
222This is the command used to process a formatting object (FO) file
223to generate the PDF file.
224
225The value of this variable should be a format control string that
226includes two `%s' arguments: the first one is for the input FO
227file name, and the second one is for the output PDF file name.
228
229For example, if you use FOP as the XSL-FO processor, you can set
230the variable to
231
232 \"fop %s %s\""
233 :group 'org-export-docbook
234 :type 'string)
235
236(defcustom org-export-docbook-keywords-markup "<literal>%s</literal>"
237 "A printf format string to be applied to keywords by DocBook exporter."
238 :group 'org-export-docbook
239 :type 'string)
240
241(defcustom org-export-docbook-timestamp-markup "<emphasis>%s</emphasis>"
242 "A printf format string to be applied to time stamps by DocBook exporter."
243 :group 'org-export-docbook
244 :type 'string)
245
246;;; Autoload functions:
247
248;;;###autoload
249(defun org-export-as-docbook-batch ()
250 "Call `org-export-as-docbook' in batch style.
251This function can be used in batch processing.
252
253For example:
254
255$ emacs --batch
256 --load=$HOME/lib/emacs/org.el
257 --visit=MyOrgFile.org --funcall org-export-as-docbook-batch"
258 (org-export-as-docbook 'hidden))
259
260;;;###autoload
261(defun org-export-as-docbook-to-buffer ()
262 "Call `org-export-as-docbook' with output to a temporary buffer.
263No file is created."
264 (interactive)
265 (org-export-as-docbook nil nil "*Org DocBook Export*")
266 (when org-export-show-temporary-export-buffer
267 (switch-to-buffer-other-window "*Org DocBook Export*")))
268
269;;;###autoload
270(defun org-replace-region-by-docbook (beg end)
271 "Replace the region from BEG to END with its DocBook export.
272It assumes the region has `org-mode' syntax, and then convert it to
273DocBook. This can be used in any buffer. For example, you could
274write an itemized list in `org-mode' syntax in an DocBook buffer and
275then use this command to convert it."
276 (interactive "r")
277 (let (reg docbook buf)
278 (save-window-excursion
279 (if (org-mode-p)
280 (setq docbook (org-export-region-as-docbook
281 beg end t 'string))
282 (setq reg (buffer-substring beg end)
283 buf (get-buffer-create "*Org tmp*"))
284 (save-excursion
285 (set-buffer buf)
286 (erase-buffer)
287 (insert reg)
288 (org-mode)
289 (setq docbook (org-export-region-as-docbook
290 (point-min) (point-max) t 'string)))
291 (kill-buffer buf)))
292 (delete-region beg end)
293 (insert docbook)))
294
295;;;###autoload
296(defun org-export-region-as-docbook (beg end &optional body-only buffer)
297 "Convert region from BEG to END in `org-mode' buffer to DocBook.
298If prefix arg BODY-ONLY is set, omit file header and footer and
299only produce the region of converted text, useful for
300cut-and-paste operations. If BUFFER is a buffer or a string,
301use/create that buffer as a target of the converted DocBook. If
302BUFFER is the symbol `string', return the produced DocBook as a
303string and leave not buffer behind. For example, a Lisp program
304could call this function in the following way:
305
306 (setq docbook (org-export-region-as-docbook beg end t 'string))
307
308When called interactively, the output buffer is selected, and shown
309in a window. A non-interactive call will only return the buffer."
310 (interactive "r\nP")
311 (when (interactive-p)
312 (setq buffer "*Org DocBook Export*"))
313 (let ((transient-mark-mode t)
314 (zmacs-regions t)
315 rtn)
316 (goto-char end)
317 (set-mark (point)) ;; To activate the region
318 (goto-char beg)
319 (setq rtn (org-export-as-docbook
320 nil nil
321 buffer body-only))
322 (if (fboundp 'deactivate-mark) (deactivate-mark))
323 (if (and (interactive-p) (bufferp rtn))
324 (switch-to-buffer-other-window rtn)
325 rtn)))
326
327;;;###autoload
328(defun org-export-as-docbook-pdf (&optional hidden ext-plist
329 to-buffer body-only pub-dir)
330 "Export as DocBook XML file, and generate PDF file."
331 (interactive "P")
332 (if (or (not org-export-docbook-xslt-proc-command)
333 (not (string-match "%s.+%s" org-export-docbook-xslt-proc-command)))
334 (error "XSLT processor command is not set correctly"))
335 (if (or (not org-export-docbook-xsl-fo-proc-command)
336 (not (string-match "%s.+%s" org-export-docbook-xsl-fo-proc-command)))
337 (error "XSL-FO processor command is not set correctly"))
338 (message "Exporting to PDF...")
339 (let* ((wconfig (current-window-configuration))
340 (docbook-buf (org-export-as-docbook hidden ext-plist
341 to-buffer body-only pub-dir))
342 (filename (buffer-file-name docbook-buf))
343 (base (file-name-sans-extension filename))
344 (fofile (concat base ".fo"))
345 (pdffile (concat base ".pdf")))
346 (and (file-exists-p pdffile) (delete-file pdffile))
347 (message "Processing DocBook XML file...")
348 (shell-command (format org-export-docbook-xslt-proc-command
349 fofile (shell-quote-argument filename)))
350 (shell-command (format org-export-docbook-xsl-fo-proc-command
351 fofile pdffile))
352 (message "Processing DocBook file...done")
353 (if (not (file-exists-p pdffile))
354 (error "PDF file was not produced")
355 (set-window-configuration wconfig)
356 (message "Exporting to PDF...done")
357 pdffile)))
358
359;;;###autoload
360(defun org-export-as-docbook-pdf-and-open ()
361 "Export as DocBook XML file, generate PDF file, and open it."
362 (interactive)
363 (let ((pdffile (org-export-as-docbook-pdf)))
364 (if pdffile
365 (org-open-file pdffile)
366 (error "PDF file was not produced"))))
367
368;;;###autoload
369(defun org-export-as-docbook (&optional hidden ext-plist
370 to-buffer body-only pub-dir)
371 "Export the current buffer as a DocBook file.
372If there is an active region, export only the region. When
373HIDDEN is obsolete and does nothing. EXT-PLIST is a
374property list with external parameters overriding org-mode's
375default settings, but still inferior to file-local settings.
376When TO-BUFFER is non-nil, create a buffer with that name and
377export to that buffer. If TO-BUFFER is the symbol `string',
378don't leave any buffer behind but just return the resulting HTML
379as a string. When BODY-ONLY is set, don't produce the file
380header and footer, simply return the content of the document (all
381top-level sections). When PUB-DIR is set, use this as the
382publishing directory."
383 (interactive "P")
384 ;; Make sure we have a file name when we need it.
385 (when (and (not (or to-buffer body-only))
386 (not buffer-file-name))
387 (if (buffer-base-buffer)
388 (org-set-local 'buffer-file-name
389 (with-current-buffer (buffer-base-buffer)
390 buffer-file-name))
391 (error "Need a file name to be able to export.")))
392
393 (message "Exporting...")
394 (setq-default org-todo-line-regexp org-todo-line-regexp)
395 (setq-default org-deadline-line-regexp org-deadline-line-regexp)
396 (setq-default org-done-keywords org-done-keywords)
397 (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
398 (let* ((opt-plist
399 (org-export-process-option-filters
400 (org-combine-plists (org-default-export-plist)
401 ext-plist
402 (org-infile-export-plist))))
403 (link-validate (plist-get opt-plist :link-validation-function))
404 valid
405 (odd org-odd-levels-only)
406 (region-p (org-region-active-p))
407 (rbeg (and region-p (region-beginning)))
408 (rend (and region-p (region-end)))
409 (subtree-p
410 (if (plist-get opt-plist :ignore-subree-p)
411 nil
412 (when region-p
413 (save-excursion
414 (goto-char rbeg)
415 (and (org-at-heading-p)
416 (>= (org-end-of-subtree t t) rend))))))
417 (level-offset (if subtree-p
418 (save-excursion
419 (goto-char rbeg)
420 (+ (funcall outline-level)
421 (if org-odd-levels-only 1 0)))
422 0))
423 (opt-plist (setq org-export-opt-plist
424 (if subtree-p
425 (org-export-add-subtree-options opt-plist rbeg)
426 opt-plist)))
427 ;; The following two are dynamically scoped into other
428 ;; routines below.
429 (org-current-export-dir
430 (or pub-dir (org-export-directory :docbook opt-plist)))
431 (org-current-export-file buffer-file-name)
432 (level 0) (line "") (origline "") txt todo
433 (filename (if to-buffer nil
434 (expand-file-name
435 (concat
436 (file-name-sans-extension
437 (or (and subtree-p
438 (org-entry-get (region-beginning)
439 "EXPORT_FILE_NAME" t))
440 (file-name-nondirectory buffer-file-name)))
441 org-export-docbook-extension)
442 (file-name-as-directory
443 (or pub-dir (org-export-directory :docbook opt-plist))))))
444 (current-dir (if buffer-file-name
445 (file-name-directory buffer-file-name)
446 default-directory))
447 (buffer (if to-buffer
448 (cond
449 ((eq to-buffer 'string) (get-buffer-create "*Org DocBook Export*"))
450 (t (get-buffer-create to-buffer)))
451 (find-file-noselect filename)))
452 ;; org-levels-open is a global variable
453 (org-levels-open (make-vector org-level-max nil))
454 (date (plist-get opt-plist :date))
455 (author (or (plist-get opt-plist :author)
456 user-full-name))
457 (email (plist-get opt-plist :email))
458 firstname othername surname
459 (title (or (and subtree-p (org-export-get-title-from-subtree))
460 (plist-get opt-plist :title)
461 (and (not
462 (plist-get opt-plist :skip-before-1st-heading))
463 (org-export-grab-title-from-buffer))
464 (and buffer-file-name
465 (file-name-sans-extension
466 (file-name-nondirectory buffer-file-name)))
467 "UNTITLED"))
468 ;; We will use HTML table formatter to export tables to DocBook
469 ;; format, so need to set html-table-tag here.
470 (html-table-tag (plist-get opt-plist :html-table-tag))
471 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
472 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
473 (inquote nil)
474 (infixed nil)
475 (inverse nil)
476 (in-local-list nil)
477 (local-list-type nil)
478 (local-list-indent nil)
479 (llt org-plain-list-ordered-item-terminator)
480 (email (plist-get opt-plist :email))
481 (language (plist-get opt-plist :language))
482 (lang-words nil)
483 cnt
484 (start 0)
485 (coding-system (and (boundp 'buffer-file-coding-system)
486 buffer-file-coding-system))
487 (coding-system-for-write (or org-export-docbook-coding-system
488 coding-system))
489 (save-buffer-coding-system (or org-export-docbook-coding-system
490 coding-system))
491 (charset (and coding-system-for-write
492 (fboundp 'coding-system-get)
493 (coding-system-get coding-system-for-write
494 'mime-charset)))
495 (region
496 (buffer-substring
497 (if region-p (region-beginning) (point-min))
498 (if region-p (region-end) (point-max))))
499 (lines
500 (org-split-string
501 (org-export-preprocess-string
502 region
503 :emph-multiline t
504 :for-docbook t
505 :skip-before-1st-heading
506 (plist-get opt-plist :skip-before-1st-heading)
507 :drawers (plist-get opt-plist :drawers)
508 :todo-keywords (plist-get opt-plist :todo-keywords)
509 :tags (plist-get opt-plist :tags)
510 :priority (plist-get opt-plist :priority)
511 :footnotes (plist-get opt-plist :footnotes)
512 :timestamps (plist-get opt-plist :timestamps)
513 :archived-trees
514 (plist-get opt-plist :archived-trees)
515 :select-tags (plist-get opt-plist :select-tags)
516 :exclude-tags (plist-get opt-plist :exclude-tags)
517 :add-text
518 (plist-get opt-plist :text)
519 :LaTeX-fragments
520 (plist-get opt-plist :LaTeX-fragments))
521 "[\r\n]"))
522 ;; Use literal output to show check boxes.
523 (checkbox-start
524 (nth 1 (assoc "=" org-export-docbook-emphasis-alist)))
525 (checkbox-end
526 (nth 2 (assoc "=" org-export-docbook-emphasis-alist)))
527 table-open type
528 table-buffer table-orig-buffer
529 ind item-type starter didclose
530 rpl path attr caption label desc descp desc1 desc2 link
531 fnc item-tag
532 footref-seen footnote-list
533 id-file
534 )
535
536 ;; Fine detailed info about author name.
537 (if (string-match "\\([^ ]+\\) \\(.+ \\)?\\([^ ]+\\)" author)
538 (progn
539 (setq firstname (match-string 1 author)
540 othername (or (match-string 2 author) "")
541 surname (match-string 3 author))))
542
543 ;; Get all footnote text.
544 (setq footnote-list
545 (org-export-docbook-get-footnotes lines))
546
547 (let ((inhibit-read-only t))
548 (org-unmodified
549 (remove-text-properties (point-min) (point-max)
550 '(:org-license-to-kill t))))
551
552 (setq org-min-level (org-get-min-level lines level-offset))
553 (setq org-last-level org-min-level)
554 (org-init-section-numbers)
555
556 ;; Get and save the date.
557 (cond
558 ((and date (string-match "%" date))
559 (setq date (format-time-string date)))
560 (date)
561 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
562
563 ;; Get the language-dependent settings
564 (setq lang-words (or (assoc language org-export-language-setup)
565 (assoc "en" org-export-language-setup)))
566
567 ;; Switch to the output buffer. Use fundamental-mode for now. We
568 ;; could turn on nXML mode later and do some indentation.
569 (set-buffer buffer)
570 (let ((inhibit-read-only t)) (erase-buffer))
571 (fundamental-mode)
572 (org-install-letbind)
573
574 (and (fboundp 'set-buffer-file-coding-system)
575 (set-buffer-file-coding-system coding-system-for-write))
576
577 ;; The main body...
578 (let ((case-fold-search nil)
579 (org-odd-levels-only odd))
580
581 ;; Create local variables for all options, to make sure all called
582 ;; functions get the correct information
583 (mapc (lambda (x)
584 (set (make-local-variable (nth 2 x))
585 (plist-get opt-plist (car x))))
586 org-export-plist-vars)
587
588 ;; Insert DocBook file header, title, and author info.
589 (unless body-only
590 (insert org-export-docbook-header)
591 (if org-export-docbook-doctype
592 (insert org-export-docbook-doctype))
593 (insert "<!-- Date: " date " -->\n")
594 (insert (format "<!-- DocBook XML file generated by Org-mode %s Emacs %s -->\n"
595 org-version emacs-major-version))
596 (insert org-export-docbook-article-header)
597 (insert (format
598 "\n <title>%s</title>
599 <info>
600 <author>
601 <personname>
602 <firstname>%s</firstname> <othername>%s</othername> <surname>%s</surname>
603 </personname>
604 %s
605 </author>
606 </info>\n"
607 (org-docbook-expand title)
608 firstname othername surname
609 (if email (concat "<email>" email "</email>") "")
610 )))
611
612 (org-init-section-numbers)
613
614 (org-export-docbook-open-para)
615
616 ;; Loop over all the lines...
617 (while (setq line (pop lines) origline line)
618 (catch 'nextline
619
620 ;; End of quote section?
621 (when (and inquote (string-match "^\\*+ " line))
622 (insert "]]>\n</programlisting>\n")
623 (org-export-docbook-open-para)
624 (setq inquote nil))
625 ;; Inside a quote section?
626 (when inquote
627 (insert (org-docbook-protect line) "\n")
628 (throw 'nextline nil))
629
630 ;; Fixed-width, verbatim lines (examples)
631 (when (and org-export-with-fixed-width
632 (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
633 (when (not infixed)
634 (setq infixed t)
635 (org-export-docbook-close-para-maybe)
636 (insert "<programlisting><![CDATA["))
637 (insert (match-string 3 line) "\n")
638 (when (or (not lines)
639 (not (string-match "^[ \t]*\\(:.*\\)"
640 (car lines))))
641 (setq infixed nil)
642 (insert "]]>\n</programlisting>\n")
643 (org-export-docbook-open-para))
644 (throw 'nextline nil))
645
646 (org-export-docbook-close-lists-maybe line)
647
648 ;; Protected HTML
649 (when (get-text-property 0 'org-protected line)
650 (let (par (ind (get-text-property 0 'original-indentation line)))
651 (when (re-search-backward
652 "\\(<para>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
653 (setq par (match-string 1))
654 (replace-match "\\2\n"))
655 (insert line "\n")
656 (while (and lines
657 (or (= (length (car lines)) 0)
658 (not ind)
659 (equal ind (get-text-property 0 'original-indentation (car lines))))
660 (or (= (length (car lines)) 0)
661 (get-text-property 0 'org-protected (car lines))))
662 (insert (pop lines) "\n"))
663 (and par (insert "<para>\n")))
664 (throw 'nextline nil))
665
666 ;; Start of block quotes and verses
667 (when (or (equal "ORG-BLOCKQUOTE-START" line)
668 (and (equal "ORG-VERSE-START" line)
669 (setq inverse t)))
670 (org-export-docbook-close-para-maybe)
671 (insert "<blockquote>")
672 ;; Check whether attribution for this blockquote exists.
673 (let (tmp1
674 attribution
675 (end (if inverse "ORG-VERSE-END" "ORG-BLOCKQUOTE-END"))
676 (quote-lines nil))
677 (while (and (setq tmp1 (pop lines))
678 (not (equal end tmp1)))
679 (push tmp1 quote-lines))
680 (push tmp1 lines) ; Put back quote end mark
681 ;; Check the last line in the quote to see if it contains
682 ;; the attribution.
683 (setq tmp1 (pop quote-lines))
684 (if (string-match "\\(^.*\\)\\(--[ \t]+\\)\\(.+\\)$" tmp1)
685 (progn
686 (setq attribution (match-string 3 tmp1))
687 (when (save-match-data
688 (string-match "[^ \t]" (match-string 1 tmp1)))
689 (push (match-string 1 tmp1) lines)))
690 (push tmp1 lines))
691 (while (setq tmp1 (pop quote-lines))
692 (push tmp1 lines))
693 (when attribution
694 (insert "<attribution>" attribution "</attribution>")))
695 ;; Insert <literallayout> for verse.
696 (if inverse
697 (insert "\n<literallayout>")
698 (org-export-docbook-open-para))
699 (throw 'nextline nil))
700
701 ;; End of block quotes
702 (when (equal "ORG-BLOCKQUOTE-END" line)
703 (org-export-docbook-close-para-maybe)
704 (insert "</blockquote>\n")
705 (org-export-docbook-open-para)
706 (throw 'nextline nil))
707
708 ;; End of verses
709 (when (equal "ORG-VERSE-END" line)
710 (insert "</literallayout>\n</blockquote>\n")
711 (org-export-docbook-open-para)
712 (setq inverse nil)
713 (throw 'nextline nil))
714
715 ;; Text centering. Element <para role="centered"> does not
716 ;; seem to work with FOP, so for now we use <informaltable> to
717 ;; center the text, which can contain multiple paragraphs.
718 (when (equal "ORG-CENTER-START" line)
719 (org-export-docbook-close-para-maybe)
720 (insert "<informaltable frame=\"none\" colsep=\"0\" rowsep=\"0\">\n"
721 "<tgroup align=\"center\" cols=\"1\">\n"
722 "<tbody><row><entry>\n")
723 (org-export-docbook-open-para)
724 (throw 'nextline nil))
725
726 (when (equal "ORG-CENTER-END" line)
727 (org-export-docbook-close-para-maybe)
728 (insert "</entry></row></tbody>\n"
729 "</tgroup>\n</informaltable>\n")
730 (org-export-docbook-open-para)
731 (throw 'nextline nil))
732
733 ;; Make targets to anchors. Note that currently FOP does not
734 ;; seem to support <anchor> tags when generating PDF output,
735 ;; but this can be used in DocBook --> HTML conversion.
736 (while (string-match "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line)
737 (cond
738 ((match-end 2)
739 (setq line (replace-match
740 (format "@<anchor xml:id=\"%s\"/>"
741 (org-solidify-link-text (match-string 1 line)))
742 t t line)))
743 (t
744 (setq line (replace-match
745 (format "@<anchor xml:id=\"%s\"/>"
746 (org-solidify-link-text (match-string 1 line)))
747 t t line)))))
748
749 ;; Put time stamps and related keywords into special mark-up
750 ;; elements.
751 (setq line (org-export-docbook-handle-time-stamps line))
752
753 ;; Replace "&", "<" and ">" by "&amp;", "&lt;" and "&gt;".
754 ;; Handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>").
755 ;; Also handle sub_superscripts and check boxes.
756 (or (string-match org-table-hline-regexp line)
757 (setq line (org-docbook-expand line)))
758
759 ;; Format the links
760 (setq start 0)
761 (while (string-match org-bracket-link-analytic-regexp++ line start)
762 (setq start (match-beginning 0))
763 (setq path (save-match-data (org-link-unescape
764 (match-string 3 line))))
765 (setq type (cond
766 ((match-end 2) (match-string 2 line))
767 ((save-match-data
768 (or (file-name-absolute-p path)
769 (string-match "^\\.\\.?/" path)))
770 "file")
771 (t "internal")))
772 (setq path (org-extract-attributes (org-link-unescape path)))
773 (setq attr (get-text-property 0 'org-attributes path)
774 caption (get-text-property 0 'org-caption path)
775 label (get-text-property 0 'org-label path))
776 (setq desc1 (if (match-end 5) (match-string 5 line))
777 desc2 (if (match-end 2) (concat type ":" path) path)
778 descp (and desc1 (not (equal desc1 desc2)))
779 desc (or desc1 desc2))
780 ;; Make an image out of the description if that is so wanted
781 (when (and descp (org-file-image-p
782 desc org-export-docbook-inline-image-extensions))
783 (save-match-data
784 (if (string-match "^file:" desc)
785 (setq desc (substring desc (match-end 0))))))
786 ;; FIXME: do we need to unescape here somewhere?
787 (cond
788 ((equal type "internal")
789 (setq rpl (format "<link linkend=\"%s\">%s</link>"
790 (org-solidify-link-text
791 (save-match-data (org-link-unescape path)) nil)
792 (org-export-docbook-format-desc desc))))
793 ((and (equal type "id")
794 (setq id-file (org-id-find-id-file path)))
795 ;; This is an id: link to another file (if it was the same file,
796 ;; it would have become an internal link...)
797 (save-match-data
798 (setq id-file (file-relative-name
799 id-file (file-name-directory org-current-export-file)))
800 (setq id-file (concat (file-name-sans-extension id-file)
801 org-export-docbook-extension))
802 (setq rpl (format "<link xlink:href=\"%s#%s\">%s</link>"
803 id-file path (org-export-docbook-format-desc desc)))))
804 ((member type '("http" "https"))
805 ;; Standard URL, just check if we need to inline an image
806 (if (and (or (eq t org-export-docbook-inline-images)
807 (and org-export-docbook-inline-images (not descp)))
808 (org-file-image-p
809 path org-export-docbook-inline-image-extensions))
810 (setq rpl (org-export-docbook-format-image
811 (concat type ":" path)))
812 (setq link (concat type ":" path))
813 (setq rpl (format "<link xlink:href=\"%s\">%s</link>"
814 (org-export-html-format-href link)
815 (org-export-docbook-format-desc desc)))
816 ))
817 ((member type '("ftp" "mailto" "news"))
818 ;; Standard URL
819 (setq link (concat type ":" path))
820 (setq rpl (format "<link xlink:href=\"%s\">%s</link>"
821 (org-export-html-format-href link)
822 (org-export-docbook-format-desc desc))))
823 ((string= type "coderef")
824 (setq rpl (format (org-export-get-coderef-format path (and descp desc))
825 (cdr (assoc path org-export-code-refs)))))
826 ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
827 ;; The link protocol has a function for format the link
828 (setq rpl
829 (save-match-data
830 (funcall fnc (org-link-unescape path) desc1 'html))))
831
832 ((string= type "file")
833 ;; FILE link
834 (let* ((filename path)
835 (abs-p (file-name-absolute-p filename))
836 thefile file-is-image-p search)
837 (save-match-data
838 (if (string-match "::\\(.*\\)" filename)
839 (setq search (match-string 1 filename)
840 filename (replace-match "" t nil filename)))
841 (setq valid
842 (if (functionp link-validate)
843 (funcall link-validate filename current-dir)
844 t))
845 (setq file-is-image-p
846 (org-file-image-p
847 filename org-export-docbook-inline-image-extensions))
848 (setq thefile (if abs-p (expand-file-name filename) filename))
849 ;; Carry over the properties (expand-file-name will
850 ;; discard the properties of filename)
851 (add-text-properties 0 (1- (length thefile))
852 (list 'org-caption caption
853 'org-attributes attr
854 'org-label label)
855 thefile)
856 (when (and org-export-docbook-link-org-files-as-docbook
857 (string-match "\\.org$" thefile))
858 (setq thefile (concat (substring thefile 0
859 (match-beginning 0))
860 org-export-docbook-extension))
861 (if (and search
862 ;; make sure this is can be used as target search
863 (not (string-match "^[0-9]*$" search))
864 (not (string-match "^\\*" search))
865 (not (string-match "^/.*/$" search)))
866 (setq thefile (concat thefile "#"
867 (org-solidify-link-text
868 (org-link-unescape search)))))
869 (when (string-match "^file:" desc)
870 (setq desc (replace-match "" t t desc))
871 (if (string-match "\\.org$" desc)
872 (setq desc (replace-match "" t t desc))))))
873 (setq rpl (if (and file-is-image-p
874 (or (eq t org-export-docbook-inline-images)
875 (and org-export-docbook-inline-images
876 (not descp))))
877 (progn
878 (message "image %s %s" thefile org-docbook-para-open)
879 (org-export-docbook-format-image thefile))
880 (format "<link xlink:href=\"%s\">%s</link>"
881 thefile (org-export-docbook-format-desc desc))))
882 (if (not valid) (setq rpl desc))))
883
884 (t
885 ;; Just publish the path, as default
886 (setq rpl (concat "&lt;" type ":"
887 (save-match-data (org-link-unescape path))
888 "&gt;"))))
889 (setq line (replace-match rpl t t line)
890 start (+ start (length rpl))))
891
892 ;; TODO items: can we do something better?!
893 (if (and (string-match org-todo-line-regexp line)
894 (match-beginning 2))
895 (setq line
896 (concat (substring line 0 (match-beginning 2))
897 "[" (match-string 2 line) "]"
898 (substring line (match-end 2)))))
899
900 ;; Does this contain a reference to a footnote?
901 (when org-export-with-footnotes
902 (setq start 0)
903 (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
904 (if (get-text-property (match-beginning 2) 'org-protected line)
905 (setq start (match-end 2))
906 (let ((num (match-string 2 line)))
907 (if (assoc num footref-seen)
908 (setq line (replace-match
909 (format "%s<footnoteref linkend=\"%s%s\"/>"
910 (match-string 1 line)
911 org-export-docbook-footnote-id-prefix num)
912 t t line))
913 (setq line (replace-match
914 (format "%s<footnote xml:id=\"%s%s\"><para>%s</para></footnote>"
915 (match-string 1 line)
916 org-export-docbook-footnote-id-prefix
917 num
918 (save-match-data
919 (org-docbook-expand
920 (cdr (assoc num footnote-list)))))
921 t t line))
922 (push (cons num 1) footref-seen))))))
923
924 (cond
925 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
926 ;; This is a headline
927 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
928 level-offset))
929 txt (match-string 2 line))
930 (if (string-match quote-re0 txt)
931 (setq txt (replace-match "" t t txt)))
932 (when in-local-list
933 ;; Close any local lists before inserting a new header line
934 (while local-list-type
935 (let ((listtype (car local-list-type)))
936 (org-export-docbook-close-li listtype)
937 (insert (cond
938 ((equal listtype "o") "</orderedlist>\n")
939 ((equal listtype "u") "</itemizedlist>\n")
940 ((equal listtype "d") "</variablelist>\n"))))
941 (pop local-list-type))
942 (setq local-list-indent nil
943 in-local-list nil))
944 (org-export-docbook-level-start level txt)
945 ;; QUOTES
946 (when (string-match quote-re line)
947 (org-export-docbook-close-para-maybe)
948 (insert "<programlisting><![CDATA[")
949 (setq inquote t)))
950
951 ;; Tables: since version 4.3 of DocBook DTD, HTML tables are
952 ;; supported. We can use existing HTML table exporter code
953 ;; here.
954 ((and org-export-with-tables
955 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
956 (if (not table-open)
957 ;; New table starts
958 (setq table-open t
959 table-buffer nil
960 table-orig-buffer nil))
961 ;; Accumulate lines
962 (setq table-buffer (cons line table-buffer)
963 table-orig-buffer (cons origline table-orig-buffer))
964 (when (or (not lines)
965 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
966 (car lines))))
967 (setq table-open nil
968 table-buffer (nreverse table-buffer)
969 table-orig-buffer (nreverse table-orig-buffer))
970 (org-export-docbook-close-para-maybe)
971 (insert (org-export-docbook-finalize-table
972 (org-format-table-html table-buffer table-orig-buffer)))))
973 (t
974 ;; Normal lines
975 (when (string-match
976 (cond
977 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
978 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
979 ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
980 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
981 line)
982 (setq ind (or (get-text-property 0 'original-indentation line)
983 (org-get-string-indentation line))
984 item-type (if (match-beginning 4) "o" "u")
985 starter (if (match-beginning 2)
986 (substring (match-string 2 line) 0 -1))
987 line (substring line (match-beginning 5))
988 item-tag nil)
989 (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line))
990 (setq item-type "d"
991 item-tag (match-string 1 line)
992 line (substring line (match-end 0))))
993 (when (and (not (equal item-type "d"))
994 (not (string-match "[^ \t]" line)))
995 ;; Empty line. Pretend indentation is large.
996 (setq ind (if org-empty-line-terminates-plain-lists
997 0
998 (1+ (or (car local-list-indent) 1)))))
999 (setq didclose nil)
1000 (while (and in-local-list
1001 (or (and (= ind (car local-list-indent))
1002 (not starter))
1003 (< ind (car local-list-indent))))
1004 (setq didclose t)
1005 (let ((listtype (car local-list-type)))
1006 (org-export-docbook-close-li listtype)
1007 (insert (cond
1008 ((equal listtype "o") "</orderedlist>\n")
1009 ((equal listtype "u") "</itemizedlist>\n")
1010 ((equal listtype "d") "</variablelist>\n"))))
1011 (pop local-list-type) (pop local-list-indent)
1012 (setq in-local-list local-list-indent))
1013 (cond
1014 ((and starter
1015 (or (not in-local-list)
1016 (> ind (car local-list-indent))))
1017 ;; Start new (level of) list
1018 (org-export-docbook-close-para-maybe)
1019 (insert (cond
1020 ((equal item-type "u") "<itemizedlist>\n<listitem>\n")
1021 ((equal item-type "o") "<orderedlist>\n<listitem>\n")
1022 ((equal item-type "d")
1023 (format "<variablelist>\n<varlistentry><term>%s</term><listitem>\n" item-tag))))
1024 ;; For DocBook, we need to open a para right after tag
1025 ;; <listitem>.
1026 (org-export-docbook-open-para)
1027 (push item-type local-list-type)
1028 (push ind local-list-indent)
1029 (setq in-local-list t))
1030 (starter
1031 ;; Continue current list
1032 (let ((listtype (car local-list-type)))
1033 (org-export-docbook-close-li listtype)
1034 (insert (cond
1035 ((equal listtype "o") "<listitem>")
1036 ((equal listtype "u") "<listitem>")
1037 ((equal listtype "d") (format
1038 "<varlistentry><term>%s</term><listitem>"
1039 (or item-tag
1040 "???"))))))
1041 ;; For DocBook, we need to open a para right after tag
1042 ;; <listitem>.
1043 (org-export-docbook-open-para))
1044 (didclose
1045 ;; We did close a list, normal text follows: need <para>
1046 (org-export-docbook-open-para)))
1047 ;; Checkboxes.
1048 (if (string-match "^[ \t]*\\(\\[[X -]\\]\\)" line)
1049 (setq line
1050 (replace-match (concat checkbox-start
1051 (match-string 1 line)
1052 checkbox-end)
1053 t t line))))
1054
1055 ;; Empty lines start a new paragraph. If hand-formatted lists
1056 ;; are not fully interpreted, lines starting with "-", "+", "*"
1057 ;; also start a new paragraph.
1058 (if (and (string-match "^ [-+*]-\\|^[ \t]*$" line)
1059 (not inverse))
1060 (org-export-docbook-open-para))
1061
1062 ;; Is this the start of a footnote?
1063 (when org-export-with-footnotes
1064 (when (and (boundp 'footnote-section-tag-regexp)
1065 (string-match (concat "^" footnote-section-tag-regexp)
1066 line))
1067 ;; ignore this line
1068 (throw 'nextline nil))
1069 ;; These footnote lines have been read and saved before,
1070 ;; ignore them at this time.
1071 (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
1072 (org-export-docbook-close-para-maybe)
1073 (throw 'nextline nil)))
1074
1075 ;; FIXME: It might be a good idea to add an option to
1076 ;; support line break processing instruction <?linebreak?>.
1077 ;; Org-mode supports line break "\\" in HTML exporter, and
1078 ;; some DocBook users may also want to force line breaks
1079 ;; even though DocBook only supports that in
1080 ;; <literallayout>.
1081
1082 (insert line "\n")))))
1083
1084 ;; Properly close all local lists and other lists
1085 (when inquote
1086 (insert "]]>\n</programlisting>\n")
1087 (org-export-docbook-open-para))
1088 (when in-local-list
1089 ;; Close any local lists before inserting a new header line
1090 (while local-list-type
1091 (let ((listtype (car local-list-type)))
1092 (org-export-docbook-close-li listtype)
1093 (insert (cond
1094 ((equal listtype "o") "</orderedlist>\n")
1095 ((equal listtype "u") "</itemizedlist>\n")
1096 ((equal listtype "d") "</variablelist>\n"))))
1097 (pop local-list-type))
1098 (setq local-list-indent nil
1099 in-local-list nil))
1100 ;; Close all open sections.
1101 (org-export-docbook-level-start 1 nil)
1102
1103 (unless (plist-get opt-plist :buffer-will-be-killed)
1104 (normal-mode)
1105 (if (eq major-mode default-major-mode)
1106 (nxml-mode)))
1107
1108 ;; Remove empty paragraphs and lists. Replace them with a
1109 ;; newline.
1110 (goto-char (point-min))
1111 (while (re-search-forward
1112 "[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t)
1113 (when (not (get-text-property (match-beginning 1) 'org-protected))
1114 (replace-match "\n")
1115 (backward-char 1)))
1116 ;; Fill empty sections with <para></para>. This is to make sure
1117 ;; that the DocBook document generated is valid and well-formed.
1118 (goto-char (point-min))
1119 (while (re-search-forward
1120 "</title>\\([ \r\n\t]*\\)</section>" nil t)
1121 (when (not (get-text-property (match-beginning 0) 'org-protected))
1122 (replace-match "\n<para></para>\n" nil nil nil 1)))
1123 ;; Insert the last closing tag.
1124 (goto-char (point-max))
1125 (unless body-only
1126 (insert "</article>"))
1127 (or to-buffer (save-buffer))
1128 (goto-char (point-min))
1129 (or (org-export-push-to-kill-ring "DocBook")
1130 (message "Exporting... done"))
1131 (if (eq to-buffer 'string)
1132 (prog1 (buffer-substring (point-min) (point-max))
1133 (kill-buffer (current-buffer)))
1134 (current-buffer)))))
1135
1136(defun org-export-docbook-open-para ()
1137 "Insert <para>, but first close previous paragraph if any."
1138 (org-export-docbook-close-para-maybe)
1139 (insert "\n<para>")
1140 (setq org-docbook-para-open t))
1141
1142(defun org-export-docbook-close-para-maybe ()
1143 "Close DocBook paragraph if there is one open."
1144 (when org-docbook-para-open
1145 (insert "</para>\n")
1146 (setq org-docbook-para-open nil)))
1147
1148(defun org-export-docbook-close-li (&optional type)
1149 "Close list if necessary."
1150 (org-export-docbook-close-para-maybe)
1151 (if (equal type "d")
1152 (insert "</listitem></varlistentry>\n")
1153 (insert "</listitem>\n")))
1154
1155(defvar in-local-list)
1156(defvar local-list-indent)
1157(defvar local-list-type)
1158(defun org-export-docbook-close-lists-maybe (line)
1159 (let ((ind (or (get-text-property 0 'original-indentation line)))
1160; (and (string-match "\\S-" line)
1161; (org-get-indentation line))))
1162 didclose)
1163 (when ind
1164 (while (and in-local-list
1165 (<= ind (car local-list-indent)))
1166 (setq didclose t)
1167 (let ((listtype (car local-list-type)))
1168 (org-export-docbook-close-li listtype)
1169 (insert (cond
1170 ((equal listtype "o") "</orderedlist>\n")
1171 ((equal listtype "u") "</itemizedlist>\n")
1172 ((equal listtype "d") "</variablelist>\n"))))
1173 (pop local-list-type) (pop local-list-indent)
1174 (setq in-local-list local-list-indent))
1175 (and didclose (org-export-docbook-open-para)))))
1176
1177(defun org-export-docbook-level-start (level title)
1178 "Insert a new level in DocBook export.
1179When TITLE is nil, just close all open levels."
1180 (org-export-docbook-close-para-maybe)
1181 (let* ((target (and title (org-get-text-property-any 0 'target title)))
1182 (l org-level-max)
1183 section-number)
1184 (while (>= l level)
1185 (if (aref org-levels-open (1- l))
1186 (progn
1187 (insert "</section>\n")
1188 (aset org-levels-open (1- l) nil)))
1189 (setq l (1- l)))
1190 (when title
1191 ;; If title is nil, this means this function is called to close
1192 ;; all levels, so the rest is done only if title is given.
1193 ;;
1194 ;; Format tags: put them into a superscript like format.
1195 (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
1196 (setq title
1197 (replace-match
1198 (if org-export-with-tags
1199 (save-match-data
1200 (concat
1201 "<superscript>"
1202 (match-string 1 title)
1203 "</superscript>"))
1204 "")
1205 t t title)))
1206 (aset org-levels-open (1- level) t)
1207 (setq section-number (org-section-number level))
1208 (insert (format "\n<section xml:id=\"%s%s\">\n<title>%s</title>"
1209 org-export-docbook-section-id-prefix
1210 section-number title))
1211 (org-export-docbook-open-para))))
1212
1213(defun org-docbook-expand (string)
1214 "Prepare STRING for DocBook export.
1215Applies all active conversions. If there are links in the
1216string, don't modify these."
1217 (let* ((re (concat org-bracket-link-regexp "\\|"
1218 (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$")))
1219 m s l res)
1220 (while (setq m (string-match re string))
1221 (setq s (substring string 0 m)
1222 l (match-string 0 string)
1223 string (substring string (match-end 0)))
1224 (push (org-docbook-do-expand s) res)
1225 (push l res))
1226 (push (org-docbook-do-expand string) res)
1227 (apply 'concat (nreverse res))))
1228
1229(defun org-docbook-do-expand (s)
1230 "Apply all active conversions to translate special ASCII to DocBook."
1231 (setq s (org-html-protect s))
1232 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
1233 (setq s (replace-match "<\\1>" t nil s)))
1234 (if org-export-with-emphasize
1235 (setq s (org-export-docbook-convert-emphasize s)))
1236 (if org-export-with-special-strings
1237 (setq s (org-export-docbook-convert-special-strings s)))
1238 (if org-export-with-sub-superscripts
1239 (setq s (org-export-docbook-convert-sub-super s)))
1240 (if org-export-with-TeX-macros
1241 (let ((start 0) wd ass)
1242 (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?"
1243 s start))
1244 (if (get-text-property (match-beginning 0) 'org-protected s)
1245 (setq start (match-end 0))
1246 (setq wd (match-string 1 s))
1247 (if (setq ass (assoc wd org-html-entities))
1248 (setq s (replace-match (or (cdr ass)
1249 (concat "&" (car ass) ";"))
1250 t t s))
1251 (setq start (+ start (length wd))))))))
1252 s)
1253
1254(defun org-export-docbook-format-desc (desc)
1255 "Make sure DESC is valid as a description in a link."
1256 (save-match-data
1257 (org-docbook-do-expand desc)))
1258
1259(defun org-export-docbook-convert-emphasize (string)
1260 "Apply emphasis for DocBook exporting."
1261 (let ((s 0) rpl)
1262 (while (string-match org-emph-re string s)
1263 (if (not (equal
1264 (substring string (match-beginning 3) (1+ (match-beginning 3)))
1265 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
1266 (setq s (match-beginning 0)
1267 rpl
1268 (concat
1269 (match-string 1 string)
1270 (nth 1 (assoc (match-string 3 string)
1271 org-export-docbook-emphasis-alist))
1272 (match-string 4 string)
1273 (nth 2 (assoc (match-string 3 string)
1274 org-export-docbook-emphasis-alist))
1275 (match-string 5 string))
1276 string (replace-match rpl t t string)
1277 s (+ s (- (length rpl) 2)))
1278 (setq s (1+ s))))
1279 string))
1280
1281(defun org-docbook-protect (string)
1282 (org-html-protect string))
1283
1284;; For now, simply return string as it is.
1285(defun org-export-docbook-convert-special-strings (string)
1286 "Convert special characters in STRING to DocBook."
1287 string)
1288
1289(defun org-export-docbook-get-footnotes (lines)
1290 "Given a list of LINES, return a list of alist footnotes."
1291 (let ((list nil) line)
1292 (while (setq line (pop lines))
1293 (if (string-match "^[ \t]*\\[\\([0-9]+\\)\\] \\(.+\\)" line)
1294 (push (cons (match-string 1 line) (match-string 2 line))
1295 list)))
1296 list))
1297
1298(defun org-export-docbook-format-image (src)
1299 "Create image element in DocBook."
1300 (save-match-data
1301 (let* ((caption (org-find-text-property-in-string 'org-caption src))
1302 (attr (or (org-find-text-property-in-string 'org-attributes src)
1303 ""))
1304 (label (org-find-text-property-in-string 'org-label src))
1305 (default-attr org-export-docbook-default-image-attributes)
1306 tmp)
1307 (while (setq tmp (pop default-attr))
1308 (if (not (string-match (concat (car tmp) "=") attr))
1309 (setq attr (concat attr " " (car tmp) "=" (cdr tmp)))))
1310 (format "<mediaobject%s>
1311<imageobject>\n<imagedata fileref=\"%s\" %s/>\n</imageobject>
1312%s</mediaobject>"
1313 (if label (concat " xml:id=\"" label "\"") "")
1314 src attr
1315 (if caption
1316 (concat "<caption>\n<para>"
1317 caption
1318 "</para>\n</caption>\n")
1319 "")
1320 ))))
1321
1322(defun org-export-docbook-preprocess (parameters)
1323 "Extra preprocessing work for DocBook export."
1324 ;; Merge lines starting with "\par" to one line. Such lines are
1325 ;; regarded as the continuation of a long footnote.
1326 (goto-char (point-min))
1327 (while (re-search-forward "\n\\(\\\\par\\>\\)" nil t)
1328 (if (not (get-text-property (match-beginning 1) 'org-protected))
1329 (replace-match ""))))
1330
1331(defun org-export-docbook-finalize-table (table)
1332 "Change TABLE to informaltable if caption does not exist.
1333TABLE is a string containing the HTML code generated by
1334`org-format-table-html' for a table in Org-mode buffer."
1335 (if (string-match
1336 "^<table \\(\\(.\\|\n\\)+\\)<caption></caption>\n\\(\\(.\\|\n\\)+\\)</table>"
1337 table)
1338 (replace-match (concat "<informaltable "
1339 (match-string 1 table)
1340 (match-string 3 table)
1341 "</informaltable>")
1342 nil nil table)
1343 table))
1344
1345;; Note: This function is very similar to
1346;; org-export-html-convert-sub-super. They can be merged in the future.
1347(defun org-export-docbook-convert-sub-super (string)
1348 "Convert sub- and superscripts in STRING for DocBook."
1349 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
1350 (while (string-match org-match-substring-regexp string s)
1351 (cond
1352 ((and requireb (match-end 8)) (setq s (match-end 2)))
1353 ((get-text-property (match-beginning 2) 'org-protected string)
1354 (setq s (match-end 2)))
1355 (t
1356 (setq s (match-end 1)
1357 key (if (string= (match-string 2 string) "_")
1358 "subscript"
1359 "superscript")
1360 c (or (match-string 8 string)
1361 (match-string 6 string)
1362 (match-string 5 string))
1363 string (replace-match
1364 (concat (match-string 1 string)
1365 "<" key ">" c "</" key ">")
1366 t t string)))))
1367 (while (string-match "\\\\\\([_^]\\)" string)
1368 (setq string (replace-match (match-string 1 string) t t string)))
1369 string))
1370
1371(defun org-export-docbook-protect-tags (string)
1372 "Change ``<...>'' in string STRING into ``@<...>''.
1373This is normally needed when STRING contains DocBook elements
1374that need to be preserved in later phase of DocBook exporting."
1375 (let ((start 0))
1376 (while (string-match "<\\([^>]*\\)>" string start)
1377 (setq string (replace-match
1378 "@<\\1>" t nil string)
1379 start (match-end 0)))
1380 string))
1381
1382(defun org-export-docbook-handle-time-stamps (line)
1383 "Format time stamps in string LINE."
1384 (let (replaced
1385 (kw-markup (org-export-docbook-protect-tags
1386 org-export-docbook-keywords-markup))
1387 (ts-markup (org-export-docbook-protect-tags
1388 org-export-docbook-timestamp-markup)))
1389 (while (string-match org-maybe-keyword-time-regexp line)
1390 (setq replaced
1391 (concat replaced
1392 (substring line 0 (match-beginning 0))
1393 (if (match-end 1)
1394 (format kw-markup
1395 (match-string 1 line)))
1396 " "
1397 (format ts-markup
1398 (substring (org-translate-time
1399 (match-string 3 line)) 1 -1)))
1400 line (substring line (match-end 0))))
1401 (concat replaced line)))
1402
1403(provide 'org-docbook)
1404
1405;;; 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 @@
1;;; org-exp-blocks.el --- pre-process blocks when exporting org files
2
3;; Copyright (C) 2009
4;; Free Software Foundation, Inc.
5
6;; Author: Eric Schulte
7
8;; This file is part of GNU Emacs.
9;;
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24;;
25;; This is a utility for pre-processing blocks in org files before
26;; export using the `org-export-preprocess-hook'. It can be used for
27;; exporting new types of blocks from org-mode files and also for
28;; changing the default export behavior of existing org-mode blocks.
29;; The `org-export-blocks' and `org-export-interblocks' variables can
30;; be used to control how blocks and the spaces between blocks
31;; respectively are processed upon export.
32;;
33;; The type of a block is defined as the string following =#+begin_=,
34;; so for example the following block would be of type ditaa. Note
35;; that both upper or lower case are allowed in =#+BEGIN_= and
36;; =#+END_=.
37;;
38;; #+begin_ditaa blue.png -r -S
39;; +---------+
40;; | cBLU |
41;; | |
42;; | +----+
43;; | |cPNK|
44;; | | |
45;; +----+----+
46;; #+end_ditaa
47;;
48;;; Currently Implemented Block Types
49;;
50;; ditaa :: Convert ascii pictures to actual images using ditaa
51;; http://ditaa.sourceforge.net/. To use this set
52;; `org-ditaa-jar-path' to the path to ditaa.jar on your
53;; system (should be set automatically in most cases) .
54;;
55;; dot :: Convert graphs defined using the dot graphing language to
56;; images using the dot utility. For information on dot see
57;; http://www.graphviz.org/
58;;
59;; comment :: Wrap comments with titles and author information, in
60;; their own divs with author-specific ids allowing for css
61;; coloring of comments based on the author.
62;;
63;; R :: Implements Sweave type exporting, evaluates blocks of R code,
64;; and also replaces \R{} chunks in the file with their result
65;; when passed to R. This require the `R' command which is
66;; provided by ESS (Emacs Speaks Statistics).
67;;
68;;; Adding new blocks
69;;
70;; When adding a new block type first define a formatting function
71;; along the same lines as `org-export-blocks-format-dot' and then use
72;; `org-export-blocks-add-block' to add your block type to
73;; `org-export-blocks'.
74
75(eval-when-compile
76 (require 'cl))
77(require 'org)
78
79(defvar comint-last-input-end)
80(defvar comint-prompt-regexp)
81(defvar comint-last-input-end)
82(defvar htmlp)
83(defvar latexp)
84(defvar docbookp)
85(defvar asciip)
86
87(declare-function comint-send-input "comint" (&optional no-newline artificial))
88(declare-function R "ess" nil)
89
90(defun org-export-blocks-set (var value)
91 "Set the value of `org-export-blocks' and install fontification."
92 (set var value)
93 (mapc (lambda (spec)
94 (if (nth 2 spec)
95 (setq org-protecting-blocks
96 (delete (symbol-name (car spec))
97 org-protecting-blocks))
98 (add-to-list 'org-protecting-blocks
99 (symbol-name (car spec)))))
100 value))
101
102(defcustom org-export-blocks
103 '((comment org-export-blocks-format-comment t)
104 (ditaa org-export-blocks-format-ditaa nil)
105 (dot org-export-blocks-format-dot nil)
106 (r org-export-blocks-format-R nil)
107 (R org-export-blocks-format-R nil))
108 "Use this a-list to associate block types with block exporting
109functions. The type of a block is determined by the text
110immediately following the '#+BEGIN_' portion of the block header.
111Each block export function should accept three argumets..."
112 :group 'org-export-general
113 :type '(repeat
114 (list
115 (symbol :tag "Block name")
116 (function :tag "Block formatter")
117 (boolean :tag "Fontify content as Org syntax")))
118 :set 'org-export-blocks-set)
119
120(defun org-export-blocks-add-block (block-spec)
121 "Add a new block type to `org-export-blocks'. BLOCK-SPEC
122should be a three element list the first element of which should
123indicate the name of the block, the second element should be the
124formatting function called by `org-export-blocks-preprocess' and
125the third element a flag indicating whether these types of blocks
126should be fontified in org-mode buffers (see
127`org-protecting-blocks'). For example the BLOCK-SPEC for ditaa
128blocks is as follows...
129
130 (ditaa org-export-blocks-format-ditaa nil)"
131 (unless (member block-spec org-export-blocks)
132 (setq org-export-blocks (cons block-spec org-export-blocks))
133 (org-export-blocks-set 'org-export-blocks org-export-blocks)))
134
135(defcustom org-export-interblocks
136 '((r org-export-interblocks-format-R)
137 (R org-export-interblocks-format-R))
138 "Use this a-list to associate block types with block exporting
139functions. The type of a block is determined by the text
140immediately following the '#+BEGIN_' portion of the block header.
141Each block export function should accept three argumets..."
142 :group 'org-export-general
143 :type 'alist)
144
145(defcustom org-export-blocks-witheld
146 '(hidden)
147 "List of block types (see `org-export-blocks') which should not
148be exported."
149 :group 'org-export-general
150 :type 'list)
151
152(defvar org-export-blocks-postblock-hooks nil "")
153
154(defun org-export-blocks-html-quote (body &optional open close)
155 "Protext BODY from org html export. The optional OPEN and
156CLOSE tags will be inserted around BODY."
157 (concat
158 "\n#+BEGIN_HTML\n"
159 (or open "")
160 body (if (string-match "\n$" body) "" "\n")
161 (or close "")
162 "#+END_HTML\n"))
163
164(defun org-export-blocks-latex-quote (body &optional open close)
165 "Protext BODY from org latex export. The optional OPEN and
166CLOSE tags will be inserted around BODY."
167 (concat
168 "\n#+BEGIN_LaTeX\n"
169 (or open "")
170 body (if (string-match "\n$" body) "" "\n")
171 (or close "")
172 "#+END_LaTeX\n"))
173
174(defun org-export-blocks-preprocess ()
175 "Export all blocks acording to the `org-export-blocks' block
176exportation alist. Does not export block types specified in
177specified in BLOCKS which default to the value of
178`org-export-blocks-witheld'."
179 (interactive)
180 (save-window-excursion
181 (let ((count 0)
182 (blocks org-export-blocks-witheld)
183 (case-fold-search t)
184 (types '())
185 indentation type func start end)
186 (flet ((interblock (start end type)
187 (save-match-data
188 (when (setf func (cadr (assoc type org-export-interblocks)))
189 (funcall func start end)))))
190 (goto-char (point-min))
191 (setf start (point))
192 (while (re-search-forward
193 "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n][ \t]*#\\+end_\\S-+.*" nil t)
194 (save-match-data (setq indentation (length (match-string 1))))
195 (save-match-data (setf type (intern (match-string 2))))
196 (unless (memq type types) (setf types (cons type types)))
197 (setf end (save-match-data (match-beginning 0)))
198 (interblock start end type)
199 (if (setf func (cadr (assoc type org-export-blocks)))
200 (progn
201 (replace-match (save-match-data
202 (if (memq type blocks)
203 ""
204 (apply func (save-match-data (org-remove-indentation (match-string 4)))
205 (split-string (match-string 3) " ")))) t t)
206 ;; indent the replaced match
207 (indent-region (match-beginning 0) (match-end 0) indentation)
208 ))
209 (setf start (save-match-data (match-end 0))))
210 (mapcar (lambda (type)
211 (interblock start (point-max) type))
212 types)))))
213
214(add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess)
215
216;;================================================================================
217;; type specific functions
218
219;;--------------------------------------------------------------------------------
220;; ditaa: create images from ASCII art using the ditaa utility
221(defvar org-ditaa-jar-path (expand-file-name
222 "ditaa.jar"
223 (file-name-as-directory
224 (expand-file-name
225 "scripts"
226 (file-name-as-directory
227 (expand-file-name
228 "../contrib"
229 (file-name-directory (or load-file-name buffer-file-name)))))))
230 "Path to the ditaa jar executable")
231
232(defun org-export-blocks-format-ditaa (body &rest headers)
233 "Pass block BODY to the ditaa utility creating an image.
234Specify the path at which the image should be saved as the first
235element of headers, any additional elements of headers will be
236passed to the ditaa utility as command line arguments."
237 (message "ditaa-formatting...")
238 (let ((out-file (if headers (car headers)))
239 (args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
240 (data-file (make-temp-file "org-ditaa")))
241 (unless (file-exists-p org-ditaa-jar-path)
242 (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path)))
243 (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body)
244 body
245 (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1)))
246 (org-split-string body "\n")
247 "\n")))
248 (cond
249 ((or htmlp latexp docbookp)
250 (with-temp-file data-file (insert body))
251 (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
252 (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
253 (format "\n[[file:%s]]\n" out-file))
254 (t (concat
255 "\n#+BEGIN_EXAMPLE\n"
256 body (if (string-match "\n$" body) "" "\n")
257 "#+END_EXAMPLE\n")))))
258
259;;--------------------------------------------------------------------------------
260;; dot: create graphs using the dot graphing language
261;; (require the dot executable to be in your path)
262(defun org-export-blocks-format-dot (body &rest headers)
263 "Pass block BODY to the dot graphing utility creating an image.
264Specify the path at which the image should be saved as the first
265element of headers, any additional elements of headers will be
266passed to the dot utility as command line arguments. Don't
267forget to specify the output type for the dot command, so if you
268are exporting to a file with a name like 'image.png' you should
269include a '-Tpng' argument, and your block should look like the
270following.
271
272#+begin_dot models.png -Tpng
273digraph data_relationships {
274 \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"]
275 \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"]
276 \"data_requirement\" -> \"data_product\"
277}
278#+end_dot"
279 (message "dot-formatting...")
280 (let ((out-file (if headers (car headers)))
281 (args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
282 (data-file (make-temp-file "org-ditaa")))
283 (cond
284 ((or htmlp latexp docbookp)
285 (with-temp-file data-file (insert body))
286 (message (concat "dot " data-file " " args " -o " out-file))
287 (shell-command (concat "dot " data-file " " args " -o " out-file))
288 (format "\n[[file:%s]]\n" out-file))
289 (t (concat
290 "\n#+BEGIN_EXAMPLE\n"
291 body (if (string-match "\n$" body) "" "\n")
292 "#+END_EXAMPLE\n")))))
293
294;;--------------------------------------------------------------------------------
295;; comment: export comments in author-specific css-stylable divs
296(defun org-export-blocks-format-comment (body &rest headers)
297 "Format comment BODY by OWNER and return it formatted for export.
298Currently, this only does something for HTML export, for all
299other backends, it converts the comment into an EXAMPLE segment."
300 (let ((owner (if headers (car headers)))
301 (title (if (cdr headers) (mapconcat 'identity (cdr headers) " "))))
302 (cond
303 (htmlp ;; We are exporting to HTML
304 (concat "#+BEGIN_HTML\n"
305 "<div class=\"org-comment\""
306 (if owner (format " id=\"org-comment-%s\" " owner))
307 ">\n"
308 (if owner (concat "<b>" owner "</b> ") "")
309 (if (and title (> (length title) 0)) (concat " -- " title "</br>\n") "</br>\n")
310 "<p>\n"
311 "#+END_HTML\n"
312 body
313 "#+BEGIN_HTML\n"
314 "</p>\n"
315 "</div>\n"
316 "#+END_HTML\n"))
317 (t ;; This is not HTML, so just make it an example.
318 (concat "#+BEGIN_EXAMPLE\n"
319 (if title (concat "Title:" title "\n") "")
320 (if owner (concat "By:" owner "\n") "")
321 body
322 (if (string-match "\n\\'" body) "" "\n")
323 "#+END_EXAMPLE\n")))))
324
325;;--------------------------------------------------------------------------------
326;; R: Sweave-type functionality
327(defvar interblock-R-buffer nil
328 "Holds the buffer for the current R process")
329
330(defvar count) ; dynamicaly scoped from `org-export-blocks-preprocess'?
331(defun org-export-blocks-format-R (body &rest headers)
332 "Process R blocks and replace \R{} forms outside the blocks
333with their values as determined by R."
334 (interactive)
335 (message "R processing...")
336 (let ((image-path (or (and (car headers)
337 (string-match "\\(.?\\)\.\\(EPS\\|eps\\)" (car headers))
338 (match-string 1 (car headers)))
339 (and (> (length (car headers)) 0)
340 (car headers))
341 ;; create the default filename
342 (format "Rplot-%03d" count)))
343 (plot (string-match "plot" body))
344 R-proc)
345 (setf count (+ count 1))
346 (interblock-initiate-R-buffer)
347 (setf R-proc (get-buffer-process interblock-R-buffer))
348 ;; send strings to the ESS process using `comint-send-string'
349 (setf body (mapconcat (lambda (line)
350 (interblock-R-input-command line) (concat "> " line))
351 (butlast (split-string body "[\r\n]"))
352 "\n"))
353 ;; if there is a plot command, then create the images
354 (when plot
355 (interblock-R-input-command (format "dev.copy2eps(file=\"%s.eps\")" image-path)))
356 (concat (cond
357 (htmlp (org-export-blocks-html-quote body
358 (format "<div id=\"R-%d\">\n<pre>\n" count)
359 "</pre>\n</div>\n"))
360 (latexp (org-export-blocks-latex-quote body
361 "\\begin{Schunk}\n\\begin{Sinput}\n"
362 "\\end{Sinput}\n\\end{Schunk}\n"))
363 (t (insert ;; default export
364 "#+begin_R " (mapconcat 'identity headers " ") "\n"
365 body (if (string-match "\n$" body) "" "\n")
366 "#+end_R\n")))
367 (if plot
368 (format "[[file:%s.eps]]\n" image-path)
369 ""))))
370
371(defun org-export-interblocks-format-R (start end)
372 "This is run over parts of the org-file which are between R
373blocks. It's main use is to expand the \R{stuff} chunks for
374export."
375 (save-excursion
376 (goto-char start)
377 (interblock-initiate-R-buffer)
378 (let (code replacement)
379 (while (and (< (point) end) (re-search-forward "\\\\R{\\(.*\\)}" end t))
380 (save-match-data (setf code (match-string 1)))
381 (setf replacement (interblock-R-command-to-string code))
382 (setf replacement (cond
383 (htmlp replacement)
384 (latexp replacement)
385 (t replacement)))
386 (setf end (+ end (- (length replacement) (length code))))
387 (replace-match replacement t t)))))
388
389(defun interblock-initiate-R-buffer ()
390 "If there is not a current R process then create one."
391 (unless (and (buffer-live-p interblock-R-buffer) (get-buffer interblock-R-buffer))
392 (save-excursion
393 (R)
394 (setf interblock-R-buffer (current-buffer))
395 (interblock-R-wait-for-output)
396 (interblock-R-input-command ""))))
397
398(defun interblock-R-command-to-string (command)
399 "Send a command to R, and return the results as a string."
400 (interblock-R-input-command command)
401 (interblock-R-last-output))
402
403(defun interblock-R-input-command (command)
404 "Pass COMMAND to the R process running in `interblock-R-buffer'."
405 (save-excursion
406 (save-match-data
407 (set-buffer interblock-R-buffer)
408 (goto-char (process-mark (get-buffer-process (current-buffer))))
409 (insert command)
410 (comint-send-input)
411 (interblock-R-wait-for-output))))
412
413(defun interblock-R-wait-for-output ()
414 "Wait until output arrives"
415 (save-excursion
416 (save-match-data
417 (set-buffer interblock-R-buffer)
418 (while (progn
419 (goto-char comint-last-input-end)
420 (not (re-search-forward comint-prompt-regexp nil t)))
421 (accept-process-output (get-buffer-process (current-buffer)))))))
422
423(defun interblock-R-last-output ()
424 "Return the last R output as a string"
425 (save-excursion
426 (save-match-data
427 (set-buffer interblock-R-buffer)
428 (goto-char (process-mark (get-buffer-process (current-buffer))))
429 (forward-line 0)
430 (let ((raw (buffer-substring comint-last-input-end (- (point) 1))))
431 (if (string-match "\n" raw)
432 raw
433 (and (string-match "\\[[[:digit:]+]\\] *\\(.*\\)$" raw)
434 (message raw)
435 (message (match-string 1 raw))
436 (match-string 1 raw)))))))
437
438(provide 'org-exp-blocks)
439
440;;; 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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -28,16 +28,19 @@
28 28
29(require 'org) 29(require 'org)
30(require 'org-agenda) 30(require 'org-agenda)
31(require 'org-exp-blocks)
31(eval-and-compile 32(eval-and-compile
32 (require 'cl)) 33 (require 'cl))
33 34
34(declare-function org-export-latex-preprocess "org-export-latex" ()) 35(declare-function org-export-latex-preprocess "org-latex" (parameters))
36(declare-function org-export-ascii-preprocess "org-ascii" (parameters))
37(declare-function org-export-html-preprocess "org-html" (parameters))
38(declare-function org-export-docbook-preprocess "org-docbook" (parameters))
35(declare-function org-agenda-skip "org-agenda" ()) 39(declare-function org-agenda-skip "org-agenda" ())
36(declare-function org-infojs-options-inbuffer-template "org-jsinfo" ()) 40(declare-function org-infojs-options-inbuffer-template "org-jsinfo" ())
37(declare-function htmlize-region "ext:htmlize" (beg end)) 41(declare-function org-export-htmlize-region-for-paste "org-html" (beg end))
38(declare-function org-id-find-id-file "org-id" (id)) 42(declare-function htmlize-buffer "htmlize" (&optional buffer))
39(defvar htmlize-buffer-places) ; from htmlize.el 43(autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t)
40
41(defgroup org-export nil 44(defgroup org-export nil
42 "Options for exporting org-listings." 45 "Options for exporting org-listings."
43 :tag "Org Export" 46 :tag "Org Export"
@@ -48,9 +51,33 @@
48 :tag "Org Export General" 51 :tag "Org Export General"
49 :group 'org-export) 52 :group 'org-export)
50 53
54(defcustom org-export-allow-BIND 'confirm
55 "Non-nil means, allow #+BIND to define local variable values for export.
56This is a potential security risk, which is why the user must confirm the
57use of these lines."
58 :group 'org-export-general
59 :type '(choice
60 (const :tag "Never" nil)
61 (const :tag "Always" t)
62 (const :tag "Make the user confirm for each file" confirm)))
63
51;; FIXME 64;; FIXME
52(defvar org-export-publishing-directory nil) 65(defvar org-export-publishing-directory nil)
53 66
67(defcustom org-export-show-temporary-export-buffer t
68 "Non-nil means, show buffer after exporting to temp buffer.
69When Org exports to a file, the buffer visiting that file is ever
70shown, but remains buried. However, when exporting to a temporary
71buffer, that buffer is popped up in a second window. When this variable
72is nil, the buffer remains buried also in these cases."
73 :group 'org-export-general
74 :type 'boolean)
75
76(defcustom org-export-copy-to-kill-ring t
77 "Non-nil means, exported stuff will also be pushed onto the kill ring."
78 :group 'org-export-general
79 :type 'boolean)
80
54(defcustom org-export-run-in-background nil 81(defcustom org-export-run-in-background nil
55 "Non-nil means export and publishing commands will run in background. 82 "Non-nil means export and publishing commands will run in background.
56This works by starting up a separate Emacs process visiting the same file 83This works by starting up a separate Emacs process visiting the same file
@@ -66,7 +93,6 @@ force an export command into the current process."
66 :group 'org-export-general 93 :group 'org-export-general
67 :type 'boolean) 94 :type 'boolean)
68 95
69
70(defcustom org-export-select-tags '("export") 96(defcustom org-export-select-tags '("export")
71 "Tags that select a tree for export. 97 "Tags that select a tree for export.
72If any such tag is found in a buffer, all trees that do not carry one 98If 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
84 :group 'org-export-general 110 :group 'org-export-general
85 :type '(repeat (string :tag "Tag"))) 111 :type '(repeat (string :tag "Tag")))
86 112
113;; FIXME: rename, this is a general variable
114(defcustom org-export-html-expand t
115 "Non-nil means, for HTML export, treat @<...> as HTML tag.
116When nil, these tags will be exported as plain text and therefore
117not be interpreted by a browser.
118
119This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
120 :group 'org-export-html
121 :group 'org-export-general
122 :type 'boolean)
123
87(defcustom org-export-with-special-strings t 124(defcustom org-export-with-special-strings t
88 "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. 125 "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export.
89When this option is turned on, these strings will be exported as: 126When 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\"."
99 :group 'org-export-translation 136 :group 'org-export-translation
100 :type 'boolean) 137 :type 'boolean)
101 138
139(defcustom org-export-html-link-up ""
140 "Where should the \"UP\" link of exported HTML pages lead?"
141 :group 'org-export-html
142 :group 'org-export-general
143 :type '(string :tag "File or URL"))
144
145(defcustom org-export-html-link-home ""
146 "Where should the \"HOME\" link of exported HTML pages lead?"
147 :group 'org-export-html
148 :group 'org-export-general
149 :type '(string :tag "File or URL"))
150
102(defcustom org-export-language-setup 151(defcustom org-export-language-setup
103 '(("en" "Author" "Date" "Table of Contents" "Footnotes") 152 '(("en" "Author" "Date" "Table of Contents" "Footnotes")
104 ("ca" "Autor" "Data" "&Iacute;ndex" "Peus de p&agrave;gina") 153 ("ca" "Autor" "Data" "&Iacute;ndex" "Peus de p&agrave;gina")
@@ -136,6 +185,16 @@ This should have an association in `org-export-language-setup'."
136 :group 'org-export-general 185 :group 'org-export-general
137 :type 'string) 186 :type 'string)
138 187
188(defvar org-export-page-description ""
189 "The page description, for the XHTML meta tag.
190This is best set with the #+DESCRIPTION line in a file, it does not make
191sense to set this globally.")
192
193(defvar org-export-page-keywords ""
194 "The page description, for the XHTML meta tag.
195This is best set with the #+KEYWORDS line in a file, it does not make
196sense to set this globally.")
197
139(defcustom org-export-skip-text-before-1st-heading nil 198(defcustom org-export-skip-text-before-1st-heading nil
140 "Non-nil means, skip all text before the first headline when exporting. 199 "Non-nil means, skip all text before the first headline when exporting.
141When nil, that text is exported as well." 200When nil, that text is exported as well."
@@ -150,7 +209,7 @@ this setting.
150 209
151This option can also be set with the +OPTIONS line, e.g. \"H:2\"." 210This option can also be set with the +OPTIONS line, e.g. \"H:2\"."
152 :group 'org-export-general 211 :group 'org-export-general
153 :type 'number) 212 :type 'integer)
154 213
155(defcustom org-export-with-section-numbers t 214(defcustom org-export-with-section-numbers t
156 "Non-nil means, add section numbers to headlines when exporting. 215 "Non-nil means, add section numbers to headlines when exporting.
@@ -269,7 +328,7 @@ e.g. \"timestamp:nil\"."
269 :type 'boolean) 328 :type 'boolean)
270 329
271(defcustom org-export-remove-timestamps-from-toc t 330(defcustom org-export-remove-timestamps-from-toc t
272 "If nil, remove timestamps from the table of contents entries." 331 "If t, remove timestamps from the table of contents entries."
273 :group 'org-export-general 332 :group 'org-export-general
274 :type 'boolean) 333 :type 'boolean)
275 334
@@ -310,6 +369,11 @@ This is run after selection of trees to be exported has happened.
310This selection includes tags-based selection, as well as removal 369This selection includes tags-based selection, as well as removal
311of commented and archived trees.") 370of commented and archived trees.")
312 371
372(defvar org-export-preprocess-after-blockquote-hook nil
373 "Hook for preprocessing an export buffer.
374This is run after blockquote/quote/verse/center have been marked
375with cookies.")
376
313(defvar org-export-preprocess-before-backend-specifics-hook nil 377(defvar org-export-preprocess-before-backend-specifics-hook nil
314 "Hook run before backend-specific functions are called during preprocessing.") 378 "Hook run before backend-specific functions are called during preprocessing.")
315 379
@@ -342,19 +406,6 @@ This option can also be set with the +OPTIONS line, e.g. \"f:nil\"."
342 :group 'org-export-translation 406 :group 'org-export-translation
343 :type 'boolean) 407 :type 'boolean)
344 408
345(defcustom org-export-html-footnotes-section "<div id=\"footnotes\">
346<h2 class=\"footnotes\">%s: </h2>
347<div id=\"text-footnotes\">
348%s
349</div>
350</div>"
351 "Format for the footnotes section.
352Should contain a two instances of %s. The first will be replaced with the
353language-specific word for \"Footnotes\", the second one will be replaced
354by the footnotes themselves."
355 :group 'org-export-html
356 :type 'string)
357
358(defcustom org-export-with-sub-superscripts t 409(defcustom org-export-with-sub-superscripts t
359 "Non-nil means, interpret \"_\" and \"^\" for export. 410 "Non-nil means, interpret \"_\" and \"^\" for export.
360When this option is turned on, you can use TeX-like syntax for sub- and 411When 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
404like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for 455like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for
405display math. 456display math.
406 457
407This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"." 458This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\".
459
460The default is nil, because this option needs the `dvipng' program which
461is not available on all systems."
408 :group 'org-export-translation 462 :group 'org-export-translation
409 :group 'org-export-latex 463 :group 'org-export-latex
410 :type 'boolean) 464 :type 'boolean)
@@ -477,405 +531,32 @@ much faster."
477 :group 'org-export-tables 531 :group 'org-export-tables
478 :type 'boolean) 532 :type 'boolean)
479 533
480(defgroup org-export-ascii nil
481 "Options specific for ASCII export of Org-mode files."
482 :tag "Org Export ASCII"
483 :group 'org-export)
484
485(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-)
486 "Characters for underlining headings in ASCII export.
487In the given sequence, these characters will be used for level 1, 2, ..."
488 :group 'org-export-ascii
489 :type '(repeat character))
490
491(defcustom org-export-ascii-bullets '(?* ?+ ?-)
492 "Bullet characters for headlines converted to lists in ASCII export.
493The first character is used for the first lest level generated in this
494way, and so on. If there are more levels than characters given here,
495the list will be repeated.
496Note that plain lists will keep the same bullets as the have in the
497Org-mode file."
498 :group 'org-export-ascii
499 :type '(repeat character))
500 534
501(defgroup org-export-xml nil 535(defgroup org-export-xml nil
502 "Options specific for XML export of Org-mode files." 536 "Options specific for XML export of Org-mode files."
503 :tag "Org Export XML" 537 :tag "Org Export XML"
504 :group 'org-export) 538 :group 'org-export)
505 539
506(defgroup org-export-html nil
507 "Options specific for HTML export of Org-mode files."
508 :tag "Org Export HTML"
509 :group 'org-export)
510
511(defcustom org-export-html-coding-system nil
512 "Coding system for HTML export, defaults to buffer-file-coding-system."
513 :group 'org-export-html
514 :type 'coding-system)
515
516(defcustom org-export-html-extension "html"
517 "The extension for exported HTML files."
518 :group 'org-export-html
519 :type 'string)
520
521(defcustom org-export-html-link-up ""
522 "Where should the \"UP\" link of exported HTML pages lead?"
523 :group 'org-export-html
524 :type '(string :tag "File or URL"))
525
526(defcustom org-export-html-link-home ""
527 "Where should the \"HOME\" link of exported HTML pages lead?"
528 :group 'org-export-html
529 :type '(string :tag "File or URL"))
530
531(defconst org-export-html-scripts
532"<script type=\"text/javascript\">
533<!--/*--><![CDATA[/*><!--*/
534 function CodeHighlightOn(elem, id)
535 {
536 var target = document.getElementById(id);
537 if(null != target) {
538 elem.cacheClassElem = elem.className;
539 elem.cacheClassTarget = target.className;
540 target.className = \"code-highlighted\";
541 elem.className = \"code-highlighted\";
542 }
543 }
544 function CodeHighlightOff(elem, id)
545 {
546 var target = document.getElementById(id);
547 if(elem.cacheClassElem)
548 elem.className = elem.cacheClassElem;
549 if(elem.cacheClassTarget)
550 target.className = elem.cacheClassTarget;
551 }
552/*]]>*/-->
553</script>"
554"Basic javascript that is needed by HTML files produced by Org-mode.")
555
556(defconst org-export-html-style-default
557"<style type=\"text/css\">
558 <!--/*--><![CDATA[/*><!--*/
559 html { font-family: Times, serif; font-size: 12pt; }
560 .title { text-align: center; }
561 .todo { color: red; }
562 .done { color: green; }
563 .tag { background-color:lightblue; font-weight:normal }
564 .target { }
565 .timestamp { color: grey }
566 .timestamp-kwd { color: CadetBlue }
567 p.verse { margin-left: 3% }
568 pre {
569 border: 1pt solid #AEBDCC;
570 background-color: #F3F5F7;
571 padding: 5pt;
572 font-family: courier, monospace;
573 font-size: 90%;
574 overflow:auto;
575 }
576 table { border-collapse: collapse; }
577 td, th { vertical-align: top; }
578 dt { font-weight: bold; }
579 div.figure { padding: 0.5em; }
580 div.figure p { text-align: center; }
581 .linenr { font-size:smaller }
582 .code-highlighted {background-color:#ffff00;}
583 .org-info-js_info-navigation { border-style:none; }
584 #org-info-js_console-label { font-size:10px; font-weight:bold;
585 white-space:nowrap; }
586 .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
587 font-weight:bold; }
588 /*]]>*/-->
589</style>"
590 "The default style specification for exported HTML files.
591Please use the variables `org-export-html-style' and
592`org-export-html-style-extra' to add to this style. If you wish to not
593have the default style included, customize the variable
594`org-export-html-style-include-default'.")
595
596(defcustom org-export-html-style-include-default t
597 "Non-nil means, include the default style in exported HTML files.
598The actual style is defined in `org-export-html-style-default' and should
599not be modified. Use the variables `org-export-html-style' to add
600your own style information."
601 :group 'org-export-html
602 :type 'boolean)
603;;;###autoload
604(put 'org-export-html-style 'safe-local-variable 'booleanp)
605
606(defcustom org-export-html-style ""
607 "Org-wide style definitions for exported HTML files.
608
609This variable needs to contain the full HTML structure to provide a style,
610including the surrounding HTML tags. If you set the value of this variable,
611you should consider to include definitions for the following classes:
612 title, todo, done, timestamp, timestamp-kwd, tag, target.
613
614For example, a valid value would be:
615
616 <style type=\"text/css\">
617 <![CDATA[
618 p { font-weight: normal; color: gray; }
619 h1 { color: black; }
620 .title { text-align: center; }
621 .todo, .timestamp-kwd { color: red; }
622 .done { color: green; }
623 ]]>
624 </style>
625
626If you'd like to refer to en external style file, use something like
627
628 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
629
630As the value of this option simply gets inserted into the HTML <head> header,
631you can \"misuse\" it to add arbitrary text to the header.
632See also the variable `org-export-html-style-extra'."
633 :group 'org-export-html
634 :type 'string)
635;;;###autoload
636(put 'org-export-html-style 'safe-local-variable 'stringp)
637
638(defcustom org-export-html-style-extra ""
639 "Additional style information for HTML export.
640The value of this variable is inserted into the HTML buffer right after
641the value of `org-export-html-style'. Use this variable for per-file
642settings of style information, and do not forget to surround the style
643settings with <style>...</style> tags."
644 :group 'org-export-html
645 :type 'string)
646;;;###autoload
647(put 'org-export-html-style-extra 'safe-local-variable 'stringp)
648
649
650(defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n"
651 "Format for typesetting the document title in HTML export."
652 :group 'org-export-html
653 :type 'string)
654
655(defcustom org-export-html-toplevel-hlevel 2
656 "The <H> level for level 1 headings in HTML export."
657 :group 'org-export-html
658 :type 'string)
659
660(defcustom org-export-html-link-org-files-as-html t
661 "Non-nil means, make file links to `file.org' point to `file.html'.
662When org-mode is exporting an org-mode file to HTML, links to
663non-html files are directly put into a href tag in HTML.
664However, links to other Org-mode files (recognized by the
665extension `.org.) should become links to the corresponding html
666file, assuming that the linked org-mode file will also be
667converted to HTML.
668When nil, the links still point to the plain `.org' file."
669 :group 'org-export-html
670 :type 'boolean)
671
672(defcustom org-export-html-inline-images 'maybe
673 "Non-nil means, inline images into exported HTML pages.
674This is done using an <img> tag. When nil, an anchor with href is used to
675link to the image. If this option is `maybe', then images in links with
676an empty description will be inlined, while images with a description will
677be linked only."
678 :group 'org-export-html
679 :type '(choice (const :tag "Never" nil)
680 (const :tag "Always" t)
681 (const :tag "When there is no description" maybe)))
682
683(defcustom org-export-html-inline-image-extensions
684 '("png" "jpeg" "jpg" "gif")
685 "Extensions of image files that can be inlined into HTML."
686 :group 'org-export-html
687 :type '(repeat (string :tag "Extension")))
688
689;; FIXME: rename
690(defcustom org-export-html-expand t
691 "Non-nil means, for HTML export, treat @<...> as HTML tag.
692When nil, these tags will be exported as plain text and therefore
693not be interpreted by a browser.
694
695This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
696 :group 'org-export-html
697 :type 'boolean)
698
699(defcustom org-export-html-table-tag
700 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
701 "The HTML tag that is used to start a table.
702This must be a <table> tag, but you may change the options like
703borders and spacing."
704 :group 'org-export-html
705 :type 'string)
706
707(defcustom org-export-table-header-tags '("<th>" . "</th>")
708 "The opening tag for table header fields.
709This is customizable so that alignment options can be specified."
710 :group 'org-export-tables
711 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
712
713(defcustom org-export-table-data-tags '("<td>" . "</td>")
714 "The opening tag for table data fields.
715This is customizable so that alignment options can be specified."
716 :group 'org-export-tables
717 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
718
719(defcustom org-export-html-with-timestamp nil
720 "If non-nil, write `org-export-html-html-helper-timestamp'
721into the exported HTML text. Otherwise, the buffer will just be saved
722to a file."
723 :group 'org-export-html
724 :type 'boolean)
725
726(defcustom org-export-html-html-helper-timestamp
727 "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n"
728 "The HTML tag used as timestamp delimiter for HTML-helper-mode."
729 :group 'org-export-html
730 :type 'string)
731
732(defgroup org-export-htmlize nil
733 "Options for processing examples with htmlize.el."
734 :tag "Org Export Htmlize"
735 :group 'org-export-html)
736
737(defcustom org-export-htmlize-output-type 'inline-css
738 "Output type to be used by htmlize when formatting code snippets.
739Normally this is `inline-css', but if you have defined to appropriate
740classes in your css style file, setting this to `css' means that the
741fontification will use the class names.
742See also the function `org-export-htmlize-generate-css'."
743 :group 'org-export-htmlize
744 :type '(choice (const css) (const inline-css)))
745
746(defcustom org-export-htmlize-css-font-prefix "org-"
747 "The prefix for CSS class names for htmlize font specifications."
748 :group 'org-export-htmlize
749 :type 'string)
750
751(defgroup org-export-icalendar nil
752 "Options specific for iCalendar export of Org-mode files."
753 :tag "Org Export iCalendar"
754 :group 'org-export)
755
756(defcustom org-combined-agenda-icalendar-file "~/org.ics"
757 "The file name for the iCalendar file covering all agenda files.
758This file is created with the command \\[org-export-icalendar-all-agenda-files].
759The file name should be absolute, the file will be overwritten without warning."
760 :group 'org-export-icalendar
761 :type 'file)
762
763(defcustom org-icalendar-combined-name "OrgMode"
764 "Calendar name for the combined iCalendar representing all agenda files."
765 :group 'org-export-icalendar
766 :type 'string)
767
768(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
769 "Contexts where iCalendar export should use a deadline time stamp.
770This is a list with several symbols in it. Valid symbol are:
771
772event-if-todo Deadlines in TODO entries become calendar events.
773event-if-not-todo Deadlines in non-TODO entries become calendar events.
774todo-due Use deadlines in TODO entries as due-dates"
775 :group 'org-export-icalendar
776 :type '(set :greedy t
777 (const :tag "Deadlines in non-TODO entries become events"
778 event-if-not-todo)
779 (const :tag "Deadline in TODO entries become events"
780 event-if-todo)
781 (const :tag "Deadlines in TODO entries become due-dates"
782 todo-due)))
783
784(defcustom org-icalendar-use-scheduled '(todo-start)
785 "Contexts where iCalendar export should use a scheduling time stamp.
786This is a list with several symbols in it. Valid symbol are:
787
788event-if-todo Scheduling time stamps in TODO entries become an event.
789event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
790todo-start Scheduling time stamps in TODO entries become start date.
791 Some calendar applications show TODO entries only after
792 that date."
793 :group 'org-export-icalendar
794 :type '(set :greedy t
795 (const :tag
796 "SCHEDULED timestamps in non-TODO entries become events"
797 event-if-not-todo)
798 (const :tag "SCHEDULED timestamps in TODO entries become events"
799 event-if-todo)
800 (const :tag "SCHEDULED in TODO entries become start date"
801 todo-start)))
802
803(defcustom org-icalendar-categories '(local-tags category)
804 "Items that should be entered into the categories field.
805This is a list of symbols, the following are valid:
806
807category The Org-mode category of the current file or tree
808todo-state The todo state, if any
809local-tags The tags, defined in the current line
810all-tags All tags, including inherited ones."
811 :group 'org-export-icalendar
812 :type '(repeat
813 (choice
814 (const :tag "The file or tree category" category)
815 (const :tag "The TODO state" todo-state)
816 (const :tag "Tags defined in current line" local-tags)
817 (const :tag "All tags, including inherited ones" all-tags))))
818
819(defcustom org-icalendar-include-todo nil
820 "Non-nil means, export to iCalendar files should also cover TODO items."
821 :group 'org-export-icalendar
822 :type '(choice
823 (const :tag "None" nil)
824 (const :tag "Unfinished" t)
825 (const :tag "All" all)))
826
827(defcustom org-icalendar-include-sexps t
828 "Non-nil means, export to iCalendar files should also cover sexp entries.
829These are entries like in the diary, but directly in an Org-mode file."
830 :group 'org-export-icalendar
831 :type 'boolean)
832
833(defcustom org-icalendar-include-body 100
834 "Amount of text below headline to be included in iCalendar export.
835This is a number of characters that should maximally be included.
836Properties, scheduling and clocking lines will always be removed.
837The text will be inserted into the DESCRIPTION field."
838 :group 'org-export-icalendar
839 :type '(choice
840 (const :tag "Nothing" nil)
841 (const :tag "Everything" t)
842 (integer :tag "Max characters")))
843
844(defcustom org-icalendar-store-UID nil
845 "Non-nil means, store any created UIDs in properties.
846The iCalendar standard requires that all entries have a unique identifier.
847Org will create these identifiers as needed. When this variable is non-nil,
848the created UIDs will be stored in the ID property of the entry. Then the
849next time this entry is exported, it will be exported with the same UID,
850superceding the previous form of it. This is essential for
851synchronization services.
852This variable is not turned on by default because we want to avoid creating
853a property drawer in every entry if people are only playing with this feature,
854or if they are only using it locally."
855 :group 'org-export-icalendar
856 :type 'boolean)
857
858;;;; Exporting 540;;;; Exporting
859 541
860;;; Variables, constants, and parameter plists 542;;; Variables, constants, and parameter plists
861 543
862(defconst org-level-max 20) 544(defconst org-level-max 20)
863 545
864(defvar org-export-html-preamble nil
865 "Preamble, to be inserted just before <body>. Set by publishing functions.")
866(defvar org-export-html-postamble nil
867 "Preamble, to be inserted just after </body>. Set by publishing functions.")
868(defvar org-export-html-auto-preamble t
869 "Should default preamble be inserted? Set by publishing functions.")
870(defvar org-export-html-auto-postamble t
871 "Should default postamble be inserted? Set by publishing functions.")
872(defvar org-current-export-file nil) ; dynamically scoped parameter 546(defvar org-current-export-file nil) ; dynamically scoped parameter
873(defvar org-current-export-dir nil) ; dynamically scoped parameter 547(defvar org-current-export-dir nil) ; dynamically scoped parameter
548(defvar org-export-opt-plist nil
549 "Contains the current option plist.")
550(defvar org-last-level nil) ; dynamically scoped variable
551(defvar org-min-level nil) ; dynamically scoped variable
552(defvar org-levels-open nil) ; dynamically scoped parameter
874 553
875(defconst org-export-plist-vars 554(defconst org-export-plist-vars
876 '((:link-up nil org-export-html-link-up) 555 '((:link-up nil org-export-html-link-up)
877 (:link-home nil org-export-html-link-home) 556 (:link-home nil org-export-html-link-home)
878 (:language nil org-export-default-language) 557 (:language nil org-export-default-language)
558 (:keywords nil org-export-page-keywords)
559 (:description nil org-export-page-description)
879 (:customtime nil org-display-custom-times) 560 (:customtime nil org-display-custom-times)
880 (:headline-levels "H" org-export-headline-levels) 561 (:headline-levels "H" org-export-headline-levels)
881 (:section-numbers "num" org-export-with-section-numbers) 562 (:section-numbers "num" org-export-with-section-numbers)
@@ -902,12 +583,14 @@ or if they are only using it locally."
902 (:tables "|" org-export-with-tables) 583 (:tables "|" org-export-with-tables)
903 (:table-auto-headline nil org-export-highlight-first-table-line) 584 (:table-auto-headline nil org-export-highlight-first-table-line)
904 (:style-include-default nil org-export-html-style-include-default) 585 (:style-include-default nil org-export-html-style-include-default)
586 (:style-include-scripts nil org-export-html-style-include-scripts)
905 (:style nil org-export-html-style) 587 (:style nil org-export-html-style)
906 (:style-extra nil org-export-html-style-extra) 588 (:style-extra nil org-export-html-style-extra)
907 (:agenda-style nil org-agenda-export-html-style) 589 (:agenda-style nil org-agenda-export-html-style)
908 (:convert-org-links nil org-export-html-link-org-files-as-html) 590 (:convert-org-links nil org-export-html-link-org-files-as-html)
909 (:inline-images nil org-export-html-inline-images) 591 (:inline-images nil org-export-html-inline-images)
910 (:html-extension nil org-export-html-extension) 592 (:html-extension nil org-export-html-extension)
593 (:xml-declaration nil org-export-html-xml-declaration)
911 (:html-table-tag nil org-export-html-table-tag) 594 (:html-table-tag nil org-export-html-table-tag)
912 (:expand-quoted-html "@" org-export-html-expand) 595 (:expand-quoted-html "@" org-export-html-expand)
913 (:timestamp nil org-export-html-with-timestamp) 596 (:timestamp nil org-export-html-with-timestamp)
@@ -919,21 +602,29 @@ or if they are only using it locally."
919 (:author nil user-full-name) 602 (:author nil user-full-name)
920 (:email nil user-mail-address) 603 (:email nil user-mail-address)
921 (:select-tags nil org-export-select-tags) 604 (:select-tags nil org-export-select-tags)
922 (:exclude-tags nil org-export-exclude-tags)) 605 (:exclude-tags nil org-export-exclude-tags)
606
607 (:latex-image-options nil org-export-latex-image-default-option))
923 "List of properties that represent export/publishing variables. 608 "List of properties that represent export/publishing variables.
924Each element is a list of 3 items: 609Each element is a list of 3 items:
9251. The property that is used internally, and also for org-publish-project-alist 6101. The property that is used internally, and also for org-publish-project-alist
9262. The string that can be used in the OPTION lines to set this option, 6112. The string that can be used in the OPTION lines to set this option,
927 or nil if this option cannot be changed in this way 612 or nil if this option cannot be changed in this way
9283. The customization variable that sets the default for this option." 6133. The customization variable that sets the default for this option."
929
930) 614)
931 615
932(defun org-default-export-plist () 616(defun org-default-export-plist ()
933 "Return the property list with default settings for the export variables." 617 "Return the property list with default settings for the export variables."
934 (let ((l org-export-plist-vars) rtn e) 618 (let* ((infile (org-infile-export-plist))
619 (letbind (plist-get infile :let-bind))
620 (l org-export-plist-vars) rtn e s v)
935 (while (setq e (pop l)) 621 (while (setq e (pop l))
936 (setq rtn (cons (car e) (cons (symbol-value (nth 2 e)) rtn)))) 622 (setq s (nth 2 e)
623 v (cond
624 ((assq s letbind) (nth 1 (assq s letbind)))
625 ((boundp s) (symbol-value s))
626 (t nil))
627 rtn (cons (car e) (cons v rtn))))
937 rtn)) 628 rtn))
938 629
939(defvar org-export-inbuffer-options-extra nil 630(defvar org-export-inbuffer-options-extra nil
@@ -965,10 +656,11 @@ modified) list.")
965 (append 656 (append
966 '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE" 657 '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"
967 "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE" "LATEX_HEADER" 658 "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE" "LATEX_HEADER"
968 "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS") 659 "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS"
660 "KEYWORDS" "DESCRIPTION" "MACRO" "BIND")
969 (mapcar 'car org-export-inbuffer-options-extra)))) 661 (mapcar 'car org-export-inbuffer-options-extra))))
970 p key val text options a pr style 662 p key val text options a pr style
971 latex-header 663 latex-header macros letbind
972 ext-setup-or-nil setup-contents (start 0)) 664 ext-setup-or-nil setup-contents (start 0))
973 (while (or (and ext-setup-or-nil 665 (while (or (and ext-setup-or-nil
974 (string-match re ext-setup-or-nil start) 666 (string-match re ext-setup-or-nil start)
@@ -985,6 +677,9 @@ modified) list.")
985 ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) 677 ((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
986 ((string-equal key "EMAIL") (setq p (plist-put p :email val))) 678 ((string-equal key "EMAIL") (setq p (plist-put p :email val)))
987 ((string-equal key "DATE") (setq p (plist-put p :date val))) 679 ((string-equal key "DATE") (setq p (plist-put p :date val)))
680 ((string-equal key "KEYWORDS") (setq p (plist-put p :keywords val)))
681 ((string-equal key "DESCRIPTION")
682 (setq p (plist-put p :description val)))
988 ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) 683 ((string-equal key "LANGUAGE") (setq p (plist-put p :language val)))
989 ((string-equal key "STYLE") 684 ((string-equal key "STYLE")
990 (setq style (concat style "\n" val))) 685 (setq style (concat style "\n" val)))
@@ -994,6 +689,8 @@ modified) list.")
994 (setq text (if text (concat text "\n" val) val))) 689 (setq text (if text (concat text "\n" val) val)))
995 ((string-equal key "OPTIONS") 690 ((string-equal key "OPTIONS")
996 (setq options (concat val " " options))) 691 (setq options (concat val " " options)))
692 ((string-equal key "BIND")
693 (push (read (concat "(" val ")")) letbind))
997 ((string-equal key "LINK_UP") 694 ((string-equal key "LINK_UP")
998 (setq p (plist-put p :link-up val))) 695 (setq p (plist-put p :link-up val)))
999 ((string-equal key "LINK_HOME") 696 ((string-equal key "LINK_HOME")
@@ -1002,6 +699,8 @@ modified) list.")
1002 (setq p (plist-put p :select-tags (org-split-string val)))) 699 (setq p (plist-put p :select-tags (org-split-string val))))
1003 ((string-equal key "EXPORT_EXCLUDE_TAGS") 700 ((string-equal key "EXPORT_EXCLUDE_TAGS")
1004 (setq p (plist-put p :exclude-tags (org-split-string val)))) 701 (setq p (plist-put p :exclude-tags (org-split-string val))))
702 ((string-equal key "MACRO")
703 (push val macros))
1005 ((equal key "SETUPFILE") 704 ((equal key "SETUPFILE")
1006 (setq setup-contents (org-file-contents 705 (setq setup-contents (org-file-contents
1007 (expand-file-name 706 (expand-file-name
@@ -1015,13 +714,55 @@ modified) list.")
1015 "\n" setup-contents "\n" 714 "\n" setup-contents "\n"
1016 (substring ext-setup-or-nil start))))))) 715 (substring ext-setup-or-nil start)))))))
1017 (setq p (plist-put p :text text)) 716 (setq p (plist-put p :text text))
717 (when (and letbind (org-export-confirm-letbind))
718 (setq p (plist-put p :let-bind letbind)))
1018 (when style (setq p (plist-put p :style-extra style))) 719 (when style (setq p (plist-put p :style-extra style)))
1019 (when latex-header 720 (when latex-header
1020 (setq p (plist-put p :latex-header-extra (substring latex-header 1)))) 721 (setq p (plist-put p :latex-header-extra (substring latex-header 1))))
1021 (when options 722 (when options
1022 (setq p (org-export-add-options-to-plist p options))) 723 (setq p (org-export-add-options-to-plist p options)))
724 ;; Add macro definitions
725 (setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))"))
726 (setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))"))
727 (setq p (plist-put
728 p :macro-modification-time
729 (and (buffer-file-name)
730 (file-exists-p (buffer-file-name))
731 (concat
732 "(eval (format-time-string \"$1\" '"
733 (prin1-to-string (nth 5 (file-attributes
734 (buffer-file-name))))
735 "))"))))
736 (setq p (plist-put p :macro-input-file (and (buffer-file-name)
737 (file-name-nondirectory
738 (buffer-file-name)))))
739 (while (setq val (pop macros))
740 (when (string-match "^\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)" val)
741 (setq p (plist-put
742 p (intern
743 (concat ":macro-" (downcase (match-string 1 val))))
744 (match-string 2 val)))))
1023 p)))) 745 p))))
1024 746
747(defvar org-export-allow-BIND-local nil)
748(defun org-export-confirm-letbind ()
749 "Can we use #+BIND values during export?
750By default this will ask fro confirmation by the user, to divert possible
751security risks."
752 (cond
753 ((not org-export-allow-BIND) nil)
754 ((eq org-export-allow-BIND t) t)
755 ((local-variable-p 'org-export-allow-BIND-local (current-buffer))
756 org-export-allow-BIND-local)
757 (t (org-set-local 'org-export-allow-BIND-local
758 (yes-or-no-p "Allow BIND values in this buffer? ")))))
759
760(defun org-install-letbind ()
761 "Install the values from #+BIND lines as local variables."
762 (let ((letbind (plist-get org-export-opt-plist :let-bind)))
763 (while letbind
764 (org-set-local (caar letbind) (nth 1 (pop letbind))))))
765
1025(defun org-export-add-options-to-plist (p options) 766(defun org-export-add-options-to-plist (p options)
1026 "Parse an OPTIONS line and set values in the property list P." 767 "Parse an OPTIONS line and set values in the property list P."
1027 (let (o) 768 (let (o)
@@ -1048,6 +789,10 @@ modified) list.")
1048 ;; (setq p (plist-put p :title a))) 789 ;; (setq p (plist-put p :title a)))
1049 (when (setq a (org-entry-get pos "EXPORT_TEXT")) 790 (when (setq a (org-entry-get pos "EXPORT_TEXT"))
1050 (setq p (plist-put p :text a))) 791 (setq p (plist-put p :text a)))
792 (when (setq a (org-entry-get pos "EXPORT_AUTHOR"))
793 (setq p (plist-put p :author a)))
794 (when (setq a (org-entry-get pos "EXPORT_DATE"))
795 (setq p (plist-put p :date a)))
1051 (when (setq a (org-entry-get pos "EXPORT_OPTIONS")) 796 (when (setq a (org-entry-get pos "EXPORT_OPTIONS"))
1052 (setq p (org-export-add-options-to-plist p a))))) 797 (setq p (org-export-add-options-to-plist p a)))))
1053 p)) 798 p))
@@ -1080,36 +825,40 @@ value of `org-export-run-in-background'."
1080 (help "[t] insert the export option template 825 (help "[t] insert the export option template
1081\[v] limit export to visible part of outline tree 826\[v] limit export to visible part of outline tree
1082 827
1083\[a] export as ASCII 828\[a] export as ASCII [A] to temporary buffer
1084 829
1085\[h] export as HTML 830\[h] export as HTML [H] to temporary buffer [R] export region
1086\[H] export as HTML to temporary buffer 831\[b] export as HTML and open in browser
1087\[R] export region as HTML
1088\[b] export as HTML and browse immediately
1089\[x] export as XOXO
1090 832
1091\[l] export as LaTeX 833\[l] export as LaTeX [L] to temporary buffer
1092\[p] export as LaTeX and process to PDF 834\[p] export as LaTeX and process to PDF
1093\[d] export as LaTeX, process to PDF, and open the resulting PDF document 835\[d] export as LaTeX, process to PDF, and open the resulting PDF document
1094\[L] export as LaTeX to temporary buffer 836
837\[D] export as DocBook
838\[V] export as DocBook, process to PDF, and open the resulting PDF document
839
840\[x] export as XOXO
841\[g] export using Wes Hardaker's generic exporter
1095 842
1096\[i] export current file as iCalendar file 843\[i] export current file as iCalendar file
1097\[I] export all agenda files as iCalendar files 844\[I] export all agenda files as iCalendar files
1098\[c] export agenda files into combined iCalendar file 845\[c] export agenda files into combined iCalendar file
1099 846
1100\[F] publish current file 847\[F] publish current file [P] publish current project
1101\[P] publish current project 848\[X] publish a project... [E] publish every projects")
1102\[X] publish... (project will be prompted for)
1103\[A] publish all projects")
1104 (cmds 849 (cmds
1105 '((?t org-insert-export-options-template nil) 850 '((?t org-insert-export-options-template nil)
1106 (?v org-export-visible nil) 851 (?v org-export-visible nil)
1107 (?a org-export-as-ascii t) 852 (?a org-export-as-ascii t)
853 (?A org-export-as-ascii-to-buffer t)
1108 (?h org-export-as-html t) 854 (?h org-export-as-html t)
1109 (?b org-export-as-html-and-open t) 855 (?b org-export-as-html-and-open t)
1110 (?H org-export-as-html-to-buffer nil) 856 (?H org-export-as-html-to-buffer nil)
1111 (?R org-export-region-as-html nil) 857 (?R org-export-region-as-html nil)
1112 (?x org-export-as-xoxo t) 858 (?x org-export-as-xoxo t)
859 (?g org-export-generic t)
860 (?D org-export-as-docbook t)
861 (?V org-export-as-docbook-pdf-and-open t)
1113 (?l org-export-as-latex t) 862 (?l org-export-as-latex t)
1114 (?p org-export-as-pdf t) 863 (?p org-export-as-pdf t)
1115 (?d org-export-as-pdf-and-open t) 864 (?d org-export-as-pdf-and-open t)
@@ -1120,16 +869,17 @@ value of `org-export-run-in-background'."
1120 (?F org-publish-current-file t) 869 (?F org-publish-current-file t)
1121 (?P org-publish-current-project t) 870 (?P org-publish-current-project t)
1122 (?X org-publish t) 871 (?X org-publish t)
1123 (?A org-publish-all t))) 872 (?E org-publish-all t)))
1124 r1 r2 ass) 873 r1 r2 ass)
1125 (save-window-excursion 874 (save-excursion
1126 (delete-other-windows) 875 (save-window-excursion
1127 (with-output-to-temp-buffer "*Org Export/Publishing Help*" 876 (delete-other-windows)
1128 (princ help)) 877 (with-output-to-temp-buffer "*Org Export/Publishing Help*"
1129 (org-fit-window-to-buffer (get-buffer-window 878 (princ help))
1130 "*Org Export/Publishing Help*")) 879 (org-fit-window-to-buffer (get-buffer-window
1131 (message "Select command: ") 880 "*Org Export/Publishing Help*"))
1132 (setq r1 (read-char-exclusive))) 881 (message "Select command: ")
882 (setq r1 (read-char-exclusive))))
1133 (setq r2 (if (< r1 27) (+ r1 96) r1)) 883 (setq r2 (if (< r1 27) (+ r1 96) r1))
1134 (unless (setq ass (assq r2 cmds)) 884 (unless (setq ass (assq r2 cmds))
1135 (error "No command associated with key %c" r1)) 885 (error "No command associated with key %c" r1))
@@ -1176,6 +926,7 @@ value of `org-export-run-in-background'."
1176 ("reg") 926 ("reg")
1177 ("macr") 927 ("macr")
1178 ("deg") 928 ("deg")
929 ("pm" . "&plusmn;")
1179 ("plusmn") 930 ("plusmn")
1180 ("sup2") 931 ("sup2")
1181 ("sup3") 932 ("sup3")
@@ -1461,6 +1212,8 @@ translations. There is currently no way for users to extend this.")
1461 1212
1462(defvar org-export-target-aliases nil 1213(defvar org-export-target-aliases nil
1463 "Alist of targets with invisible aliases.") 1214 "Alist of targets with invisible aliases.")
1215(defvar org-export-preferred-target-alist nil
1216 "Alist of section id's with preferred aliases.")
1464(defvar org-export-code-refs nil 1217(defvar org-export-code-refs nil
1465 "Alist of code references and line numbers") 1218 "Alist of code references and line numbers")
1466 1219
@@ -1474,8 +1227,11 @@ on this string to produce the exported version."
1474 (let* ((htmlp (plist-get parameters :for-html)) 1227 (let* ((htmlp (plist-get parameters :for-html))
1475 (asciip (plist-get parameters :for-ascii)) 1228 (asciip (plist-get parameters :for-ascii))
1476 (latexp (plist-get parameters :for-LaTeX)) 1229 (latexp (plist-get parameters :for-LaTeX))
1477 (backend (cond (htmlp 'html) (latexp 'latex) (asciip 'ascii))) 1230 (docbookp (plist-get parameters :for-docbook))
1478 1231 (backend (cond (htmlp 'html)
1232 (latexp 'latex)
1233 (asciip 'ascii)
1234 (docbookp 'docbook)))
1479 (archived-trees (plist-get parameters :archived-trees)) 1235 (archived-trees (plist-get parameters :archived-trees))
1480 (inhibit-read-only t) 1236 (inhibit-read-only t)
1481 (drawers org-drawers) 1237 (drawers org-drawers)
@@ -1483,6 +1239,7 @@ on this string to produce the exported version."
1483 target-alist rtn) 1239 target-alist rtn)
1484 1240
1485 (setq org-export-target-aliases nil) 1241 (setq org-export-target-aliases nil)
1242 (setq org-export-preferred-target-alist nil)
1486 (setq org-export-code-refs nil) 1243 (setq org-export-code-refs nil)
1487 1244
1488 (with-current-buffer (get-buffer-create " org-mode-tmp") 1245 (with-current-buffer (get-buffer-create " org-mode-tmp")
@@ -1497,10 +1254,15 @@ on this string to produce the exported version."
1497 1254
1498 (let ((org-inhibit-startup t)) (org-mode)) 1255 (let ((org-inhibit-startup t)) (org-mode))
1499 (setq case-fold-search t) 1256 (setq case-fold-search t)
1257 (org-install-letbind)
1500 1258
1501 ;; Call the hook 1259 ;; Call the hook
1502 (run-hooks 'org-export-preprocess-hook) 1260 (run-hooks 'org-export-preprocess-hook)
1503 1261
1262 ;; Process the macros
1263 (org-export-preprocess-apply-macros)
1264 (run-hooks 'org-export-preprocess-after-macros-hook)
1265
1504 (untabify (point-min) (point-max)) 1266 (untabify (point-min) (point-max))
1505 1267
1506 ;; Handle include files, and call a hook 1268 ;; Handle include files, and call a hook
@@ -1560,14 +1322,17 @@ on this string to produce the exported version."
1560 ;; Protect quoted subtrees 1322 ;; Protect quoted subtrees
1561 (org-export-protect-quoted-subtrees) 1323 (org-export-protect-quoted-subtrees)
1562 1324
1325 ;; Remove clock lines
1326 (org-export-remove-clock-lines)
1327
1563 ;; Protect verbatim elements 1328 ;; Protect verbatim elements
1564 (org-export-protect-verbatim) 1329 (org-export-protect-verbatim)
1565 1330
1566 ;; Blockquotes and verse 1331 ;; Blockquotes, verse, and center
1567 (org-export-mark-blockquote-and-verse) 1332 (org-export-mark-blockquote-verse-center)
1333 (run-hooks 'org-export-preprocess-after-blockquote-hook)
1568 1334
1569 ;; Remove timestamps, if the user has requested so 1335 ;; Remove timestamps, if the user has requested so
1570 (org-export-remove-clock-lines)
1571 (unless (plist-get parameters :timestamps) 1336 (unless (plist-get parameters :timestamps)
1572 (org-export-remove-timestamps)) 1337 (org-export-remove-timestamps))
1573 1338
@@ -1603,17 +1368,22 @@ on this string to produce the exported version."
1603 1368
1604 ;; LaTeX-specific preprocessing 1369 ;; LaTeX-specific preprocessing
1605 (when latexp 1370 (when latexp
1606 (require 'org-export-latex nil) 1371 (require 'org-latex nil)
1607 (org-export-latex-preprocess)) 1372 (org-export-latex-preprocess parameters))
1608 1373
1609 ;; ASCII-specific preprocessing 1374 ;; ASCII-specific preprocessing
1610 (when asciip 1375 (when asciip
1611 (org-export-ascii-preprocess)) 1376 (org-export-ascii-preprocess parameters))
1612 1377
1613 ;; HTML-specific preprocessing 1378 ;; HTML-specific preprocessing
1614 (when htmlp 1379 (when htmlp
1615 (org-export-html-preprocess parameters)) 1380 (org-export-html-preprocess parameters))
1616 1381
1382 ;; DocBook-specific preprocessing
1383 (when docbookp
1384 (require 'org-docbook nil)
1385 (org-export-docbook-preprocess parameters))
1386
1617 ;; Remove or replace comments 1387 ;; Remove or replace comments
1618 (org-export-handle-comments (plist-get parameters :comments)) 1388 (org-export-handle-comments (plist-get parameters :comments))
1619 1389
@@ -1639,19 +1409,24 @@ The new targets are added to TARGET-ALIST, which is also returned."
1639 (goto-char (point-min)) 1409 (goto-char (point-min))
1640 (org-init-section-numbers) 1410 (org-init-section-numbers)
1641 (let ((re (concat "^" org-outline-regexp 1411 (let ((re (concat "^" org-outline-regexp
1642 "\\| [ \t]*:ID:[ \t]*\\([^ \t\r\n]+\\)")) 1412 "\\| [ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)"))
1643 level target last-section-target a) 1413 level target last-section-target a id)
1644 (while (re-search-forward re nil t) 1414 (while (re-search-forward re nil t)
1645 (if (match-end 1) 1415 (if (match-end 2)
1646 (progn 1416 (progn
1647 (push (cons (org-match-string-no-properties 1) 1417 (setq id (org-match-string-no-properties 2))
1648 target) target-alist) 1418 (push (cons id target) target-alist)
1649 (setq a (or (assoc last-section-target org-export-target-aliases) 1419 (setq a (or (assoc last-section-target org-export-target-aliases)
1650 (progn 1420 (progn
1651 (push (list last-section-target) 1421 (push (list last-section-target)
1652 org-export-target-aliases) 1422 org-export-target-aliases)
1653 (car org-export-target-aliases)))) 1423 (car org-export-target-aliases))))
1654 (push (caar target-alist) (cdr a))) 1424 (push (caar target-alist) (cdr a))
1425 (when (equal (match-string 1) "CUSTOM_ID")
1426 (if (not (assoc last-section-target
1427 org-export-preferred-target-alist))
1428 (push (cons last-section-target id)
1429 org-export-preferred-target-alist))))
1655 (setq level (org-reduced-level 1430 (setq level (org-reduced-level
1656 (save-excursion (goto-char (point-at-bol)) 1431 (save-excursion (goto-char (point-at-bol))
1657 (org-outline-level)))) 1432 (org-outline-level))))
@@ -1705,7 +1480,13 @@ the current file."
1705 found props pos cref 1480 found props pos cref
1706 (target 1481 (target
1707 (cond 1482 (cond
1708 ((cdr (assoc slink target-alist))) 1483 ((= (string-to-char link) ?#)
1484 ;; user wants exactly this link
1485 link)
1486 ((cdr (assoc slink target-alist))
1487 (or (cdr (assoc (assoc slink target-alist)
1488 org-export-preferred-target-alist))
1489 (cdr (assoc slink target-alist))))
1709 ((and (string-match "^id:" link) 1490 ((and (string-match "^id:" link)
1710 (cdr (assoc (substring link 3) target-alist)))) 1491 (cdr (assoc (substring link 3) target-alist))))
1711 ((string-match "^(\\(.*\\))$" link) 1492 ((string-match "^(\\(.*\\))$" link)
@@ -1751,10 +1532,20 @@ whose content to keep."
1751 (org-delete-all exp-drawers 1532 (org-delete-all exp-drawers
1752 (copy-sequence all-drawers)) 1533 (copy-sequence all-drawers))
1753 "\\|") 1534 "\\|")
1754 "\\):[ \t]*\n\\([^\000]*?\n\\)?[ \t]*:END:[ \t]*\n"))) 1535 "\\):[ \t]*$"))
1536 beg eol)
1755 (while (re-search-forward re nil t) 1537 (while (re-search-forward re nil t)
1756 (org-if-unprotected 1538 (org-if-unprotected
1757 (replace-match "")))))) 1539 (setq beg (match-beginning 0)
1540 eol (match-end 0))
1541 (if (re-search-forward "^\\([ \t]*:END:[ \t]*\n?\\)\\|^\\*+[ \t]"
1542 nil t)
1543 (if (match-end 1)
1544 ;; terminated in this entry
1545 (progn
1546 (delete-region beg (match-end 1))
1547 (goto-char beg))
1548 (goto-char eol))))))))
1758 1549
1759(defun org-export-handle-export-tags (select-tags exclude-tags) 1550(defun org-export-handle-export-tags (select-tags exclude-tags)
1760 "Modify the buffer, honoring SELECT-TAGS and EXCLUDE-TAGS. 1551 "Modify the buffer, honoring SELECT-TAGS and EXCLUDE-TAGS.
@@ -1848,6 +1639,7 @@ from the buffer."
1848 1639
1849(defun org-export-remove-timestamps () 1640(defun org-export-remove-timestamps ()
1850 "Remove timestamps and keywords for export." 1641 "Remove timestamps and keywords for export."
1642 (goto-char (point-min))
1851 (while (re-search-forward org-maybe-keyword-time-regexp nil t) 1643 (while (re-search-forward org-maybe-keyword-time-regexp nil t)
1852 (backward-char 1) 1644 (backward-char 1)
1853 (org-if-unprotected 1645 (org-if-unprotected
@@ -1858,7 +1650,8 @@ from the buffer."
1858 (replace-match "")))))) 1650 (replace-match ""))))))
1859 1651
1860(defun org-export-remove-clock-lines () 1652(defun org-export-remove-clock-lines ()
1861 "Remove timestamps and keywords for export." 1653 "Remove clock lines for export."
1654 (goto-char (point-min))
1862 (let ((re (concat "^[ \t]*" org-clock-string ".*\n?"))) 1655 (let ((re (concat "^[ \t]*" org-clock-string ".*\n?")))
1863 (while (re-search-forward re nil t) 1656 (while (re-search-forward re nil t)
1864 (org-if-unprotected 1657 (org-if-unprotected
@@ -1897,7 +1690,8 @@ from the buffer."
1897 1690
1898(defun org-export-select-backend-specific-text (backend) 1691(defun org-export-select-backend-specific-text (backend)
1899 (let ((formatters 1692 (let ((formatters
1900 '((html "HTML" "BEGIN_HTML" "END_HTML") 1693 '((docbook "DOCBOOK" "BEGIN_DOCBOOK" "END_DOCBOOK")
1694 (html "HTML" "BEGIN_HTML" "END_HTML")
1901 (ascii "ASCII" "BEGIN_ASCII" "END_ASCII") 1695 (ascii "ASCII" "BEGIN_ASCII" "END_ASCII")
1902 (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) 1696 (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX")))
1903 (case-fold-search t) 1697 (case-fold-search t)
@@ -1908,17 +1702,17 @@ from the buffer."
1908 (when (eq (car fmt) backend) 1702 (when (eq (car fmt) backend)
1909 ;; This is selected code, put it into the file for real 1703 ;; This is selected code, put it into the file for real
1910 (goto-char (point-min)) 1704 (goto-char (point-min))
1911 (while (re-search-forward (concat "^#\\+" (cadr fmt) 1705 (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" (cadr fmt)
1912 ":[ \t]*\\(.*\\)") nil t) 1706 ":[ \t]*\\(.*\\)") nil t)
1913 (replace-match "\\1" t) 1707 (replace-match "\\1\\2" t)
1914 (add-text-properties 1708 (add-text-properties
1915 (point-at-bol) (min (1+ (point-at-eol)) (point-max)) 1709 (point-at-bol) (min (1+ (point-at-eol)) (point-max))
1916 '(org-protected t)))) 1710 '(org-protected t))))
1917 (goto-char (point-min)) 1711 (goto-char (point-min))
1918 (while (re-search-forward 1712 (while (re-search-forward
1919 (concat "^#\\+" 1713 (concat "^[ \t]*#\\+" (caddr fmt)
1920 (caddr fmt) "\\>.*\\(\\(\n.*\\)*?\n\\)#\\+" 1714 "\\>.*\\(\\(\n.*\\)*?\n\\)[ \t]*#\\+" (cadddr fmt)
1921 (cadddr fmt) "\\>.*\n?") nil t) 1715 "\\>.*\n?") nil t)
1922 (if (eq (car fmt) backend) 1716 (if (eq (car fmt) backend)
1923 ;; yes, keep this 1717 ;; yes, keep this
1924 (add-text-properties (match-beginning 1) (1+ (match-end 1)) 1718 (add-text-properties (match-beginning 1) (1+ (match-end 1))
@@ -1926,22 +1720,29 @@ from the buffer."
1926 ;; No, this is for a different backend, kill it 1720 ;; No, this is for a different backend, kill it
1927 (delete-region (match-beginning 0) (match-end 0))))))) 1721 (delete-region (match-beginning 0) (match-end 0)))))))
1928 1722
1929(defun org-export-mark-blockquote-and-verse () 1723(defun org-export-mark-blockquote-verse-center ()
1930 "Mark block quote and verse environments with special cookies. 1724 "Mark block quote and verse environments with special cookies.
1931These special cookies will later be interpreted by the backend." 1725These special cookies will later be interpreted by the backend."
1932 ;; Blockquotes 1726 ;; Blockquotes
1933 (goto-char (point-min)) 1727 (let (type t1 ind beg end beg1 end1 content)
1934 (while (re-search-forward "^#\\+\\(begin\\|end\\)_\\(block\\)?quote\\>.*" 1728 (goto-char (point-min))
1935 nil t) 1729 (while (re-search-forward
1936 (replace-match (if (equal (downcase (match-string 1)) "end") 1730 "^\\([ \t]*\\)#\\+\\(begin_\\(\\(block\\)?quote\\|verse\\|center\\)\\>.*\\)"
1937 "ORG-BLOCKQUOTE-END" "ORG-BLOCKQUOTE-START") 1731 nil t)
1938 t t)) 1732 (setq ind (length (match-string 1))
1939 ;; Verse 1733 type (downcase (match-string 3))
1940 (goto-char (point-min)) 1734 t1 (if (equal type "quote") "blockquote" type))
1941 (while (re-search-forward "^#\\+\\(begin\\|end\\)_verse\\>.*" nil t) 1735 (setq beg (match-beginning 0)
1942 (replace-match (if (equal (downcase (match-string 1)) "end") 1736 beg1 (1+ (match-end 0)))
1943 "ORG-VERSE-END" "ORG-VERSE-START") 1737 (when (re-search-forward (concat "^[ \t]*#\\+end_" type "\\>.*") nil t)
1944 t t))) 1738 (setq end (1+ (point-at-eol))
1739 end1 (1- (match-beginning 0)))
1740 (setq content (org-remove-indentation (buffer-substring beg1 end1)))
1741 (setq content (concat "ORG-" (upcase t1) "-START\n"
1742 content "\n"
1743 "ORG-" (upcase t1) "-END\n"))
1744 (delete-region beg end)
1745 (insert (org-add-props content nil 'original-indentation ind))))))
1945 1746
1946(defun org-export-attach-captions-and-attributes (backend target-alist) 1747(defun org-export-attach-captions-and-attributes (backend target-alist)
1947 "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. 1748 "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."
1951 (remove-text-properties (point-min) (point-max) 1752 (remove-text-properties (point-min) (point-max)
1952 '(org-caption nil org-attributes nil)) 1753 '(org-caption nil org-attributes nil))
1953 (let ((case-fold-search t) 1754 (let ((case-fold-search t)
1954 (re (concat "^#\\+caption:[ \t]+\\(.*\\)" 1755 (re (concat "^[ \t]*#\\+caption:[ \t]+\\(.*\\)"
1955 "\\|" 1756 "\\|"
1956 "^#\\+attr_" (symbol-name backend) ":[ \t]+\\(.*\\)" 1757 "^[ \t]*#\\+attr_" (symbol-name backend) ":[ \t]+\\(.*\\)"
1957 "\\|" 1758 "\\|"
1958 "^#\\+label:[ \t]+\\(.*\\)" 1759 "^[ \t]*#\\+label:[ \t]+\\(.*\\)"
1959 "\\|" 1760 "\\|"
1960 "^[ \t]*|[^-]" 1761 "^[ \t]*|[^-]"
1961 "\\|" 1762 "\\|"
@@ -1997,16 +1798,17 @@ table line. If it is a link, add it to the line containing the link."
1997 "Remove comments, or convert to backend-specific format. 1798 "Remove comments, or convert to backend-specific format.
1998COMMENTSP can be a format string for publishing comments. 1799COMMENTSP can be a format string for publishing comments.
1999When it is nil, all comments will be removed." 1800When it is nil, all comments will be removed."
2000 (let ((re "^#\\(.*\n?\\)") 1801 (let ((re "^\\(#\\|[ \t]*#\\+\\)\\(.*\n?\\)")
2001 pos) 1802 pos)
2002 (goto-char (point-min)) 1803 (goto-char (point-min))
2003 (while (or (looking-at re) 1804 (while (or (looking-at re)
2004 (re-search-forward re nil t)) 1805 (re-search-forward re nil t))
2005 (setq pos (match-beginning 0)) 1806 (setq pos (match-beginning 0))
2006 (if commentsp 1807 (if (and commentsp
1808 (not (equal (char-before (match-end 1)) ?+)))
2007 (progn (add-text-properties 1809 (progn (add-text-properties
2008 (match-beginning 0) (match-end 0) '(org-protected t)) 1810 (match-beginning 0) (match-end 0) '(org-protected t))
2009 (replace-match (format commentsp (match-string 1)) t t)) 1811 (replace-match (format commentsp (match-string 2)) t t))
2010 (goto-char (1+ pos)) 1812 (goto-char (1+ pos))
2011 (org-if-unprotected 1813 (org-if-unprotected
2012 (replace-match "") 1814 (replace-match "")
@@ -2019,8 +1821,12 @@ When it is nil, all comments will be removed."
2019 (goto-char (point-min)) 1821 (goto-char (point-min))
2020 (when re-radio 1822 (when re-radio
2021 (while (re-search-forward re-radio nil t) 1823 (while (re-search-forward re-radio nil t)
2022 (org-if-unprotected 1824 (unless
2023 (replace-match "\\1[[\\2]]")))))) 1825 (save-match-data
1826 (or (org-in-regexp org-bracket-link-regexp)
1827 (org-in-regexp org-plain-link-re)))
1828 (org-if-unprotected
1829 (replace-match "\\1[[\\2]]")))))))
2024 1830
2025(defun org-export-remove-special-table-lines () 1831(defun org-export-remove-special-table-lines ()
2026 "Remove tables lines that are used for internal purposes." 1832 "Remove tables lines that are used for internal purposes."
@@ -2037,11 +1843,12 @@ When it is nil, all comments will be removed."
2037(defun org-export-normalize-links () 1843(defun org-export-normalize-links ()
2038 "Convert all links to bracket links, and expand link abbreviations." 1844 "Convert all links to bracket links, and expand link abbreviations."
2039 (let ((re-plain-link (concat "\\([^[<]\\)" org-plain-link-re)) 1845 (let ((re-plain-link (concat "\\([^[<]\\)" org-plain-link-re))
2040 (re-angle-link (concat "\\([^[]\\)" org-angle-link-re))) 1846 (re-angle-link (concat "\\([^[]\\)" org-angle-link-re))
1847 nodesc)
2041 (goto-char (point-min)) 1848 (goto-char (point-min))
2042 (while (re-search-forward re-plain-link nil t) 1849 (while (re-search-forward re-plain-link nil t)
2043 (goto-char (1- (match-end 0))) 1850 (goto-char (1- (match-end 0)))
2044 (org-if-unprotected 1851 (org-if-unprotected-at (1+ (match-beginning 0))
2045 (let* ((s (concat (match-string 1) "[[" (match-string 2) 1852 (let* ((s (concat (match-string 1) "[[" (match-string 2)
2046 ":" (match-string 3) "]]"))) 1853 ":" (match-string 3) "]]")))
2047 ;; added 'org-link face to links 1854 ;; added 'org-link face to links
@@ -2058,19 +1865,18 @@ When it is nil, all comments will be removed."
2058 (goto-char (point-min)) 1865 (goto-char (point-min))
2059 (while (re-search-forward org-bracket-link-regexp nil t) 1866 (while (re-search-forward org-bracket-link-regexp nil t)
2060 (goto-char (1- (match-end 0))) 1867 (goto-char (1- (match-end 0)))
1868 (setq nodesc (not (match-end 3)))
2061 (org-if-unprotected 1869 (org-if-unprotected
2062 (let* ((xx (save-match-data 1870 (let* ((xx (save-match-data
2063 (org-translate-link 1871 (org-translate-link
2064 (org-link-expand-abbrev (match-string 1))))) 1872 (org-link-expand-abbrev (match-string 1)))))
2065 (s (concat 1873 (s (concat
2066 "[[" (org-add-props (copy-sequence xx) 1874 "[[" (org-add-props (copy-sequence xx)
2067 nil 'org-protected t) 1875 nil 'org-protected t 'org-no-description nodesc)
2068 "]" 1876 "]"
2069 (if (match-end 3) 1877 (if (match-end 3)
2070 (match-string 2) 1878 (match-string 2)
2071 (concat "[" (org-add-props 1879 (concat "[" (copy-sequence xx)
2072 (copy-sequence xx)
2073 '(org-protected t))
2074 "]")) 1880 "]"))
2075 "]"))) 1881 "]")))
2076 (put-text-property 0 (length s) 'face 'org-link s) 1882 (put-text-property 0 (length s) 'face 'org-link s)
@@ -2145,13 +1951,14 @@ can work correctly."
2145 (a (assoc rtn alist))) 1951 (a (assoc rtn alist)))
2146 (or (cdr a) rtn)))) 1952 (or (cdr a) rtn))))
2147 1953
2148(defun org-get-min-level (lines) 1954(defun org-get-min-level (lines &optional offset)
2149 "Get the minimum level in LINES." 1955 "Get the minimum level in LINES."
2150 (let ((re "^\\(\\*+\\) ") l) 1956 (let ((re "^\\(\\*+\\) ") l)
2151 (catch 'exit 1957 (catch 'exit
2152 (while (setq l (pop lines)) 1958 (while (setq l (pop lines))
2153 (if (string-match re l) 1959 (if (string-match re l)
2154 (throw 'exit (org-tr-level (length (match-string 1 l)))))) 1960 (throw 'exit (org-tr-level (- (length (match-string 1 l))
1961 (or offset 0))))))
2155 1))) 1962 1)))
2156 1963
2157;; Variable holding the vector with section numbers 1964;; Variable holding the vector with section numbers
@@ -2242,8 +2049,52 @@ TYPE must be a string, any of:
2242 (pop roman))) 2049 (pop roman)))
2243 res))) 2050 res)))
2244 2051
2245(org-number-to-roman 1961) 2052;;; Macros
2246 2053
2054(defun org-export-preprocess-apply-macros ()
2055 "Replace macro references."
2056 (goto-char (point-min))
2057 (let (sy val key args args2 s n)
2058 (while (re-search-forward
2059 "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\(.*?\\))\\)?}}}"
2060 nil t)
2061 (setq key (downcase (match-string 1))
2062 args (match-string 3))
2063 (when (setq val (or (plist-get org-export-opt-plist
2064 (intern (concat ":macro-" key)))
2065 (plist-get org-export-opt-plist
2066 (intern (concat ":" key)))))
2067 (save-match-data
2068 (when args
2069 (setq args (org-split-string args ",[ \t]*") args2 nil)
2070 (while args
2071 (while (string-match "\\\\\\'" (car args))
2072 ;; repair bad splits
2073 (setcar (cdr args) (concat (substring (car args) 0 -1)
2074 ";" (nth 1 args)))
2075 (pop args))
2076 (push (pop args) args2))
2077 (setq args (nreverse args2))
2078 (setq s 0)
2079 (while (string-match "\\$\\([0-9]+\\)" val s)
2080 (setq s (1+ (match-beginning 0))
2081 n (string-to-number (match-string 1 val)))
2082 (and (>= (length args) n)
2083 (setq val (replace-match (nth (1- n) args) t t val)))))
2084 (when (string-match "\\`(eval\\>" val)
2085 (setq val (eval (read val))))
2086 (if (and val (not (stringp val)))
2087 (setq val (format "%s" val))))
2088 (and (stringp val)
2089 (replace-match val t t))))))
2090
2091(defun org-export-apply-macros-in-string (s)
2092 "Apply the macros in string S."
2093 (when s
2094 (with-temp-buffer
2095 (insert s)
2096 (org-export-preprocess-apply-macros)
2097 (buffer-string))))
2247 2098
2248;;; Include files 2099;;; Include files
2249 2100
@@ -2275,14 +2126,16 @@ TYPE must be a string, any of:
2275 (setq start (format "#+begin_%s %s\n" markup switches) 2126 (setq start (format "#+begin_%s %s\n" markup switches)
2276 end (format "#+end_%s" markup)))) 2127 end (format "#+end_%s" markup))))
2277 (insert (or start "")) 2128 (insert (or start ""))
2278 (insert (org-get-file-contents (expand-file-name file) prefix prefix1)) 2129 (insert (org-get-file-contents (expand-file-name file) prefix prefix1 markup))
2279 (or (bolp) (newline)) 2130 (or (bolp) (newline))
2280 (insert (or end "")))))) 2131 (insert (or end ""))))))
2281 2132
2282(defun org-get-file-contents (file &optional prefix prefix1) 2133(defun org-get-file-contents (file &optional prefix prefix1 markup)
2283 "Get the contents of FILE and return them as a string. 2134 "Get the contents of FILE and return them as a string.
2284If PREFIX is a string, prepend it to each line. If PREFIX1 2135If PREFIX is a string, prepend it to each line. If PREFIX1
2285is a string, prepend it to the first line instead of PREFIX." 2136is a string, prepend it to the first line instead of PREFIX.
2137If MARKUP, don't protect org-like lines, the exporter will
2138take care of the block they are in."
2286 (with-temp-buffer 2139 (with-temp-buffer
2287 (insert-file-contents file) 2140 (insert-file-contents file)
2288 (when (or prefix prefix1) 2141 (when (or prefix prefix1)
@@ -2291,6 +2144,13 @@ is a string, prepend it to the first line instead of PREFIX."
2291 (insert (or prefix1 prefix)) 2144 (insert (or prefix1 prefix))
2292 (setq prefix1 nil) 2145 (setq prefix1 nil)
2293 (beginning-of-line 2))) 2146 (beginning-of-line 2)))
2147 (buffer-string)
2148 (unless markup
2149 (goto-char (point-min))
2150 (while (re-search-forward "^\\(\\*\\|[ \t]*#\\)" nil t)
2151 (goto-char (match-beginning 0))
2152 (insert ",")
2153 (end-of-line 1)))
2294 (buffer-string))) 2154 (buffer-string)))
2295 2155
2296(defun org-get-and-remove-property (listvar prop) 2156(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."
2320 "Replace source code segments with special code for export." 2180 "Replace source code segments with special code for export."
2321 (setq org-export-last-code-line-counter-value 0) 2181 (setq org-export-last-code-line-counter-value 0)
2322 (let ((case-fold-search t) 2182 (let ((case-fold-search t)
2323 lang code trans opts) 2183 lang code trans opts indent)
2324 (goto-char (point-min)) 2184 (goto-char (point-min))
2325 (while (re-search-forward 2185 (while (re-search-forward
2326 "\\(^#\\+BEGIN_SRC:?[ \t]+\\([^ \t\n]+\\)\\(.*\\)\n\\([^\000]+?\n\\)#\\+END_SRC.*\\)\\|\\(^#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)#\\+END_EXAMPLE.*\\)" 2186 "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?[ \t]+\\([^ \t\n]+\\)\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\\)"
2327 nil t) 2187 nil t)
2328 (if (match-end 1) 2188 (if (match-end 1)
2329 ;; src segments 2189 ;; src segments
2330 (setq lang (match-string 2) 2190 (setq lang (match-string 3)
2331 opts (match-string 3) 2191 opts (match-string 4)
2332 code (match-string 4)) 2192 code (match-string 5)
2193 indent (length (match-string 2)))
2333 (setq lang nil 2194 (setq lang nil
2334 opts (match-string 6) 2195 opts (match-string 8)
2335 code (match-string 7))) 2196 code (match-string 9)
2197 indent (length (match-string 7))))
2336 2198
2337 (setq trans (org-export-format-source-code-or-example 2199 (setq trans (org-export-format-source-code-or-example
2338 backend lang code opts)) 2200 backend lang code opts indent))
2339 (replace-match trans t t)))) 2201 (replace-match trans t t))))
2340 2202
2341(defvar htmlp) ;; dynamically scoped 2203(defvar htmlp) ;; dynamically scoped
2342(defvar latexp) ;; dynamically scoped 2204(defvar latexp) ;; dynamically scoped
2205(defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el
2343 2206
2344(defun org-export-format-source-code-or-example (backend 2207(defun org-export-format-source-code-or-example
2345 lang code &optional opts) 2208 (backend lang code &optional opts indent)
2346 "Format CODE from language LANG and return it formatted for export. 2209 "Format CODE from language LANG and return it formatted for export.
2347If LANG is nil, do not add any fontification. 2210If LANG is nil, do not add any fontification.
2348OPTS contains formatting optons, like `-n' for triggering numbering lines, 2211OPTS contains formatting optons, like `-n' for triggering numbering lines,
2349and `+n' for continuing previous numering. 2212and `+n' for continuing previous numering.
2350Code formatting according to language currently only works for HTML. 2213Code formatting according to language currently only works for HTML.
2351Numbering lines works for all three major backends (html, latex, and ascii)." 2214Numbering lines works for all three major backends (html, latex, and ascii).
2215INDENT was the original indentation of the block."
2352 (save-match-data 2216 (save-match-data
2353 (let (num cont rtn rpllbl keepp textareap cols rows fmt) 2217 (let (num cont rtn rpllbl keepp textareap cols rows fmt)
2354 (setq opts (or opts "") 2218 (setq opts (or opts "")
@@ -2369,88 +2233,104 @@ Numbering lines works for all three major backends (html, latex, and ascii)."
2369 ;; we cannot use numbering or highlighting. 2233 ;; we cannot use numbering or highlighting.
2370 (setq num nil cont nil lang nil)) 2234 (setq num nil cont nil lang nil))
2371 (if keepp (setq rpllbl 'keep)) 2235 (if keepp (setq rpllbl 'keep))
2372 (setq rtn code) 2236 (setq rtn (org-remove-indentation code))
2373 (when (equal lang "org") 2237 (when (string-match "^," rtn)
2374 (setq rtn (with-temp-buffer 2238 (setq rtn (with-temp-buffer
2375 (insert rtn) 2239 (insert rtn)
2376 ;; Free up the protected lines 2240 ;; Free up the protected lines
2377 (goto-char (point-min)) 2241 (goto-char (point-min))
2378 (while (re-search-forward "^," nil t) 2242 (while (re-search-forward "^," nil t)
2379 (replace-match "") 2243 (if (or (equal lang "org")
2244 (save-match-data
2245 (looking-at "\\([*#]\\|[ \t]*#\\+\\)")))
2246 (replace-match ""))
2380 (end-of-line 1)) 2247 (end-of-line 1))
2381 (buffer-string)))) 2248 (buffer-string))))
2382 ;; Now backend-specific coding 2249 ;; Now backend-specific coding
2383 (cond 2250 (setq rtn
2384 ((eq backend 'html) 2251 (cond
2385 ;; We are exporting to HTML 2252 ((eq backend 'docbook)
2386 (when lang 2253 (setq rtn (org-export-number-lines rtn 'docbook 0 0 num cont rpllbl fmt))
2387 (require 'htmlize nil t) 2254 (concat "\n#+BEGIN_DOCBOOK\n"
2388 (when (not (fboundp 'htmlize-region-for-paste)) 2255 (org-add-props (concat "<programlisting><![CDATA["
2389 ;; we do not have htmlize.el, or an old version of it 2256 rtn
2390 (setq lang nil) 2257 "]]>\n</programlisting>\n")
2391 (message 2258 '(org-protected t))
2392 "htmlize.el 1.34 or later is needed for source code formatting"))) 2259 "#+END_DOCBOOK\n"))
2393 2260 ((eq backend 'html)
2394 (if lang 2261 ;; We are exporting to HTML
2395 (let* ((mode (and lang (intern (concat lang "-mode")))) 2262 (when lang
2396 (org-inhibit-startup t) 2263 (require 'htmlize nil t)
2397 (org-startup-folded nil)) 2264 (when (not (fboundp 'htmlize-region-for-paste))
2398 (setq rtn 2265 ;; we do not have htmlize.el, or an old version of it
2399 (with-temp-buffer 2266 (setq lang nil)
2400 (insert rtn) 2267 (message
2401 (if (functionp mode) 2268 "htmlize.el 1.34 or later is needed for source code formatting")))
2402 (funcall mode) 2269
2403 (fundamental-mode)) 2270 (if lang
2404 (font-lock-fontify-buffer) 2271 (let* ((mode (and lang (intern (concat lang "-mode"))))
2405 (org-export-htmlize-region-for-paste 2272 (org-inhibit-startup t)
2406 (point-min) (point-max)))) 2273 (org-startup-folded nil))
2407 (if (string-match "<pre\\([^>]*\\)>\n?" rtn) 2274 (setq rtn
2408 (setq rtn (replace-match 2275 (with-temp-buffer
2409 (format "<pre class=\"src src-%s\">\n" lang) 2276 (insert rtn)
2410 t t rtn)))) 2277 (if (functionp mode)
2411 (if textareap 2278 (funcall mode)
2412 (setq rtn (concat 2279 (fundamental-mode))
2413 (format "<p>\n<textarea cols=\"%d\" rows=\"%d\" overflow-x:scroll >\n" 2280 (font-lock-fontify-buffer)
2414 cols rows) 2281 (org-src-mode)
2415 rtn "</textarea>\n</p>\n")) 2282 (set-buffer-modified-p nil)
2416 (with-temp-buffer 2283 (org-export-htmlize-region-for-paste
2417 (insert rtn) 2284 (point-min) (point-max))))
2418 (goto-char (point-min)) 2285 (if (string-match "<pre\\([^>]*\\)>\n*" rtn)
2419 (while (re-search-forward "[<>&]" nil t) 2286 (setq rtn (replace-match
2420 (replace-match (cdr (assq (char-before) 2287 (format "<pre class=\"src src-%s\">\n" lang)
2421 '((?&."&amp;")(?<."&lt;")(?>."&gt;")))) 2288 t t rtn))))
2422 t t)) 2289 (if textareap
2423 (setq rtn (buffer-string))) 2290 (setq rtn (concat
2424 (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n")))) 2291 (format "<p>\n<textarea cols=\"%d\" rows=\"%d\" overflow-x:scroll >\n"
2425 (unless textareap 2292 cols rows)
2426 (setq rtn (org-export-number-lines rtn 'html 1 1 num 2293 rtn "</textarea>\n</p>\n"))
2427 cont rpllbl fmt))) 2294 (with-temp-buffer
2428 (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t)) "\n#+END_HTML\n\n")) 2295 (insert rtn)
2429 ((eq backend 'latex) 2296 (goto-char (point-min))
2430 (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt)) 2297 (while (re-search-forward "[<>&]" nil t)
2431 (concat "\n#+BEGIN_LaTeX\n" 2298 (replace-match (cdr (assq (char-before)
2432 (org-add-props (concat "\\begin{verbatim}\n" rtn "\n\\end{verbatim}\n") 2299 '((?&."&amp;")(?<."&lt;")(?>."&gt;"))))
2433 '(org-protected t)) 2300 t t))
2434 "#+END_LaTeX\n\n")) 2301 (setq rtn (buffer-string)))
2435 ((eq backend 'ascii) 2302 (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n"))))
2436 ;; This is not HTML or LaTeX, so just make it an example. 2303 (unless textareap
2437 (setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt)) 2304 (setq rtn (org-export-number-lines rtn 'html 1 1 num
2438 (concat "#+BEGIN_ASCII\n" 2305 cont rpllbl fmt)))
2439 (org-add-props 2306 (if (string-match "\\(\\`<[^>]*>\\)\n" rtn)
2440 (concat 2307 (setq rtn (replace-match "\\1" t nil rtn)))
2441 (mapconcat 2308 (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t)) "\n#+END_HTML\n\n"))
2442 (lambda (l) (concat " " l)) 2309 ((eq backend 'latex)
2443 (org-split-string rtn "\n") 2310 (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt))
2444 "\n") 2311 (concat "\n#+BEGIN_LaTeX\n"
2445 "\n") 2312 (org-add-props (concat (car org-export-latex-verbatim-wrap)
2446 '(org-protected t)) 2313 rtn (cdr org-export-latex-verbatim-wrap))
2447 "#+END_ASCII\n")))))) 2314 '(org-protected t))
2315 "#+END_LaTeX\n\n"))
2316 ((eq backend 'ascii)
2317 ;; This is not HTML or LaTeX, so just make it an example.
2318 (setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt))
2319 (concat "#+BEGIN_ASCII\n"
2320 (org-add-props
2321 (concat
2322 (mapconcat
2323 (lambda (l) (concat " " l))
2324 (org-split-string rtn "\n")
2325 "\n")
2326 "\n")
2327 '(org-protected t))
2328 "#+END_ASCII\n"))))
2329 (org-add-props rtn nil 'original-indentation indent))))
2448 2330
2449(defun org-export-number-lines (text backend 2331(defun org-export-number-lines (text backend
2450 &optional skip1 skip2 number cont 2332 &optional skip1 skip2 number cont
2451 replace-labels label-format) 2333 replace-labels label-format)
2452 (if (and (not number) (not (eq replace-labels 'keep)))
2453 (setq replace-labels nil)) ;; must use names if no numbers
2454 (setq skip1 (or skip1 0) skip2 (or skip2 0)) 2334 (setq skip1 (or skip1 0) skip2 (or skip2 0))
2455 (if (not cont) (setq org-export-last-code-line-counter-value 0)) 2335 (if (not cont) (setq org-export-last-code-line-counter-value 0))
2456 (with-temp-buffer 2336 (with-temp-buffer
@@ -2469,6 +2349,7 @@ Numbering lines works for all three major backends (html, latex, and ascii)."
2469 fmt)) 2349 fmt))
2470 ((eq backend 'ascii) fmt) 2350 ((eq backend 'ascii) fmt)
2471 ((eq backend 'latex) fmt) 2351 ((eq backend 'latex) fmt)
2352 ((eq backend 'docbook) fmt)
2472 (t ""))) 2353 (t "")))
2473 (label-format (or label-format org-coderef-label-format)) 2354 (label-format (or label-format org-coderef-label-format))
2474 (label-pre (if (string-match "%s" label-format) 2355 (label-pre (if (string-match "%s" label-format)
@@ -2478,10 +2359,10 @@ Numbering lines works for all three major backends (html, latex, and ascii)."
2478 (substring label-format (match-end 0)) 2359 (substring label-format (match-end 0))
2479 "")) 2360 ""))
2480 (lbl-re 2361 (lbl-re
2481 (concat 2362 (concat
2482 ".*?\\S-.*?\\([ \t]*\\(" 2363 ".*?\\S-.*?\\([ \t]*\\("
2483 (regexp-quote label-pre) 2364 (regexp-quote label-pre)
2484 "\\([-a-zA-Z0-9_]+\\)" 2365 "\\([-a-zA-Z0-9_ ]+\\)"
2485 (regexp-quote label-post) 2366 (regexp-quote label-post)
2486 "\\)\\)")) 2367 "\\)\\)"))
2487 ref) 2368 ref)
@@ -2491,17 +2372,28 @@ Numbering lines works for all three major backends (html, latex, and ascii)."
2491 (if number 2372 (if number
2492 (insert (format fm (incf n))) 2373 (insert (format fm (incf n)))
2493 (forward-char 1)) 2374 (forward-char 1))
2494 (when (and (not (eq replace-labels 'keep)) 2375 (when (looking-at lbl-re)
2495 (looking-at lbl-re))
2496 (setq ref (match-string 3)) 2376 (setq ref (match-string 3))
2497 (if replace-labels 2377 (cond ((numberp replace-labels)
2498 (progn 2378 ;; remove labels; use numbers for references when lines
2499 (delete-region (match-beginning 1) (match-end 1)) 2379 ;; are numbered, use labels otherwise
2500 (push (cons ref n) org-export-code-refs)) 2380 (delete-region (match-beginning 1) (match-end 1))
2501 (goto-char (match-beginning 2)) 2381 (push (cons ref (if (> n 0) n ref)) org-export-code-refs))
2502 (delete-region (match-beginning 2) (match-end 2)) 2382 ((eq replace-labels 'keep)
2503 (insert "(" ref ")") 2383 ;; don't remove labels; use numbers for references when
2504 (push (cons ref (concat "(" ref ")")) org-export-code-refs)) 2384 ;; lines are numbered, use labels otherwise
2385 (goto-char (match-beginning 2))
2386 (delete-region (match-beginning 2) (match-end 2))
2387 (insert "(" ref ")")
2388 (push (cons ref (if (> n 0) n (concat "(" ref ")")))
2389 org-export-code-refs))
2390 (t
2391 ;; don't remove labels and don't use numbers for
2392 ;; references
2393 (goto-char (match-beginning 2))
2394 (delete-region (match-beginning 2) (match-end 2))
2395 (insert "(" ref ")")
2396 (push (cons ref (concat "(" ref ")")) org-export-code-refs)))
2505 (when (eq backend 'html) 2397 (when (eq backend 'html)
2506 (save-excursion 2398 (save-excursion
2507 (beginning-of-line 1) 2399 (beginning-of-line 1)
@@ -2514,312 +2406,6 @@ Numbering lines works for all three major backends (html, latex, and ascii)."
2514 (newline) 2406 (newline)
2515 (buffer-string)))) 2407 (buffer-string))))
2516 2408
2517;;; ASCII export
2518
2519(defvar org-last-level nil) ; dynamically scoped variable
2520(defvar org-min-level nil) ; dynamically scoped variable
2521(defvar org-levels-open nil) ; dynamically scoped parameter
2522(defvar org-ascii-current-indentation nil) ; For communication
2523
2524;;;###autoload
2525(defun org-export-as-ascii (arg)
2526 "Export the outline as a pretty ASCII file.
2527If there is an active region, export only the region.
2528The prefix ARG specifies how many levels of the outline should become
2529underlined headlines. The default is 3."
2530 (interactive "P")
2531 (setq-default org-todo-line-regexp org-todo-line-regexp)
2532 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
2533 (org-infile-export-plist)))
2534 (region-p (org-region-active-p))
2535 (rbeg (and region-p (region-beginning)))
2536 (rend (and region-p (region-end)))
2537 (subtree-p
2538 (when region-p
2539 (save-excursion
2540 (goto-char rbeg)
2541 (and (org-at-heading-p)
2542 (>= (org-end-of-subtree t t) rend)))))
2543 (opt-plist (if subtree-p
2544 (org-export-add-subtree-options opt-plist rbeg)
2545 opt-plist))
2546 (custom-times org-display-custom-times)
2547 (org-ascii-current-indentation '(0 . 0))
2548 (level 0) line txt
2549 (umax nil)
2550 (umax-toc nil)
2551 (case-fold-search nil)
2552 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
2553 (filename (concat (file-name-as-directory
2554 (org-export-directory :ascii opt-plist))
2555 (file-name-sans-extension
2556 (or (and subtree-p
2557 (org-entry-get (region-beginning)
2558 "EXPORT_FILE_NAME" t))
2559 (file-name-nondirectory bfname)))
2560 ".txt"))
2561 (filename (if (equal (file-truename filename)
2562 (file-truename bfname))
2563 (concat filename ".txt")
2564 filename))
2565 (buffer (find-file-noselect filename))
2566 (org-levels-open (make-vector org-level-max nil))
2567 (odd org-odd-levels-only)
2568 (date (plist-get opt-plist :date))
2569 (author (plist-get opt-plist :author))
2570 (title (or (and subtree-p (org-export-get-title-from-subtree))
2571 (plist-get opt-plist :title)
2572 (and (not
2573 (plist-get opt-plist :skip-before-1st-heading))
2574 (org-export-grab-title-from-buffer))
2575 (file-name-sans-extension
2576 (file-name-nondirectory bfname))))
2577 (email (plist-get opt-plist :email))
2578 (language (plist-get opt-plist :language))
2579 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
2580; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
2581 (todo nil)
2582 (lang-words nil)
2583 (region
2584 (buffer-substring
2585 (if (org-region-active-p) (region-beginning) (point-min))
2586 (if (org-region-active-p) (region-end) (point-max))))
2587 (lines (org-split-string
2588 (org-export-preprocess-string
2589 region
2590 :for-ascii t
2591 :skip-before-1st-heading
2592 (plist-get opt-plist :skip-before-1st-heading)
2593 :drawers (plist-get opt-plist :drawers)
2594 :tags (plist-get opt-plist :tags)
2595 :priority (plist-get opt-plist :priority)
2596 :footnotes (plist-get opt-plist :footnotes)
2597 :timestamps (plist-get opt-plist :timestamps)
2598 :todo-keywords (plist-get opt-plist :todo-keywords)
2599 :verbatim-multiline t
2600 :select-tags (plist-get opt-plist :select-tags)
2601 :exclude-tags (plist-get opt-plist :exclude-tags)
2602 :archived-trees
2603 (plist-get opt-plist :archived-trees)
2604 :add-text (plist-get opt-plist :text))
2605 "\n"))
2606 thetoc have-headings first-heading-pos
2607 table-open table-buffer link desc)
2608 (let ((inhibit-read-only t))
2609 (org-unmodified
2610 (remove-text-properties (point-min) (point-max)
2611 '(:org-license-to-kill t))))
2612
2613 (setq org-min-level (org-get-min-level lines))
2614 (setq org-last-level org-min-level)
2615 (org-init-section-numbers)
2616
2617 (find-file-noselect filename)
2618
2619 (setq lang-words (or (assoc language org-export-language-setup)
2620 (assoc "en" org-export-language-setup)))
2621 (switch-to-buffer-other-window buffer)
2622 (erase-buffer)
2623 (fundamental-mode)
2624 ;; create local variables for all options, to make sure all called
2625 ;; functions get the correct information
2626 (mapc (lambda (x)
2627 (set (make-local-variable (nth 2 x))
2628 (plist-get opt-plist (car x))))
2629 org-export-plist-vars)
2630 (org-set-local 'org-odd-levels-only odd)
2631 (setq umax (if arg (prefix-numeric-value arg)
2632 org-export-headline-levels))
2633 (setq umax-toc (if (integerp org-export-with-toc)
2634 (min org-export-with-toc umax)
2635 umax))
2636
2637 ;; File header
2638 (if title (org-insert-centered title ?=))
2639 (insert "\n")
2640 (if (and (or author email)
2641 org-export-author-info)
2642 (insert (concat (nth 1 lang-words) ": " (or author "")
2643 (if email (concat " <" email ">") "")
2644 "\n")))
2645
2646 (cond
2647 ((and date (string-match "%" date))
2648 (setq date (format-time-string date)))
2649 (date)
2650 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
2651
2652 (if (and date org-export-time-stamp-file)
2653 (insert (concat (nth 2 lang-words) ": " date"\n")))
2654
2655 (insert "\n\n")
2656
2657 (if org-export-with-toc
2658 (progn
2659 (push (concat (nth 3 lang-words) "\n") thetoc)
2660 (push (concat (make-string (string-width (nth 3 lang-words)) ?=)
2661 "\n") thetoc)
2662 (mapc '(lambda (line)
2663 (if (string-match org-todo-line-regexp
2664 line)
2665 ;; This is a headline
2666 (progn
2667 (setq have-headings t)
2668 (setq level (- (match-end 1) (match-beginning 1))
2669 level (org-tr-level level)
2670 txt (match-string 3 line)
2671 todo
2672 (or (and org-export-mark-todo-in-toc
2673 (match-beginning 2)
2674 (not (member (match-string 2 line)
2675 org-done-keywords)))
2676 ; TODO, not DONE
2677 (and org-export-mark-todo-in-toc
2678 (= level umax-toc)
2679 (org-search-todo-below
2680 line lines level))))
2681 (setq txt (org-html-expand-for-ascii txt))
2682
2683 (while (string-match org-bracket-link-regexp txt)
2684 (setq txt
2685 (replace-match
2686 (match-string (if (match-end 2) 3 1) txt)
2687 t t txt)))
2688
2689 (if (and (memq org-export-with-tags '(not-in-toc nil))
2690 (string-match
2691 (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
2692 txt))
2693 (setq txt (replace-match "" t t txt)))
2694 (if (string-match quote-re0 txt)
2695 (setq txt (replace-match "" t t txt)))
2696
2697 (if org-export-with-section-numbers
2698 (setq txt (concat (org-section-number level)
2699 " " txt)))
2700 (if (<= level umax-toc)
2701 (progn
2702 (push
2703 (concat
2704 (make-string
2705 (* (max 0 (- level org-min-level)) 4) ?\ )
2706 (format (if todo "%s (*)\n" "%s\n") txt))
2707 thetoc)
2708 (setq org-last-level level))
2709 ))))
2710 lines)
2711 (setq thetoc (if have-headings (nreverse thetoc) nil))))
2712
2713 (org-init-section-numbers)
2714 (while (setq line (pop lines))
2715 ;; Remove the quoted HTML tags.
2716 (setq line (org-html-expand-for-ascii line))
2717 ;; Replace links with the description when possible
2718 (while (string-match org-bracket-link-regexp line)
2719 (setq link (match-string 1 line)
2720 desc (match-string (if (match-end 3) 3 1) line))
2721 (if (and (> (length link) 8)
2722 (equal (substring link 0 8) "coderef:"))
2723 (setq line (replace-match
2724 (format (org-export-get-coderef-format (substring link 8) desc)
2725 (cdr (assoc
2726 (substring link 8)
2727 org-export-code-refs)))
2728 t t line))
2729 (setq line (replace-match
2730 (if (match-end 3) "[\\3]" "[\\1]")
2731 t nil line))))
2732 (when custom-times
2733 (setq line (org-translate-time line)))
2734 (cond
2735 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
2736 ;; a Headline
2737 (setq first-heading-pos (or first-heading-pos (point)))
2738 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
2739 txt (match-string 2 line))
2740 (org-ascii-level-start level txt umax lines))
2741
2742 ((and org-export-with-tables
2743 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
2744 (if (not table-open)
2745 ;; New table starts
2746 (setq table-open t table-buffer nil))
2747 ;; Accumulate lines
2748 (setq table-buffer (cons line table-buffer))
2749 (when (or (not lines)
2750 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
2751 (car lines))))
2752 (setq table-open nil
2753 table-buffer (nreverse table-buffer))
2754 (insert (mapconcat
2755 (lambda (x)
2756 (org-fix-indentation x org-ascii-current-indentation))
2757 (org-format-table-ascii table-buffer)
2758 "\n") "\n")))
2759 (t
2760 (setq line (org-fix-indentation line org-ascii-current-indentation))
2761 ;; Remove forced line breaks
2762 (if (string-match "\\\\\\\\[ \t]*$" line)
2763 (setq line (replace-match "" t t line)))
2764 (if (and org-export-with-fixed-width
2765 (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line))
2766 (setq line (replace-match "\\1" nil nil line)))
2767 (insert line "\n"))))
2768
2769 (normal-mode)
2770
2771 ;; insert the table of contents
2772 (when thetoc
2773 (goto-char (point-min))
2774 (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
2775 (progn
2776 (goto-char (match-beginning 0))
2777 (replace-match ""))
2778 (goto-char first-heading-pos))
2779 (mapc 'insert thetoc)
2780 (or (looking-at "[ \t]*\n[ \t]*\n")
2781 (insert "\n\n")))
2782
2783 ;; Convert whitespace place holders
2784 (goto-char (point-min))
2785 (let (beg end)
2786 (while (setq beg (next-single-property-change (point) 'org-whitespace))
2787 (setq end (next-single-property-change beg 'org-whitespace))
2788 (goto-char beg)
2789 (delete-region beg end)
2790 (insert (make-string (- end beg) ?\ ))))
2791
2792 (save-buffer)
2793 ;; remove display and invisible chars
2794 (let (beg end)
2795 (goto-char (point-min))
2796 (while (setq beg (next-single-property-change (point) 'display))
2797 (setq end (next-single-property-change beg 'display))
2798 (delete-region beg end)
2799 (goto-char beg)
2800 (insert "=>"))
2801 (goto-char (point-min))
2802 (while (setq beg (next-single-property-change (point) 'org-cwidth))
2803 (setq end (next-single-property-change beg 'org-cwidth))
2804 (delete-region beg end)
2805 (goto-char beg)))
2806 (goto-char (point-min))))
2807
2808(defun org-export-ascii-preprocess ()
2809 "Do extra work for ASCII export"
2810 ;; Put quotes around verbatim text
2811 (goto-char (point-min))
2812 (while (re-search-forward org-verbatim-re nil t)
2813 (goto-char (match-end 2))
2814 (backward-delete-char 1) (insert "'")
2815 (goto-char (match-beginning 2))
2816 (delete-char 1) (insert "`")
2817 (goto-char (match-end 2)))
2818 (goto-char (point-min))
2819 ;; Remove target markers
2820 (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
2821 (replace-match "\\1\\2")))
2822
2823(defun org-search-todo-below (line lines level) 2409(defun org-search-todo-below (line lines level)
2824 "Search the subtree below LINE for any TODO entries." 2410 "Search the subtree below LINE for any TODO entries."
2825 (let ((rest (cdr (memq line lines))) 2411 (let ((rest (cdr (memq line lines)))
@@ -2837,52 +2423,6 @@ underlined headlines. The default is 3."
2837 (if (<= lv level) (throw 'exit nil)) 2423 (if (<= lv level) (throw 'exit nil))
2838 (if todo (throw 'exit t)))))))) 2424 (if todo (throw 'exit t))))))))
2839 2425
2840(defun org-html-expand-for-ascii (line)
2841 "Handle quoted HTML for ASCII export."
2842 (if org-export-html-expand
2843 (while (string-match "@<[^<>\n]*>" line)
2844 ;; We just remove the tags for now.
2845 (setq line (replace-match "" nil nil line))))
2846 line)
2847
2848(defun org-insert-centered (s &optional underline)
2849 "Insert the string S centered and underline it with character UNDERLINE."
2850 (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
2851 (insert (make-string ind ?\ ) s "\n")
2852 (if underline
2853 (insert (make-string ind ?\ )
2854 (make-string (string-width s) underline)
2855 "\n"))))
2856
2857(defun org-ascii-level-start (level title umax &optional lines)
2858 "Insert a new level in ASCII export."
2859 (let (char (n (- level umax 1)) (ind 0))
2860 (if (> level umax)
2861 (progn
2862 (insert (make-string (* 2 n) ?\ )
2863 (char-to-string (nth (% n (length org-export-ascii-bullets))
2864 org-export-ascii-bullets))
2865 " " title "\n")
2866 ;; find the indentation of the next non-empty line
2867 (catch 'stop
2868 (while lines
2869 (if (string-match "^\\* " (car lines)) (throw 'stop nil))
2870 (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
2871 (throw 'stop (setq ind (org-get-indentation (car lines)))))
2872 (pop lines)))
2873 (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind)))
2874 (if (or (not (equal (char-before) ?\n))
2875 (not (equal (char-before (1- (point))) ?\n)))
2876 (insert "\n"))
2877 (setq char (nth (- umax level) (reverse org-export-ascii-underline)))
2878 (unless org-export-with-tags
2879 (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
2880 (setq title (replace-match "" t t title))))
2881 (if org-export-with-section-numbers
2882 (setq title (concat (org-section-number level) " " title)))
2883 (insert title "\n" (make-string (string-width title) char) "\n")
2884 (setq org-ascii-current-indentation '(0 . 0)))))
2885
2886;;;###autoload 2426;;;###autoload
2887(defun org-export-visible (type arg) 2427(defun org-export-visible (type arg)
2888 "Create a copy of the visible part of the current buffer, and export it. 2428 "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
2895command." 2435command."
2896 (interactive 2436 (interactive
2897 (list (progn 2437 (list (progn
2898 (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]uffer with HTML [x]OXO [ ]keep buffer") 2438 (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]uffer with HTML [D]ocBook [x]OXO [ ]keep buffer")
2899 (read-char-exclusive)) 2439 (read-char-exclusive))
2900 current-prefix-arg)) 2440 current-prefix-arg))
2901 (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?x ?\ ))) 2441 (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?D ?x ?\ )))
2902 (error "Invalid export key")) 2442 (error "Invalid export key"))
2903 (let* ((binding (cdr (assoc type 2443 (let* ((binding (cdr (assoc type
2904 '((?a . org-export-as-ascii) 2444 '((?a . org-export-as-ascii)
2445 (?A . org-export-as-ascii-to-buffer)
2905 (?\C-a . org-export-as-ascii) 2446 (?\C-a . org-export-as-ascii)
2906 (?b . org-export-as-html-and-open) 2447 (?b . org-export-as-html-and-open)
2907 (?\C-b . org-export-as-html-and-open) 2448 (?\C-b . org-export-as-html-and-open)
2908 (?h . org-export-as-html) 2449 (?h . org-export-as-html)
2909 (?H . org-export-as-html-to-buffer) 2450 (?H . org-export-as-html-to-buffer)
2910 (?R . org-export-region-as-html) 2451 (?R . org-export-region-as-html)
2452 (?D . org-export-as-docbook)
2911 (?x . org-export-as-xoxo))))) 2453 (?x . org-export-as-xoxo)))))
2912 (keepp (equal type ?\ )) 2454 (keepp (equal type ?\ ))
2913 (file buffer-file-name) 2455 (file buffer-file-name)
@@ -2959,7 +2501,96 @@ command."
2959 (not (get-char-property s 'invisible)))) 2501 (not (get-char-property s 'invisible))))
2960 s)) 2502 s))
2961 2503
2962;;; HTML export 2504(defvar org-export-htmlized-org-css-url) ;; defined in org-html.el
2505
2506;;;###autoload
2507(defun org-export-as-org (arg &optional hidden ext-plist
2508 to-buffer body-only pub-dir)
2509 "Make a copy with not-exporting stuff removed.
2510The purpose of this function is to provide a way to export the source
2511Org file of a webpage in Org format, but with sensitive and/or irrelevant
2512stuff removed. This command will remove the following:
2513
2514- archived trees (if the variable `org-export-with-archived-trees' is nil)
2515- comment blocks and trees starting with the COMMENT keyword
2516- only trees that are consistent with `org-export-select-tags'
2517 and `org-export-exclude-tags'.
2518
2519The only arguments that will be used are EXT-PLIST and PUB-DIR,
2520all the others will be ignored (but are present so that the general
2521mechanism to call publishing functions will work).
2522
2523EXT-PLIST is a property list with external parameters overriding
2524org-mode's default settings, but still inferior to file-local
2525settings. When PUB-DIR is set, use this as the publishing
2526directory."
2527 (interactive "P")
2528 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
2529 ext-plist
2530 (org-infile-export-plist)))
2531 (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
2532 (filename (concat (file-name-as-directory
2533 (or pub-dir
2534 (org-export-directory :org opt-plist)))
2535 (file-name-sans-extension
2536 (file-name-nondirectory bfname))
2537 ".org"))
2538 (filename (and filename
2539 (if (equal (file-truename filename)
2540 (file-truename bfname))
2541 (concat (file-name-sans-extension filename)
2542 "-source."
2543 (file-name-extension filename))
2544 filename)))
2545 (backup-inhibited t)
2546 (buffer (find-file-noselect filename))
2547 (region (buffer-string)))
2548 (save-excursion
2549 (switch-to-buffer buffer)
2550 (erase-buffer)
2551 (insert region)
2552 (let ((org-inhibit-startup t)) (org-mode))
2553 (org-install-letbind)
2554
2555 ;; Get rid of archived trees
2556 (org-export-remove-archived-trees (plist-get opt-plist :archived-trees))
2557
2558 ;; Remove comment environment and comment subtrees
2559 (org-export-remove-comment-blocks-and-subtrees)
2560
2561 ;; Get rid of excluded trees
2562 (org-export-handle-export-tags (plist-get opt-plist :select-tags)
2563 (plist-get opt-plist :exclude-tags))
2564
2565 (when (or (plist-get opt-plist :plain-source)
2566 (not (or (plist-get opt-plist :plain-source)
2567 (plist-get opt-plist :htmlized-source))))
2568 ;; Either nothing special is requested (default call)
2569 ;; or the plain source is explicitly requested
2570 ;; so: save it
2571 (save-buffer))
2572 (when (plist-get opt-plist :htmlized-source)
2573 ;; Make the htmlized version
2574 (require 'htmlize)
2575 (require 'org-html)
2576 (font-lock-fontify-buffer)
2577 (let* ((htmlize-output-type 'css)
2578 (newbuf (htmlize-buffer)))
2579 (with-current-buffer newbuf
2580 (when org-export-htmlized-org-css-url
2581 (goto-char (point-min))
2582 (and (re-search-forward
2583 "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*"
2584 nil t)
2585 (replace-match
2586 (format
2587 "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
2588 org-export-htmlized-org-css-url)
2589 t t)))
2590 (write-file (concat filename ".html")))
2591 (kill-buffer newbuf)))
2592 (set-buffer-modified-p nil)
2593 (kill-buffer (current-buffer)))))
2963 2594
2964(defvar org-archive-location) ;; gets loaded with the org-archive require. 2595(defvar org-archive-location) ;; gets loaded with the org-archive require.
2965(defun org-get-current-options () 2596(defun org-get-current-options ()
@@ -2971,6 +2602,8 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
2971#+AUTHOR: %s 2602#+AUTHOR: %s
2972#+EMAIL: %s 2603#+EMAIL: %s
2973#+DATE: %s 2604#+DATE: %s
2605#+DESCRIPTION:
2606#+KEYWORDS:
2974#+LANGUAGE: %s 2607#+LANGUAGE: %s
2975#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s 2608#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s
2976#+OPTIONS: TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s 2609#+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."
3045 "org file:~/org/%s.org" 2678 "org file:~/org/%s.org"
3046 )) 2679 ))
3047 2680
3048(defun org-export-html-preprocess (parameters)
3049 ;; Convert LaTeX fragments to images
3050 (when (plist-get parameters :LaTeX-fragments)
3051 (org-format-latex
3052 (concat "ltxpng/" (file-name-sans-extension
3053 (file-name-nondirectory
3054 org-current-export-file)))
3055 org-current-export-dir nil "Creating LaTeX image %s"))
3056 (message "Exporting..."))
3057
3058;;;###autoload 2681;;;###autoload
3059(defun org-insert-export-options-template () 2682(defun org-insert-export-options-template ()
3060 "Insert into the buffer a template with information for exporting." 2683 "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."
3065 (setq s (substring s 0 (match-beginning 0)))) 2688 (setq s (substring s 0 (match-beginning 0))))
3066 (insert s))) 2689 (insert s)))
3067 2690
3068;;;###autoload
3069(defun org-export-as-html-and-open (arg)
3070 "Export the outline as HTML and immediately open it with a browser.
3071If there is an active region, export only the region.
3072The prefix ARG specifies how many levels of the outline should become
3073headlines. The default is 3. Lower levels will become bulleted lists."
3074 (interactive "P")
3075 (org-export-as-html arg 'hidden)
3076 (org-open-file buffer-file-name))
3077
3078;;;###autoload
3079(defun org-export-as-html-batch ()
3080 "Call `org-export-as-html', may be used in batch processing as
3081emacs --batch
3082 --load=$HOME/lib/emacs/org.el
3083 --eval \"(setq org-export-headline-levels 2)\"
3084 --visit=MyFile --funcall org-export-as-html-batch"
3085 (org-export-as-html org-export-headline-levels 'hidden))
3086
3087;;;###autoload
3088(defun org-export-as-html-to-buffer (arg)
3089 "Call `org-export-as-html` with output to a temporary buffer.
3090No file is created. The prefix ARG is passed through to `org-export-as-html'."
3091 (interactive "P")
3092 (org-export-as-html arg nil nil "*Org HTML Export*")
3093 (switch-to-buffer-other-window "*Org HTML Export*"))
3094
3095;;;###autoload
3096(defun org-replace-region-by-html (beg end)
3097 "Assume the current region has org-mode syntax, and convert it to HTML.
3098This can be used in any buffer. For example, you could write an
3099itemized list in org-mode syntax in an HTML buffer and then use this
3100command to convert it."
3101 (interactive "r")
3102 (let (reg html buf pop-up-frames)
3103 (save-window-excursion
3104 (if (org-mode-p)
3105 (setq html (org-export-region-as-html
3106 beg end t 'string))
3107 (setq reg (buffer-substring beg end)
3108 buf (get-buffer-create "*Org tmp*"))
3109 (with-current-buffer buf
3110 (erase-buffer)
3111 (insert reg)
3112 (org-mode)
3113 (setq html (org-export-region-as-html
3114 (point-min) (point-max) t 'string)))
3115 (kill-buffer buf)))
3116 (delete-region beg end)
3117 (insert html)))
3118
3119;;;###autoload
3120(defun org-export-region-as-html (beg end &optional body-only buffer)
3121 "Convert region from BEG to END in org-mode buffer to HTML.
3122If prefix arg BODY-ONLY is set, omit file header, footer, and table of
3123contents, and only produce the region of converted text, useful for
3124cut-and-paste operations.
3125If BUFFER is a buffer or a string, use/create that buffer as a target
3126of the converted HTML. If BUFFER is the symbol `string', return the
3127produced HTML as a string and leave not buffer behind. For example,
3128a Lisp program could call this function in the following way:
3129
3130 (setq html (org-export-region-as-html beg end t 'string))
3131
3132When called interactively, the output buffer is selected, and shown
3133in a window. A non-interactive call will only return the buffer."
3134 (interactive "r\nP")
3135 (when (interactive-p)
3136 (setq buffer "*Org HTML Export*"))
3137 (let ((transient-mark-mode t) (zmacs-regions t)
3138 ext-plist rtn)
3139 (setq ext-plist (plist-put ext-plist :ignore-subree-p t))
3140 (goto-char end)
3141 (set-mark (point)) ;; to activate the region
3142 (goto-char beg)
3143 (setq rtn (org-export-as-html
3144 nil nil ext-plist
3145 buffer body-only))
3146 (if (fboundp 'deactivate-mark) (deactivate-mark))
3147 (if (and (interactive-p) (bufferp rtn))
3148 (switch-to-buffer-other-window rtn)
3149 rtn)))
3150
3151(defvar html-table-tag nil) ; dynamically scoped into this.
3152(defvar org-par-open nil)
3153;;;###autoload
3154(defun org-export-as-html (arg &optional hidden ext-plist
3155 to-buffer body-only pub-dir)
3156 "Export the outline as a pretty HTML file.
3157If there is an active region, export only the region. The prefix
3158ARG specifies how many levels of the outline should become
3159headlines. The default is 3. Lower levels will become bulleted
3160lists. When HIDDEN is non-nil, don't display the HTML buffer.
3161EXT-PLIST is a property list with external parameters overriding
3162org-mode's default settings, but still inferior to file-local
3163settings. When TO-BUFFER is non-nil, create a buffer with that
3164name and export to that buffer. If TO-BUFFER is the symbol
3165`string', don't leave any buffer behind but just return the
3166resulting HTML as a string. When BODY-ONLY is set, don't produce
3167the file header and footer, simply return the content of
3168<body>...</body>, without even the body tags themselves. When
3169PUB-DIR is set, use this as the publishing directory."
3170 (interactive "P")
3171
3172 ;; Make sure we have a file name when we need it.
3173 (when (and (not (or to-buffer body-only))
3174 (not buffer-file-name))
3175 (if (buffer-base-buffer)
3176 (org-set-local 'buffer-file-name
3177 (with-current-buffer (buffer-base-buffer)
3178 buffer-file-name))
3179 (error "Need a file name to be able to export.")))
3180
3181 (message "Exporting...")
3182 (setq-default org-todo-line-regexp org-todo-line-regexp)
3183 (setq-default org-deadline-line-regexp org-deadline-line-regexp)
3184 (setq-default org-done-keywords org-done-keywords)
3185 (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
3186 (let* ((opt-plist
3187 (org-export-process-option-filters
3188 (org-combine-plists (org-default-export-plist)
3189 ext-plist
3190 (org-infile-export-plist))))
3191 (style (concat (if (plist-get opt-plist :style-include-default)
3192 org-export-html-style-default)
3193 (plist-get opt-plist :style)
3194 (plist-get opt-plist :style-extra)
3195 "\n" org-export-html-scripts))
3196 (html-extension (plist-get opt-plist :html-extension))
3197 (link-validate (plist-get opt-plist :link-validation-function))
3198 valid thetoc have-headings first-heading-pos
3199 (odd org-odd-levels-only)
3200 (region-p (org-region-active-p))
3201 (rbeg (and region-p (region-beginning)))
3202 (rend (and region-p (region-end)))
3203 (subtree-p
3204 (if (plist-get opt-plist :ignore-subree-p)
3205 nil
3206 (when region-p
3207 (save-excursion
3208 (goto-char rbeg)
3209 (and (org-at-heading-p)
3210 (>= (org-end-of-subtree t t) rend))))))
3211 (opt-plist (if subtree-p
3212 (org-export-add-subtree-options opt-plist rbeg)
3213 opt-plist))
3214 ;; The following two are dynamically scoped into other
3215 ;; routines below.
3216 (org-current-export-dir
3217 (or pub-dir (org-export-directory :html opt-plist)))
3218 (org-current-export-file buffer-file-name)
3219 (level 0) (line "") (origline "") txt todo
3220 (umax nil)
3221 (umax-toc nil)
3222 (filename (if to-buffer nil
3223 (expand-file-name
3224 (concat
3225 (file-name-sans-extension
3226 (or (and subtree-p
3227 (org-entry-get (region-beginning)
3228 "EXPORT_FILE_NAME" t))
3229 (file-name-nondirectory buffer-file-name)))
3230 "." html-extension)
3231 (file-name-as-directory
3232 (or pub-dir (org-export-directory :html opt-plist))))))
3233 (current-dir (if buffer-file-name
3234 (file-name-directory buffer-file-name)
3235 default-directory))
3236 (buffer (if to-buffer
3237 (cond
3238 ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
3239 (t (get-buffer-create to-buffer)))
3240 (find-file-noselect filename)))
3241 (org-levels-open (make-vector org-level-max nil))
3242 (date (plist-get opt-plist :date))
3243 (author (plist-get opt-plist :author))
3244 (title (or (and subtree-p (org-export-get-title-from-subtree))
3245 (plist-get opt-plist :title)
3246 (and (not
3247 (plist-get opt-plist :skip-before-1st-heading))
3248 (org-export-grab-title-from-buffer))
3249 (and buffer-file-name
3250 (file-name-sans-extension
3251 (file-name-nondirectory buffer-file-name)))
3252 "UNTITLED"))
3253 (html-table-tag (plist-get opt-plist :html-table-tag))
3254 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
3255 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
3256 (inquote nil)
3257 (infixed nil)
3258 (inverse nil)
3259 (in-local-list nil)
3260 (local-list-type nil)
3261 (local-list-indent nil)
3262 (llt org-plain-list-ordered-item-terminator)
3263 (email (plist-get opt-plist :email))
3264 (language (plist-get opt-plist :language))
3265 (lang-words nil)
3266 (head-count 0) cnt
3267 (start 0)
3268 (coding-system (and (boundp 'buffer-file-coding-system)
3269 buffer-file-coding-system))
3270 (coding-system-for-write (or org-export-html-coding-system
3271 coding-system))
3272 (save-buffer-coding-system (or org-export-html-coding-system
3273 coding-system))
3274 (charset (and coding-system-for-write
3275 (fboundp 'coding-system-get)
3276 (coding-system-get coding-system-for-write
3277 'mime-charset)))
3278 (region
3279 (buffer-substring
3280 (if region-p (region-beginning) (point-min))
3281 (if region-p (region-end) (point-max))))
3282 (lines
3283 (org-split-string
3284 (org-export-preprocess-string
3285 region
3286 :emph-multiline t
3287 :for-html t
3288 :skip-before-1st-heading
3289 (plist-get opt-plist :skip-before-1st-heading)
3290 :drawers (plist-get opt-plist :drawers)
3291 :todo-keywords (plist-get opt-plist :todo-keywords)
3292 :tags (plist-get opt-plist :tags)
3293 :priority (plist-get opt-plist :priority)
3294 :footnotes (plist-get opt-plist :footnotes)
3295 :timestamps (plist-get opt-plist :timestamps)
3296 :archived-trees
3297 (plist-get opt-plist :archived-trees)
3298 :select-tags (plist-get opt-plist :select-tags)
3299 :exclude-tags (plist-get opt-plist :exclude-tags)
3300 :add-text
3301 (plist-get opt-plist :text)
3302 :LaTeX-fragments
3303 (plist-get opt-plist :LaTeX-fragments))
3304 "[\r\n]"))
3305 table-open type
3306 table-buffer table-orig-buffer
3307 ind item-type starter didclose
3308 rpl path attr desc descp desc1 desc2 link
3309 snumber fnc item-tag
3310 footnotes footref-seen
3311 id-file
3312 )
3313
3314 (let ((inhibit-read-only t))
3315 (org-unmodified
3316 (remove-text-properties (point-min) (point-max)
3317 '(:org-license-to-kill t))))
3318
3319 (message "Exporting...")
3320
3321 (setq org-min-level (org-get-min-level lines))
3322 (setq org-last-level org-min-level)
3323 (org-init-section-numbers)
3324
3325 (cond
3326 ((and date (string-match "%" date))
3327 (setq date (format-time-string date)))
3328 (date)
3329 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
3330
3331 ;; Get the language-dependent settings
3332 (setq lang-words (or (assoc language org-export-language-setup)
3333 (assoc "en" org-export-language-setup)))
3334
3335 ;; Switch to the output buffer
3336 (set-buffer buffer)
3337 (let ((inhibit-read-only t)) (erase-buffer))
3338 (fundamental-mode)
3339
3340 (and (fboundp 'set-buffer-file-coding-system)
3341 (set-buffer-file-coding-system coding-system-for-write))
3342
3343 (let ((case-fold-search nil)
3344 (org-odd-levels-only odd))
3345 ;; create local variables for all options, to make sure all called
3346 ;; functions get the correct information
3347 (mapc (lambda (x)
3348 (set (make-local-variable (nth 2 x))
3349 (plist-get opt-plist (car x))))
3350 org-export-plist-vars)
3351 (setq umax (if arg (prefix-numeric-value arg)
3352 org-export-headline-levels))
3353 (setq umax-toc (if (integerp org-export-with-toc)
3354 (min org-export-with-toc umax)
3355 umax))
3356 (unless body-only
3357 ;; File header
3358 (insert (format
3359 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
3360 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
3361<html xmlns=\"http://www.w3.org/1999/xhtml\"
3362lang=\"%s\" xml:lang=\"%s\">
3363<head>
3364<title>%s</title>
3365<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
3366<meta name=\"generator\" content=\"Org-mode\"/>
3367<meta name=\"generated\" content=\"%s\"/>
3368<meta name=\"author\" content=\"%s\"/>
3369%s
3370</head><body>
3371"
3372 language language (org-html-expand title)
3373 (or charset "iso-8859-1") date author style))
3374
3375 (insert (or (plist-get opt-plist :preamble) ""))
3376
3377 (when (plist-get opt-plist :auto-preamble)
3378 (if title (insert (format org-export-html-title-format
3379 (org-html-expand title))))))
3380
3381 (if (and org-export-with-toc (not body-only))
3382 (progn
3383 (push (format "<h%d>%s</h%d>\n"
3384 org-export-html-toplevel-hlevel
3385 (nth 3 lang-words)
3386 org-export-html-toplevel-hlevel)
3387 thetoc)
3388 (push "<div id=\"text-table-of-contents\">\n" thetoc)
3389 (push "<ul>\n<li>" thetoc)
3390 (setq lines
3391 (mapcar '(lambda (line)
3392 (if (string-match org-todo-line-regexp line)
3393 ;; This is a headline
3394 (progn
3395 (setq have-headings t)
3396 (setq level (- (match-end 1) (match-beginning 1))
3397 level (org-tr-level level)
3398 txt (save-match-data
3399 (org-html-expand
3400 (org-export-cleanup-toc-line
3401 (match-string 3 line))))
3402 todo
3403 (or (and org-export-mark-todo-in-toc
3404 (match-beginning 2)
3405 (not (member (match-string 2 line)
3406 org-done-keywords)))
3407 ; TODO, not DONE
3408 (and org-export-mark-todo-in-toc
3409 (= level umax-toc)
3410 (org-search-todo-below
3411 line lines level))))
3412 (if (string-match
3413 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
3414 (setq txt (replace-match "&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
3415 (if (string-match quote-re0 txt)
3416 (setq txt (replace-match "" t t txt)))
3417 (setq snumber (org-section-number level))
3418 (if org-export-with-section-numbers
3419 (setq txt (concat snumber " " txt)))
3420 (if (<= level (max umax umax-toc))
3421 (setq head-count (+ head-count 1)))
3422 (if (<= level umax-toc)
3423 (progn
3424 (if (> level org-last-level)
3425 (progn
3426 (setq cnt (- level org-last-level))
3427 (while (>= (setq cnt (1- cnt)) 0)
3428 (push "\n<ul>\n<li>" thetoc))
3429 (push "\n" thetoc)))
3430 (if (< level org-last-level)
3431 (progn
3432 (setq cnt (- org-last-level level))
3433 (while (>= (setq cnt (1- cnt)) 0)
3434 (push "</li>\n</ul>" thetoc))
3435 (push "\n" thetoc)))
3436 ;; Check for targets
3437 (while (string-match org-any-target-regexp line)
3438 (setq line (replace-match
3439 (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
3440 t t line)))
3441 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
3442 (setq txt (replace-match "" t t txt)))
3443 (push
3444 (format
3445 (if todo
3446 "</li>\n<li><a href=\"#sec-%s\"><span class=\"todo\">%s</span></a>"
3447 "</li>\n<li><a href=\"#sec-%s\">%s</a>")
3448 snumber txt) thetoc)
3449
3450 (setq org-last-level level))
3451 )))
3452 line)
3453 lines))
3454 (while (> org-last-level (1- org-min-level))
3455 (setq org-last-level (1- org-last-level))
3456 (push "</li>\n</ul>\n" thetoc))
3457 (push "</div>\n" thetoc)
3458 (setq thetoc (if have-headings (nreverse thetoc) nil))))
3459
3460 (setq head-count 0)
3461 (org-init-section-numbers)
3462
3463 (org-open-par)
3464
3465 (while (setq line (pop lines) origline line)
3466 (catch 'nextline
3467
3468 ;; end of quote section?
3469 (when (and inquote (string-match "^\\*+ " line))
3470 (insert "</pre>\n")
3471 (setq inquote nil))
3472 ;; inside a quote section?
3473 (when inquote
3474 (insert (org-html-protect line) "\n")
3475 (throw 'nextline nil))
3476
3477 ;; Fixed-width, verbatim lines (examples)
3478 (when (and org-export-with-fixed-width
3479 (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
3480 (when (not infixed)
3481 (setq infixed t)
3482 (org-close-par-maybe)
3483 (insert "<pre class=\"example\">\n"))
3484 (insert (org-html-protect (match-string 3 line)) "\n")
3485 (when (or (not lines)
3486 (not (string-match "^[ \t]*\\(:.*\\)"
3487 (car lines))))
3488 (setq infixed nil)
3489 (insert "</pre>\n"))
3490 (throw 'nextline nil))
3491
3492 ;; Protected HTML
3493 (when (get-text-property 0 'org-protected line)
3494 (let (par)
3495 (when (re-search-backward
3496 "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
3497 (setq par (match-string 1))
3498 (replace-match "\\2\n"))
3499 (insert line "\n")
3500 (while (and lines
3501 (or (= (length (car lines)) 0)
3502 (get-text-property 0 'org-protected (car lines))))
3503 (insert (pop lines) "\n"))
3504 (and par (insert "<p>\n")))
3505 (throw 'nextline nil))
3506
3507 ;; Horizontal line
3508 (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
3509 (if org-par-open
3510 (insert "\n</p>\n<hr/>\n<p>\n")
3511 (insert "\n<hr/>\n"))
3512 (throw 'nextline nil))
3513
3514 ;; Blockquotes and verse
3515 (when (equal "ORG-BLOCKQUOTE-START" line)
3516 (org-close-par-maybe)
3517 (insert "<blockquote>\n<p>\n")
3518 (throw 'nextline nil))
3519 (when (equal "ORG-BLOCKQUOTE-END" line)
3520 (insert "</p>\n</blockquote>\n")
3521 (throw 'nextline nil))
3522 (when (equal "ORG-VERSE-START" line)
3523 (org-close-par-maybe)
3524 (insert "\n<p class=\"verse\">\n")
3525 (setq inverse t)
3526 (throw 'nextline nil))
3527 (when (equal "ORG-VERSE-END" line)
3528 (insert "</p>\n")
3529 (setq inverse nil)
3530 (throw 'nextline nil))
3531 (when inverse
3532 (let ((i (org-get-string-indentation line)))
3533 (if (> i 0)
3534 (setq line (concat (mapconcat 'identity
3535 (make-list (* 2 i) "\\nbsp") "")
3536 " " (org-trim line))))
3537 (setq line (concat line "\\\\"))))
3538
3539 ;; make targets to anchors
3540 (while (string-match "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line)
3541 (cond
3542 ((match-end 2)
3543 (setq line (replace-match
3544 (format
3545 "@<a name=\"%s\" id=\"%s\">@</a>"
3546 (org-solidify-link-text (match-string 1 line))
3547 (org-solidify-link-text (match-string 1 line)))
3548 t t line)))
3549 ((and org-export-with-toc (equal (string-to-char line) ?*))
3550 ;; FIXME: NOT DEPENDENT on TOC?????????????????????
3551 (setq line (replace-match
3552 (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
3553; (concat "@<i>" (match-string 1 line) "@</i> ")
3554 t t line)))
3555 (t
3556 (setq line (replace-match
3557 (concat "@<a name=\""
3558 (org-solidify-link-text (match-string 1 line))
3559 "\" class=\"target\">" (match-string 1 line) "@</a> ")
3560 t t line)))))
3561
3562 (setq line (org-html-handle-time-stamps line))
3563
3564 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
3565 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
3566 ;; Also handle sub_superscripts and checkboxes
3567 (or (string-match org-table-hline-regexp line)
3568 (setq line (org-html-expand line)))
3569
3570 ;; Format the links
3571 (setq start 0)
3572 (while (string-match org-bracket-link-analytic-regexp++ line start)
3573 (setq start (match-beginning 0))
3574 (setq path (save-match-data (org-link-unescape
3575 (match-string 3 line))))
3576 (setq type (cond
3577 ((match-end 2) (match-string 2 line))
3578 ((save-match-data
3579 (or (file-name-absolute-p path)
3580 (string-match "^\\.\\.?/" path)))
3581 "file")
3582 (t "internal")))
3583 (setq path (org-extract-attributes (org-link-unescape path)))
3584 (setq attr (get-text-property 0 'org-attributes path))
3585 (setq desc1 (if (match-end 5) (match-string 5 line))
3586 desc2 (if (match-end 2) (concat type ":" path) path)
3587 descp (and desc1 (not (equal desc1 desc2)))
3588 desc (or desc1 desc2))
3589 ;; Make an image out of the description if that is so wanted
3590 (when (and descp (org-file-image-p
3591 desc org-export-html-inline-image-extensions))
3592 (save-match-data
3593 (if (string-match "^file:" desc)
3594 (setq desc (substring desc (match-end 0)))))
3595 (setq desc (org-add-props
3596 (concat "<img src=\"" desc "\"/>")
3597 '(org-protected t))))
3598 ;; FIXME: do we need to unescape here somewhere?
3599 (cond
3600 ((equal type "internal")
3601 (setq rpl
3602 (concat
3603 "<a href=\"#"
3604 (org-solidify-link-text
3605 (save-match-data (org-link-unescape path)) nil)
3606 "\"" attr ">"
3607 (org-export-html-format-desc desc)
3608 "</a>")))
3609 ((and (equal type "id")
3610 (setq id-file (org-id-find-id-file path)))
3611 ;; This is an id: link to another file (if it was the same file,
3612 ;; it would have become an internal link...)
3613 (setq id-file (file-relative-name
3614 id-file (file-name-directory org-current-export-file)))
3615 (setq id-file (concat (file-name-sans-extension id-file)
3616 "." html-extension))
3617 (setq rpl (concat "<a href=\"" id-file "#" path "\""
3618 attr ">"
3619 (org-export-html-format-desc desc)
3620 "</a>")))
3621 ((member type '("http" "https"))
3622 ;; standard URL, just check if we need to inline an image
3623 (if (and (or (eq t org-export-html-inline-images)
3624 (and org-export-html-inline-images (not descp)))
3625 (org-file-image-p
3626 path org-export-html-inline-image-extensions))
3627 (setq rpl (org-export-html-format-image
3628 (concat type ":" path) org-par-open))
3629 (setq link (concat type ":" path))
3630 (setq rpl (concat "<a href=\""
3631 (org-export-html-format-href link)
3632 "\"" attr ">"
3633 (org-export-html-format-desc desc)
3634 "</a>"))))
3635 ((member type '("ftp" "mailto" "news"))
3636 ;; standard URL
3637 (setq link (concat type ":" path))
3638 (setq rpl (concat "<a href=\""
3639 (org-export-html-format-href link)
3640 "\"" attr ">"
3641 (org-export-html-format-desc desc)
3642 "</a>")))
3643
3644 ((string= type "coderef")
3645
3646 (setq rpl (format "<a href=\"#coderef-%s\" class=\"coderef\" onmouseover=\"CodeHighlightOn(this, 'coderef-%s');\" onmouseout=\"CodeHighlightOff(this, 'coderef-%s');\">%s</a>"
3647 path path path
3648 (format (org-export-get-coderef-format path (and descp desc))
3649 (cdr (assoc path org-export-code-refs))))))
3650
3651 ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
3652 ;; The link protocol has a function for format the link
3653 (setq rpl
3654 (save-match-data
3655 (funcall fnc (org-link-unescape path) desc1 'html))))
3656
3657 ((string= type "file")
3658 ;; FILE link
3659 (let* ((filename path)
3660 (abs-p (file-name-absolute-p filename))
3661 thefile file-is-image-p search)
3662 (save-match-data
3663 (if (string-match "::\\(.*\\)" filename)
3664 (setq search (match-string 1 filename)
3665 filename (replace-match "" t nil filename)))
3666 (setq valid
3667 (if (functionp link-validate)
3668 (funcall link-validate filename current-dir)
3669 t))
3670 (setq file-is-image-p
3671 (org-file-image-p
3672 filename org-export-html-inline-image-extensions))
3673 (setq thefile (if abs-p (expand-file-name filename) filename))
3674 (when (and org-export-html-link-org-files-as-html
3675 (string-match "\\.org$" thefile))
3676 (setq thefile (concat (substring thefile 0
3677 (match-beginning 0))
3678 "." html-extension))
3679 (if (and search
3680 ;; make sure this is can be used as target search
3681 (not (string-match "^[0-9]*$" search))
3682 (not (string-match "^\\*" search))
3683 (not (string-match "^/.*/$" search)))
3684 (setq thefile (concat thefile "#"
3685 (org-solidify-link-text
3686 (org-link-unescape search)))))
3687 (when (string-match "^file:" desc)
3688 (setq desc (replace-match "" t t desc))
3689 (if (string-match "\\.org$" desc)
3690 (setq desc (replace-match "" t t desc))))))
3691 (setq rpl (if (and file-is-image-p
3692 (or (eq t org-export-html-inline-images)
3693 (and org-export-html-inline-images
3694 (not descp))))
3695 (progn
3696 (message "image %s %s" thefile org-par-open)
3697 (org-export-html-format-image thefile org-par-open))
3698 (concat "<a href=\"" thefile "\"" attr ">"
3699 (org-export-html-format-desc desc)
3700 "</a>")))
3701 (if (not valid) (setq rpl desc))))
3702
3703 (t
3704 ;; just publish the path, as default
3705 (setq rpl (concat "<i>&lt;" type ":"
3706 (save-match-data (org-link-unescape path))
3707 "&gt;</i>"))))
3708 (setq line (replace-match rpl t t line)
3709 start (+ start (length rpl))))
3710
3711 ;; TODO items
3712 (if (and (string-match org-todo-line-regexp line)
3713 (match-beginning 2))
3714
3715 (setq line
3716 (concat (substring line 0 (match-beginning 2))
3717 "<span class=\""
3718 (if (member (match-string 2 line)
3719 org-done-keywords)
3720 "done" "todo")
3721 "\">" (match-string 2 line)
3722 "</span>" (substring line (match-end 2)))))
3723
3724 ;; Does this contain a reference to a footnote?
3725 (when org-export-with-footnotes
3726 (setq start 0)
3727 (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
3728 (if (get-text-property (match-beginning 2) 'org-protected line)
3729 (setq start (match-end 2))
3730 (let ((n (match-string 2 line)) extra a)
3731 (if (setq a (assoc n footref-seen))
3732 (progn
3733 (setcdr a (1+ (cdr a)))
3734 (setq extra (format ".%d" (cdr a))))
3735 (setq extra "")
3736 (push (cons n 1) footref-seen))
3737 (setq line
3738 (replace-match
3739 (format
3740 "%s<sup><a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a></sup>"
3741 (match-string 1 line) n extra n n)
3742 t t line))))))
3743
3744 (cond
3745 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
3746 ;; This is a headline
3747 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
3748 txt (match-string 2 line))
3749 (if (string-match quote-re0 txt)
3750 (setq txt (replace-match "" t t txt)))
3751 (if (<= level (max umax umax-toc))
3752 (setq head-count (+ head-count 1)))
3753 (when in-local-list
3754 ;; Close any local lists before inserting a new header line
3755 (while local-list-type
3756 (org-close-li (car local-list-type))
3757 (insert (format "</%sl>\n" (car local-list-type)))
3758 (pop local-list-type))
3759 (setq local-list-indent nil
3760 in-local-list nil))
3761 (setq first-heading-pos (or first-heading-pos (point)))
3762 (org-html-level-start level txt umax
3763 (and org-export-with-toc (<= level umax))
3764 head-count)
3765 ;; QUOTES
3766 (when (string-match quote-re line)
3767 (org-close-par-maybe)
3768 (insert "<pre>")
3769 (setq inquote t)))
3770
3771 ((and org-export-with-tables
3772 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
3773 (if (not table-open)
3774 ;; New table starts
3775 (setq table-open t table-buffer nil table-orig-buffer nil))
3776 ;; Accumulate lines
3777 (setq table-buffer (cons line table-buffer)
3778 table-orig-buffer (cons origline table-orig-buffer))
3779 (when (or (not lines)
3780 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
3781 (car lines))))
3782 (setq table-open nil
3783 table-buffer (nreverse table-buffer)
3784 table-orig-buffer (nreverse table-orig-buffer))
3785 (org-close-par-maybe)
3786 (insert (org-format-table-html table-buffer table-orig-buffer))))
3787 (t
3788 ;; Normal lines
3789 (when (string-match
3790 (cond
3791 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
3792 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
3793 ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
3794 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
3795 line)
3796 (setq ind (org-get-string-indentation line)
3797 item-type (if (match-beginning 4) "o" "u")
3798 starter (if (match-beginning 2)
3799 (substring (match-string 2 line) 0 -1))
3800 line (substring line (match-beginning 5))
3801 item-tag nil)
3802 (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line))
3803 (setq item-type "d"
3804 item-tag (match-string 1 line)
3805 line (substring line (match-end 0))))
3806 (when (and (not (equal item-type "d"))
3807 (not (string-match "[^ \t]" line)))
3808 ;; empty line. Pretend indentation is large.
3809 (setq ind (if org-empty-line-terminates-plain-lists
3810 0
3811 (1+ (or (car local-list-indent) 1)))))
3812 (setq didclose nil)
3813 (while (and in-local-list
3814 (or (and (= ind (car local-list-indent))
3815 (not starter))
3816 (< ind (car local-list-indent))))
3817 (setq didclose t)
3818 (org-close-li (car local-list-type))
3819 (insert (format "</%sl>\n" (car local-list-type)))
3820 (pop local-list-type) (pop local-list-indent)
3821 (setq in-local-list local-list-indent))
3822 (cond
3823 ((and starter
3824 (or (not in-local-list)
3825 (> ind (car local-list-indent))))
3826 ;; Start new (level of) list
3827 (org-close-par-maybe)
3828 (insert (cond
3829 ((equal item-type "u") "<ul>\n<li>\n")
3830 ((equal item-type "o") "<ol>\n<li>\n")
3831 ((equal item-type "d")
3832 (format "<dl>\n<dt>%s</dt><dd>\n" item-tag))))
3833 (push item-type local-list-type)
3834 (push ind local-list-indent)
3835 (setq in-local-list t))
3836 (starter
3837 ;; continue current list
3838 (org-close-li (car local-list-type))
3839 (insert (cond
3840 ((equal (car local-list-type) "d")
3841 (format "<dt>%s</dt><dd>\n" (or item-tag "???")))
3842 (t "<li>\n"))))
3843 (didclose
3844 ;; we did close a list, normal text follows: need <p>
3845 (org-open-par)))
3846 (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
3847 (setq line
3848 (replace-match
3849 (if (equal (match-string 1 line) "X")
3850 "<b>[X]</b>"
3851 "<b>[<span style=\"visibility:hidden;\">X</span>]</b>")
3852 t t line))))
3853
3854 ;; Empty lines start a new paragraph. If hand-formatted lists
3855 ;; are not fully interpreted, lines starting with "-", "+", "*"
3856 ;; also start a new paragraph.
3857 (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
3858
3859 ;; Is this the start of a footnote?
3860 (when org-export-with-footnotes
3861 (when (and (boundp 'footnote-section-tag-regexp)
3862 (string-match (concat "^" footnote-section-tag-regexp)
3863 line))
3864 ;; ignore this line
3865 (throw 'nextline nil))
3866 (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
3867 (org-close-par-maybe)
3868 (let ((n (match-string 1 line)))
3869 (setq org-par-open t
3870 line (replace-match
3871 (format "<p class=\"footnote\"><sup><a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a></sup>" n n n) t t line)))))
3872
3873 ;; Check if the line break needs to be conserved
3874 (cond
3875 ((string-match "\\\\\\\\[ \t]*$" line)
3876 (setq line (replace-match "<br/>" t t line)))
3877 (org-export-preserve-breaks
3878 (setq line (concat line "<br/>"))))
3879
3880 ;; Check if a paragraph should be started
3881 (let ((start 0))
3882 (while (and org-par-open
3883 (string-match "\\\\par\\>" line start))
3884 ;; Leave a space in the </p> so that the footnote matcher
3885 ;; does not see this.
3886 (if (not (get-text-property (match-beginning 0)
3887 'org-protected line))
3888 (setq line (replace-match "</p ><p >" t t line)))
3889 (setq start (match-end 0))))
3890
3891 (insert line "\n")))))
3892
3893 ;; Properly close all local lists and other lists
3894 (when inquote
3895 (insert "</pre>\n")
3896 (org-open-par))
3897 (when in-local-list
3898 ;; Close any local lists before inserting a new header line
3899 (while local-list-type
3900 (org-close-li (car local-list-type))
3901 (insert (format "</%sl>\n" (car local-list-type)))
3902 (pop local-list-type))
3903 (setq local-list-indent nil
3904 in-local-list nil))
3905 (org-html-level-start 1 nil umax
3906 (and org-export-with-toc (<= level umax))
3907 head-count)
3908 ;; the </div> to close the last text-... div.
3909 (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
3910
3911 (save-excursion
3912 (goto-char (point-min))
3913 (while (re-search-forward "<p class=\"footnote\">[^\000]*?\\(</p>\\|\\'\\)" nil t)
3914 (push (match-string 0) footnotes)
3915 (replace-match "" t t)))
3916 (when footnotes
3917 (insert (format org-export-html-footnotes-section
3918 (or (nth 4 lang-words) "Footnotes")
3919 (mapconcat 'identity (nreverse footnotes) "\n"))
3920 "\n"))
3921 (unless body-only
3922 (when (plist-get opt-plist :auto-postamble)
3923 (insert "<div id=\"postamble\">")
3924 (when (and org-export-author-info author)
3925 (insert "<p class=\"author\"> "
3926 (nth 1 lang-words) ": " author "\n")
3927 (when email
3928 (if (listp (split-string email ",+ *"))
3929 (mapc (lambda(e)
3930 (insert "<a href=\"mailto:" e "\">&lt;"
3931 e "&gt;</a>\n"))
3932 (split-string email ",+ *"))
3933 (insert "<a href=\"mailto:" email "\">&lt;"
3934 email "&gt;</a>\n")))
3935 (insert "</p>\n"))
3936 (when (and date org-export-time-stamp-file)
3937 (insert "<p class=\"date\"> "
3938 (nth 2 lang-words) ": "
3939 date "</p>\n"))
3940 (when org-export-creator-info
3941 (insert (format "<p>HTML generated by org-mode %s in emacs %s</p>\n"
3942 org-version emacs-major-version)))
3943 (insert "</div>"))
3944
3945 (if org-export-html-with-timestamp
3946 (insert org-export-html-html-helper-timestamp))
3947 (insert (or (plist-get opt-plist :postamble) ""))
3948 (insert "</body>\n</html>\n"))
3949
3950 (unless (plist-get opt-plist :buffer-will-be-killed)
3951 (normal-mode)
3952 (if (eq major-mode default-major-mode) (html-mode)))
3953
3954 ;; insert the table of contents
3955 (goto-char (point-min))
3956 (when thetoc
3957 (if (or (re-search-forward
3958 "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
3959 (re-search-forward
3960 "\\[TABLE-OF-CONTENTS\\]" nil t))
3961 (progn
3962 (goto-char (match-beginning 0))
3963 (replace-match ""))
3964 (goto-char first-heading-pos)
3965 (when (looking-at "\\s-*</p>")
3966 (goto-char (match-end 0))
3967 (insert "\n")))
3968 (insert "<div id=\"table-of-contents\">\n")
3969 (mapc 'insert thetoc)
3970 (insert "</div>\n"))
3971 ;; remove empty paragraphs and lists
3972 (goto-char (point-min))
3973 (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
3974 (replace-match ""))
3975 (goto-char (point-min))
3976 (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
3977 (replace-match ""))
3978 (goto-char (point-min))
3979 (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t)
3980 (replace-match ""))
3981 ;; Convert whitespace place holders
3982 (goto-char (point-min))
3983 (let (beg end n)
3984 (while (setq beg (next-single-property-change (point) 'org-whitespace))
3985 (setq n (get-text-property beg 'org-whitespace)
3986 end (next-single-property-change beg 'org-whitespace))
3987 (goto-char beg)
3988 (delete-region beg end)
3989 (insert (format "<span style=\"visibility:hidden;\">%s</span>"
3990 (make-string n ?x)))))
3991 (or to-buffer (save-buffer))
3992 (goto-char (point-min))
3993 (message "Exporting... done")
3994 (if (eq to-buffer 'string)
3995 (prog1 (buffer-substring (point-min) (point-max))
3996 (kill-buffer (current-buffer)))
3997 (current-buffer)))))
3998
3999(defun org-export-get-coderef-format (path desc)
4000 (save-match-data
4001 (if (and desc (string-match
4002 (regexp-quote (concat "(" path ")"))
4003 desc))
4004 (replace-match "%s" t t desc)
4005 "%s")))
4006
4007
4008(defun org-export-html-format-href (s)
4009 "Make sure the S is valid as a href reference in an XHTML document."
4010 (save-match-data
4011 (let ((start 0))
4012 (while (string-match "&" s start)
4013 (setq start (+ (match-beginning 0) 3)
4014 s (replace-match "&amp;" t t s)))))
4015 s)
4016
4017(defun org-export-html-format-desc (s)
4018 "Make sure the S is valid as a description in a link."
4019 (if (and s (not (get-text-property 1 'org-protected s)))
4020 (save-match-data
4021 (org-html-do-expand s))
4022 s))
4023
4024(defun org-export-html-format-image (src par-open)
4025 "Create image tag with source and attributes."
4026 (save-match-data
4027 (if (string-match "^ltxpng/" src)
4028 (format "<img src=\"%s\"/>" src)
4029 (let* ((caption (org-find-text-property-in-string 'org-caption src))
4030 (attr (org-find-text-property-in-string 'org-attributes src))
4031 (label (org-find-text-property-in-string 'org-label src)))
4032 (format "%s<div %sclass=\"figure\">
4033<p><img src=\"%s\"%s /></p>%s
4034</div>%s"
4035 (if org-par-open "</p>\n" "")
4036 (if label (format "id=\"%s\" " label) "")
4037 src
4038 (if (string-match "\\<alt=" (or attr ""))
4039 (concat " " attr )
4040 (concat " " attr " alt=\"" src "\""))
4041 (if caption (concat "\n<p>" caption "</p>") "")
4042 (if org-par-open "\n<p>" ""))))))
4043
4044
4045(defvar org-table-colgroup-info nil) 2691(defvar org-table-colgroup-info nil)
4046(defun org-format-table-ascii (lines)
4047 "Format a table for ascii export."
4048 (if (stringp lines)
4049 (setq lines (org-split-string lines "\n")))
4050 (if (not (string-match "^[ \t]*|" (car lines)))
4051 ;; Table made by table.el - test for spanning
4052 lines
4053
4054 ;; A normal org table
4055 ;; Get rid of hlines at beginning and end
4056 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
4057 (setq lines (nreverse lines))
4058 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
4059 (setq lines (nreverse lines))
4060 (when org-export-table-remove-special-lines
4061 ;; Check if the table has a marking column. If yes remove the
4062 ;; column and the special lines
4063 (setq lines (org-table-clean-before-export lines)))
4064 ;; Get rid of the vertical lines except for grouping
4065 (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
4066 rtn line vl1 start)
4067 (while (setq line (pop lines))
4068 (if (string-match org-table-hline-regexp line)
4069 (and (string-match "|\\(.*\\)|" line)
4070 (setq line (replace-match " \\1" t nil line)))
4071 (setq start 0 vl1 vl)
4072 (while (string-match "|" line start)
4073 (setq start (match-end 0))
4074 (or (pop vl1) (setq line (replace-match " " t t line)))))
4075 (push line rtn))
4076 (nreverse rtn))))
4077
4078(defun org-colgroup-info-to-vline-list (info)
4079 (let (vl new last)
4080 (while info
4081 (setq last new new (pop info))
4082 (if (or (memq last '(:end :startend))
4083 (memq new '(:start :startend)))
4084 (push t vl)
4085 (push nil vl)))
4086 (setq vl (nreverse vl))
4087 (and vl (setcar vl nil))
4088 vl))
4089
4090(defvar org-table-number-regexp) ; defined in org-table.el
4091(defun org-format-table-html (lines olines)
4092 "Find out which HTML converter to use and return the HTML code."
4093 (if (stringp lines)
4094 (setq lines (org-split-string lines "\n")))
4095 (if (string-match "^[ \t]*|" (car lines))
4096 ;; A normal org table
4097 (org-format-org-table-html lines)
4098 ;; Table made by table.el - test for spanning
4099 (let* ((hlines (delq nil (mapcar
4100 (lambda (x)
4101 (if (string-match "^[ \t]*\\+-" x) x
4102 nil))
4103 lines)))
4104 (first (car hlines))
4105 (ll (and (string-match "\\S-+" first)
4106 (match-string 0 first)))
4107 (re (concat "^[ \t]*" (regexp-quote ll)))
4108 (spanning (delq nil (mapcar (lambda (x) (not (string-match re x)))
4109 hlines))))
4110 (if (and (not spanning)
4111 (not org-export-prefer-native-exporter-for-tables))
4112 ;; We can use my own converter with HTML conversions
4113 (org-format-table-table-html lines)
4114 ;; Need to use the code generator in table.el, with the original text.
4115 (org-format-table-table-html-using-table-generate-source olines)))))
4116
4117(defvar org-table-number-fraction) ; defined in org-table.el
4118(defun org-format-org-table-html (lines &optional splice)
4119 "Format a table into HTML."
4120 (require 'org-table)
4121 ;; Get rid of hlines at beginning and end
4122 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
4123 (setq lines (nreverse lines))
4124 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
4125 (setq lines (nreverse lines))
4126 (when org-export-table-remove-special-lines
4127 ;; Check if the table has a marking column. If yes remove the
4128 ;; column and the special lines
4129 (setq lines (org-table-clean-before-export lines)))
4130
4131 (let ((caption (or (get-text-property 0 'org-caption (car lines))
4132 (get-text-property (or (next-single-property-change
4133 0 'org-caption (car lines))
4134 0)
4135 'org-caption (car lines))))
4136 (head (and org-export-highlight-first-table-line
4137 (delq nil (mapcar
4138 (lambda (x) (string-match "^[ \t]*|-" x))
4139 (cdr lines)))))
4140
4141 (nlines 0) fnum i
4142 tbopen line fields html gr colgropen)
4143 (if splice (setq head nil))
4144 (unless splice (push (if head "<thead>" "<tbody>") html))
4145 (setq tbopen t)
4146 (while (setq line (pop lines))
4147 (catch 'next-line
4148 (if (string-match "^[ \t]*|-" line)
4149 (progn
4150 (unless splice
4151 (push (if head "</thead>" "</tbody>") html)
4152 (if lines (push "<tbody>" html) (setq tbopen nil)))
4153 (setq head nil) ;; head ends here, first time around
4154 ;; ignore this line
4155 (throw 'next-line t)))
4156 ;; Break the line into fields
4157 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
4158 (unless fnum (setq fnum (make-vector (length fields) 0)))
4159 (setq nlines (1+ nlines) i -1)
4160 (push (concat "<tr>"
4161 (mapconcat
4162 (lambda (x)
4163 (setq i (1+ i))
4164 (if (and (< i nlines)
4165 (string-match org-table-number-regexp x))
4166 (incf (aref fnum i)))
4167 (if head
4168 (concat (car org-export-table-header-tags) x
4169 (cdr org-export-table-header-tags))
4170 (concat (car org-export-table-data-tags) x
4171 (cdr org-export-table-data-tags))))
4172 fields "")
4173 "</tr>")
4174 html)))
4175 (unless splice (if tbopen (push "</tbody>" html)))
4176 (unless splice (push "</table>\n" html))
4177 (setq html (nreverse html))
4178 (unless splice
4179 ;; Put in col tags with the alignment (unfortunately often ignored...)
4180 (push (mapconcat
4181 (lambda (x)
4182 (setq gr (pop org-table-colgroup-info))
4183 (format "%s<col align=\"%s\"></col>%s"
4184 (if (memq gr '(:start :startend))
4185 (prog1
4186 (if colgropen "</colgroup>\n<colgroup>" "<colgroup>")
4187 (setq colgropen t))
4188 "")
4189 (if (> (/ (float x) nlines) org-table-number-fraction)
4190 "right" "left")
4191 (if (memq gr '(:end :startend))
4192 (progn (setq colgropen nil) "</colgroup>")
4193 "")))
4194 fnum "")
4195 html)
4196 (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html)))))
4197 (if caption (push (format "<caption>%s</caption>" caption) html))
4198 (push html-table-tag html))
4199 (concat (mapconcat 'identity html "\n") "\n")))
4200 2692
4201(defun org-table-clean-before-export (lines &optional maybe-quoted) 2693(defun org-table-clean-before-export (lines &optional maybe-quoted)
4202 "Check if the table has a marking column. 2694 "Check if the table has a marking column.
@@ -4250,165 +2742,6 @@ If yes remove the column and the special lines."
4250 (replace-match "\\1|" t nil x)))) 2742 (replace-match "\\1|" t nil x))))
4251 lines)))) 2743 lines))))
4252 2744
4253(defun org-format-table-table-html (lines)
4254 "Format a table generated by table.el into HTML.
4255This conversion does *not* use `table-generate-source' from table.el.
4256This has the advantage that Org-mode's HTML conversions can be used.
4257But it has the disadvantage, that no cell- or row-spanning is allowed."
4258 (let (line field-buffer
4259 (head org-export-highlight-first-table-line)
4260 fields html empty)
4261 (setq html (concat html-table-tag "\n"))
4262 (while (setq line (pop lines))
4263 (setq empty "&nbsp;")
4264 (catch 'next-line
4265 (if (string-match "^[ \t]*\\+-" line)
4266 (progn
4267 (if field-buffer
4268 (progn
4269 (setq
4270 html
4271 (concat
4272 html
4273 "<tr>"
4274 (mapconcat
4275 (lambda (x)
4276 (if (equal x "") (setq x empty))
4277 (if head
4278 (concat (car org-export-table-header-tags) x
4279 (cdr org-export-table-header-tags))
4280 (concat (car org-export-table-data-tags) x
4281 (cdr org-export-table-data-tags))))
4282 field-buffer "\n")
4283 "</tr>\n"))
4284 (setq head nil)
4285 (setq field-buffer nil)))
4286 ;; Ignore this line
4287 (throw 'next-line t)))
4288 ;; Break the line into fields and store the fields
4289 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
4290 (if field-buffer
4291 (setq field-buffer (mapcar
4292 (lambda (x)
4293 (concat x "<br/>" (pop fields)))
4294 field-buffer))
4295 (setq field-buffer fields))))
4296 (setq html (concat html "</table>\n"))
4297 html))
4298
4299(defun org-format-table-table-html-using-table-generate-source (lines)
4300 "Format a table into html, using `table-generate-source' from table.el.
4301This has the advantage that cell- or row-spanning is allowed.
4302But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
4303 (require 'table)
4304 (with-current-buffer (get-buffer-create " org-tmp1 ")
4305 (erase-buffer)
4306 (insert (mapconcat 'identity lines "\n"))
4307 (goto-char (point-min))
4308 (if (not (re-search-forward "|[^+]" nil t))
4309 (error "Error processing table"))
4310 (table-recognize-table)
4311 (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
4312 (table-generate-source 'html " org-tmp2 ")
4313 (set-buffer " org-tmp2 ")
4314 (buffer-substring (point-min) (point-max))))
4315
4316(defun org-export-splice-style (style extra)
4317 "Splice EXTRA into STYLE, just before \"</style>\"."
4318 (if (and (stringp extra)
4319 (string-match "\\S-" extra)
4320 (string-match "</style>" style))
4321 (concat (substring style 0 (match-beginning 0))
4322 "\n" extra "\n"
4323 (substring style (match-beginning 0)))
4324 style))
4325
4326(defun org-html-handle-time-stamps (s)
4327 "Format time stamps in string S, or remove them."
4328 (catch 'exit
4329 (let (r b)
4330 (while (string-match org-maybe-keyword-time-regexp s)
4331 (or b (setq b (substring s 0 (match-beginning 0))))
4332 (setq r (concat
4333 r (substring s 0 (match-beginning 0))
4334 (if (match-end 1)
4335 (format "@<span class=\"timestamp-kwd\">%s @</span>"
4336 (match-string 1 s)))
4337 (format " @<span class=\"timestamp\">%s@</span>"
4338 (substring
4339 (org-translate-time (match-string 3 s)) 1 -1)))
4340 s (substring s (match-end 0))))
4341 ;; Line break if line started and ended with time stamp stuff
4342 (if (not r)
4343 s
4344 (setq r (concat r s))
4345 (unless (string-match "\\S-" (concat b s))
4346 (setq r (concat r "@<br/>")))
4347 r))))
4348
4349(defun org-export-htmlize-region-for-paste (beg end)
4350 "Convert the region to HTML, using htmlize.el.
4351This is much like `htmlize-region-for-paste', only that it uses
4352the settings define in the org-... variables."
4353 (let* ((htmlize-output-type org-export-htmlize-output-type)
4354 (htmlize-css-name-prefix org-export-htmlize-css-font-prefix)
4355 (htmlbuf (htmlize-region beg end)))
4356 (unwind-protect
4357 (with-current-buffer htmlbuf
4358 (buffer-substring (plist-get htmlize-buffer-places 'content-start)
4359 (plist-get htmlize-buffer-places 'content-end)))
4360 (kill-buffer htmlbuf))))
4361
4362;;;###autoload
4363(defun org-export-htmlize-generate-css ()
4364 "Create the CSS for all font definitions in the current Emacs session.
4365Use this to create face definitions in your CSS style file that can then
4366be used by code snippets transformed by htmlize.
4367This command just produces a buffer that contains class definitions for all
4368faces used in the current Emacs session. You can copy and paste the ones you
4369need into your CSS file.
4370
4371If you then set `org-export-htmlize-output-type' to `css', calls to
4372the function `org-export-htmlize-region-for-paste' will produce code
4373that uses these same face definitions."
4374 (interactive)
4375 (require 'htmlize)
4376 (and (get-buffer "*html*") (kill-buffer "*html*"))
4377 (with-temp-buffer
4378 (let ((fl (face-list))
4379 (htmlize-css-name-prefix "org-")
4380 (htmlize-output-type 'css)
4381 f i)
4382 (while (setq f (pop fl)
4383 i (and f (face-attribute f :inherit)))
4384 (when (and (symbolp f) (or (not i) (not (listp i))))
4385 (insert (org-add-props (copy-sequence "1") nil 'face f))))
4386 (htmlize-region (point-min) (point-max))))
4387 (switch-to-buffer "*html*")
4388 (goto-char (point-min))
4389 (if (re-search-forward "<style" nil t)
4390 (delete-region (point-min) (match-beginning 0)))
4391 (if (re-search-forward "</style>" nil t)
4392 (delete-region (1+ (match-end 0)) (point-max)))
4393 (beginning-of-line 1)
4394 (if (looking-at " +") (replace-match ""))
4395 (goto-char (point-min)))
4396
4397(defun org-html-protect (s)
4398 ;; convert & to &amp;, < to &lt; and > to &gt;
4399 (let ((start 0))
4400 (while (string-match "&" s start)
4401 (setq s (replace-match "&amp;" t t s)
4402 start (1+ (match-beginning 0))))
4403 (while (string-match "<" s)
4404 (setq s (replace-match "&lt;" t t s)))
4405 (while (string-match ">" s)
4406 (setq s (replace-match "&gt;" t t s)))
4407; (while (string-match "\"" s)
4408; (setq s (replace-match "&quot;" t t s)))
4409 )
4410 s)
4411
4412(defun org-export-cleanup-toc-line (s) 2745(defun org-export-cleanup-toc-line (s)
4413 "Remove tags and timestamps from lines going into the toc." 2746 "Remove tags and timestamps from lines going into the toc."
4414 (when (memq org-export-with-tags '(not-in-toc nil)) 2747 (when (memq org-export-with-tags '(not-in-toc nil))
@@ -4422,47 +2755,6 @@ that uses these same face definitions."
4422 t t s))) 2755 t t s)))
4423 s) 2756 s)
4424 2757
4425(defun org-html-expand (string)
4426 "Prepare STRING for HTML export. Applies all active conversions.
4427If there are links in the string, don't modify these."
4428 (let* ((re (concat org-bracket-link-regexp "\\|"
4429 (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$")))
4430 m s l res)
4431 (while (setq m (string-match re string))
4432 (setq s (substring string 0 m)
4433 l (match-string 0 string)
4434 string (substring string (match-end 0)))
4435 (push (org-html-do-expand s) res)
4436 (push l res))
4437 (push (org-html-do-expand string) res)
4438 (apply 'concat (nreverse res))))
4439
4440(defun org-html-do-expand (s)
4441 "Apply all active conversions to translate special ASCII to HTML."
4442 (setq s (org-html-protect s))
4443 (if org-export-html-expand
4444 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
4445 (setq s (replace-match "<\\1>" t nil s))))
4446 (if org-export-with-emphasize
4447 (setq s (org-export-html-convert-emphasize s)))
4448 (if org-export-with-special-strings
4449 (setq s (org-export-html-convert-special-strings s)))
4450 (if org-export-with-sub-superscripts
4451 (setq s (org-export-html-convert-sub-super s)))
4452 (if org-export-with-TeX-macros
4453 (let ((start 0) wd ass)
4454 (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?"
4455 s start))
4456 (if (get-text-property (match-beginning 0) 'org-protected s)
4457 (setq start (match-end 0))
4458 (setq wd (match-string 1 s))
4459 (if (setq ass (assoc wd org-html-entities))
4460 (setq s (replace-match (or (cdr ass)
4461 (concat "&" (car ass) ";"))
4462 t t s))
4463 (setq start (+ start (length wd))))))))
4464 s)
4465
4466(defun org-create-multibrace-regexp (left right n) 2758(defun org-create-multibrace-regexp (left right n)
4467 "Create a regular expression which will match a balanced sexp. 2759 "Create a regular expression which will match a balanced sexp.
4468Opening delimiter is LEFT, and closing delimiter is RIGHT, both given 2760Opening delimiter is LEFT, and closing delimiter is RIGHT, both given
@@ -4471,7 +2763,7 @@ The regexp returned will match the entire expression including the
4471delimiters. It will also define a single group which contains the 2763delimiters. It will also define a single group which contains the
4472match except for the outermost delimiters. The maximum depth of 2764match except for the outermost delimiters. The maximum depth of
4473stacked delimiters is N. Escaping delimiters is not possible." 2765stacked delimiters is N. Escaping delimiters is not possible."
4474 (let* ((nothing (concat "[^" "\\" left "\\" right "]*?")) 2766 (let* ((nothing (concat "[^" left right "]*?"))
4475 (or "\\|") 2767 (or "\\|")
4476 (re nothing) 2768 (re nothing)
4477 (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) 2769 (next (concat "\\(?:" nothing left nothing right "\\)+" nothing)))
@@ -4498,643 +2790,29 @@ stacked delimiters is N. Escaping delimiters is not possible."
4498 "\\)") 2790 "\\)")
4499 "The regular expression matching a sub- or superscript, forcing braces.") 2791 "The regular expression matching a sub- or superscript, forcing braces.")
4500 2792
4501(defconst org-export-html-special-string-regexps
4502 '(("\\\\-" . "&shy;")
4503 ("---\\([^-]\\)" . "&mdash;\\1")
4504 ("--\\([^-]\\)" . "&ndash;\\1")
4505 ("\\.\\.\\." . "&hellip;"))
4506 "Regular expressions for special string conversion.")
4507
4508(defun org-export-html-convert-special-strings (string)
4509 "Convert special characters in STRING to HTML."
4510 (let ((all org-export-html-special-string-regexps)
4511 e a re rpl start)
4512 (while (setq a (pop all))
4513 (setq re (car a) rpl (cdr a) start 0)
4514 (while (string-match re string start)
4515 (if (get-text-property (match-beginning 0) 'org-protected string)
4516 (setq start (match-end 0))
4517 (setq string (replace-match rpl t nil string)))))
4518 string))
4519
4520(defun org-export-html-convert-sub-super (string)
4521 "Convert sub- and superscripts in STRING to HTML."
4522 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
4523 (while (string-match org-match-substring-regexp string s)
4524 (cond
4525 ((and requireb (match-end 8)) (setq s (match-end 2)))
4526 ((get-text-property (match-beginning 2) 'org-protected string)
4527 (setq s (match-end 2)))
4528 (t
4529 (setq s (match-end 1)
4530 key (if (string= (match-string 2 string) "_") "sub" "sup")
4531 c (or (match-string 8 string)
4532 (match-string 6 string)
4533 (match-string 5 string))
4534 string (replace-match
4535 (concat (match-string 1 string)
4536 "<" key ">" c "</" key ">")
4537 t t string)))))
4538 (while (string-match "\\\\\\([_^]\\)" string)
4539 (setq string (replace-match (match-string 1 string) t t string)))
4540 string))
4541
4542(defun org-export-html-convert-emphasize (string)
4543 "Apply emphasis."
4544 (let ((s 0) rpl)
4545 (while (string-match org-emph-re string s)
4546 (if (not (equal
4547 (substring string (match-beginning 3) (1+ (match-beginning 3)))
4548 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
4549 (setq s (match-beginning 0)
4550 rpl
4551 (concat
4552 (match-string 1 string)
4553 (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
4554 (match-string 4 string)
4555 (nth 3 (assoc (match-string 3 string)
4556 org-emphasis-alist))
4557 (match-string 5 string))
4558 string (replace-match rpl t t string)
4559 s (+ s (- (length rpl) 2)))
4560 (setq s (1+ s))))
4561 string))
4562
4563(defun org-open-par ()
4564 "Insert <p>, but first close previous paragraph if any."
4565 (org-close-par-maybe)
4566 (insert "\n<p>")
4567 (setq org-par-open t))
4568(defun org-close-par-maybe ()
4569 "Close paragraph if there is one open."
4570 (when org-par-open
4571 (insert "</p>")
4572 (setq org-par-open nil)))
4573(defun org-close-li (&optional type)
4574 "Close <li> if necessary."
4575 (org-close-par-maybe)
4576 (insert (if (equal type "d") "</dd>\n" "</li>\n")))
4577
4578(defvar body-only) ; dynamically scoped into this.
4579(defun org-html-level-start (level title umax with-toc head-count)
4580 "Insert a new level in HTML export.
4581When TITLE is nil, just close all open levels."
4582 (org-close-par-maybe)
4583 (let* ((target (and title (org-get-text-property-any 0 'target title)))
4584 (extra-targets
4585 (mapconcat (lambda (x)
4586 (format "<a name=\"%s\" id=\"%s\"></a>"
4587 x x))
4588 (cdr (assoc target org-export-target-aliases))
4589 ""))
4590 (l org-level-max)
4591 snumber)
4592 (while (>= l level)
4593 (if (aref org-levels-open (1- l))
4594 (progn
4595 (org-html-level-close l umax)
4596 (aset org-levels-open (1- l) nil)))
4597 (setq l (1- l)))
4598 (when title
4599 ;; If title is nil, this means this function is called to close
4600 ;; all levels, so the rest is done only if title is given
4601 (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
4602 (setq title (replace-match
4603 (if org-export-with-tags
4604 (save-match-data
4605 (concat
4606 "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
4607 (mapconcat 'identity (org-split-string
4608 (match-string 1 title) ":")
4609 "&nbsp;")
4610 "</span>"))
4611 "")
4612 t t title)))
4613 (if (> level umax)
4614 (progn
4615 (if (aref org-levels-open (1- level))
4616 (progn
4617 (org-close-li)
4618 (if target
4619 (insert (format "<li id=\"%s\">" target) extra-targets title "<br/>\n")
4620 (insert "<li>" title "<br/>\n")))
4621 (aset org-levels-open (1- level) t)
4622 (org-close-par-maybe)
4623 (if target
4624 (insert (format "<ul>\n<li id=\"%s\">" target)
4625 extra-targets title "<br/>\n")
4626 (insert "<ul>\n<li>" title "<br/>\n"))))
4627 (aset org-levels-open (1- level) t)
4628 (setq snumber (org-section-number level))
4629 (if (and org-export-with-section-numbers (not body-only))
4630 (setq title (concat snumber " " title)))
4631 (setq level (+ level org-export-html-toplevel-hlevel -1))
4632 (unless (= head-count 1) (insert "\n</div>\n"))
4633 (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"
4634 snumber level level snumber extra-targets title level snumber))
4635 (org-open-par)))))
4636 2793
4637(defun org-get-text-property-any (pos prop &optional object) 2794(defun org-get-text-property-any (pos prop &optional object)
4638 (or (get-text-property pos prop object) 2795 (or (get-text-property pos prop object)
4639 (and (setq pos (next-single-property-change pos prop object)) 2796 (and (setq pos (next-single-property-change pos prop object))
4640 (get-text-property pos prop object)))) 2797 (get-text-property pos prop object))))
4641 2798
4642(defun org-html-level-close (level max-outline-level) 2799(defun org-export-get-coderef-format (path desc)
4643 "Terminate one level in HTML export." 2800 (save-match-data
4644 (if (<= level max-outline-level) 2801 (if (and desc (string-match
4645 (insert "</div>\n") 2802 (regexp-quote (concat "(" path ")"))
4646 (org-close-li) 2803 desc))
4647 (insert "</ul>\n"))) 2804 (replace-match "%s" t t desc)
4648 2805 (or desc "%s"))))
4649;;; iCalendar export 2806
4650 2807(defun org-export-push-to-kill-ring (format)
4651;;;###autoload 2808 "Push buffer content to kill ring.
4652(defun org-export-icalendar-this-file () 2809The depends on the variable `org-export-copy-to-kill'."
4653 "Export current file as an iCalendar file. 2810 (when org-export-copy-to-kill-ring
4654The iCalendar file will be located in the same directory as the Org-mode 2811 (org-kill-new (buffer-string))
4655file, but with extension `.ics'." 2812 (when (fboundp 'x-set-selection)
4656 (interactive) 2813 (ignore-errors (x-set-selection 'PRIMARY (buffer-string)))
4657 (org-export-icalendar nil buffer-file-name)) 2814 (ignore-errors (x-set-selection 'CLIPBOARD (buffer-string))))
4658 2815 (message "%s export done, pushed to kill ring and clipboard" format)))
4659;;;###autoload
4660(defun org-export-icalendar-all-agenda-files ()
4661 "Export all files in `org-agenda-files' to iCalendar .ics files.
4662Each iCalendar file will be located in the same directory as the Org-mode
4663file, but with extension `.ics'."
4664 (interactive)
4665 (apply 'org-export-icalendar nil (org-agenda-files t)))
4666
4667;;;###autoload
4668(defun org-export-icalendar-combine-agenda-files ()
4669 "Export all files in `org-agenda-files' to a single combined iCalendar file.
4670The file is stored under the name `org-combined-agenda-icalendar-file'."
4671 (interactive)
4672 (apply 'org-export-icalendar t (org-agenda-files t)))
4673
4674(defun org-export-icalendar (combine &rest files)
4675 "Create iCalendar files for all elements of FILES.
4676If COMBINE is non-nil, combine all calendar entries into a single large
4677file and store it under the name `org-combined-agenda-icalendar-file'."
4678 (save-excursion
4679 (org-prepare-agenda-buffers files)
4680 (let* ((dir (org-export-directory
4681 :ical (list :publishing-directory
4682 org-export-publishing-directory)))
4683 file ical-file ical-buffer category started org-agenda-new-buffers)
4684 (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
4685 (when combine
4686 (setq ical-file
4687 (if (file-name-absolute-p org-combined-agenda-icalendar-file)
4688 org-combined-agenda-icalendar-file
4689 (expand-file-name org-combined-agenda-icalendar-file dir))
4690 ical-buffer (org-get-agenda-file-buffer ical-file))
4691 (set-buffer ical-buffer) (erase-buffer))
4692 (while (setq file (pop files))
4693 (catch 'nextfile
4694 (org-check-agenda-file file)
4695 (set-buffer (org-get-agenda-file-buffer file))
4696 (unless combine
4697 (setq ical-file (concat (file-name-as-directory dir)
4698 (file-name-sans-extension
4699 (file-name-nondirectory buffer-file-name))
4700 ".ics"))
4701 (setq ical-buffer (org-get-agenda-file-buffer ical-file))
4702 (with-current-buffer ical-buffer (erase-buffer)))
4703 (setq category (or org-category
4704 (file-name-sans-extension
4705 (file-name-nondirectory buffer-file-name))))
4706 (if (symbolp category) (setq category (symbol-name category)))
4707 (let ((standard-output ical-buffer))
4708 (if combine
4709 (and (not started) (setq started t)
4710 (org-start-icalendar-file org-icalendar-combined-name))
4711 (org-start-icalendar-file category))
4712 (org-print-icalendar-entries combine)
4713 (when (or (and combine (not files)) (not combine))
4714 (org-finish-icalendar-file)
4715 (set-buffer ical-buffer)
4716 (run-hooks 'org-before-save-iCalendar-file-hook)
4717 (save-buffer)
4718 (run-hooks 'org-after-save-iCalendar-file-hook)
4719 (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
4720 ))))
4721 (org-release-buffers org-agenda-new-buffers))))
4722
4723(defvar org-before-save-iCalendar-file-hook nil
4724 "Hook run before an iCalendar file has been saved.
4725This can be used to modify the result of the export.")
4726
4727(defvar org-after-save-iCalendar-file-hook nil
4728 "Hook run after an iCalendar file has been saved.
4729The iCalendar buffer is still current when this hook is run.
4730A good way to use this is to tell a desktop calendar application to re-read
4731the iCalendar file.")
4732
4733(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
4734(defun org-print-icalendar-entries (&optional combine)
4735 "Print iCalendar entries for the current Org-mode file to `standard-output'.
4736When COMBINE is non nil, add the category to each line."
4737 (require 'org-agenda)
4738 (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
4739 (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
4740 (dts (org-ical-ts-to-string
4741 (format-time-string (cdr org-time-stamp-formats) (current-time))
4742 "DTSTART"))
4743 hd ts ts2 state status (inc t) pos b sexp rrule
4744 scheduledp deadlinep todo prefix due start
4745 tmp pri categories location summary desc uid
4746 (sexp-buffer (get-buffer-create "*ical-tmp*")))
4747 (org-refresh-category-properties)
4748 (save-excursion
4749 (goto-char (point-min))
4750 (while (re-search-forward re1 nil t)
4751 (catch :skip
4752 (org-agenda-skip)
4753 (when (boundp 'org-icalendar-verify-function)
4754 (unless (funcall org-icalendar-verify-function)
4755 (outline-next-heading)
4756 (backward-char 1)
4757 (throw :skip nil)))
4758 (setq pos (match-beginning 0)
4759 ts (match-string 0)
4760 inc t
4761 hd (condition-case nil
4762 (org-icalendar-cleanup-string
4763 (org-get-heading))
4764 (error (throw :skip nil)))
4765 summary (org-icalendar-cleanup-string
4766 (org-entry-get nil "SUMMARY"))
4767 desc (org-icalendar-cleanup-string
4768 (or (org-entry-get nil "DESCRIPTION")
4769 (and org-icalendar-include-body (org-get-entry)))
4770 t org-icalendar-include-body)
4771 location (org-icalendar-cleanup-string
4772 (org-entry-get nil "LOCATION" 'selective))
4773 uid (if org-icalendar-store-UID
4774 (org-id-get-create)
4775 (or (org-id-get) (org-id-new)))
4776 categories (org-export-get-categories)
4777 deadlinep nil scheduledp nil)
4778 (if (looking-at re2)
4779 (progn
4780 (goto-char (match-end 0))
4781 (setq ts2 (match-string 1)
4782 inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
4783 (setq tmp (buffer-substring (max (point-min)
4784 (- pos org-ds-keyword-length))
4785 pos)
4786 ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
4787 (progn
4788 (setq inc nil)
4789 (replace-match "\\1" t nil ts))
4790 ts)
4791 deadlinep (string-match org-deadline-regexp tmp)
4792 scheduledp (string-match org-scheduled-regexp tmp)
4793 todo (org-get-todo-state)
4794 ;; donep (org-entry-is-done-p)
4795 ))
4796 (when (and
4797 deadlinep
4798 (if todo
4799 (not (memq 'event-if-todo org-icalendar-use-deadline))
4800 (not (memq 'event-if-not-todo org-icalendar-use-deadline))))
4801 (throw :skip t))
4802 (when (and
4803 scheduledp
4804 (if todo
4805 (not (memq 'event-if-todo org-icalendar-use-scheduled))
4806 (not (memq 'event-if-not-todo org-icalendar-use-scheduled))))
4807 (throw :skip t))
4808 (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-")))
4809 (if (or (string-match org-tr-regexp hd)
4810 (string-match org-ts-regexp hd))
4811 (setq hd (replace-match "" t t hd)))
4812 (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
4813 (setq rrule
4814 (concat "\nRRULE:FREQ="
4815 (cdr (assoc
4816 (match-string 2 ts)
4817 '(("d" . "DAILY")("w" . "WEEKLY")
4818 ("m" . "MONTHLY")("y" . "YEARLY"))))
4819 ";INTERVAL=" (match-string 1 ts)))
4820 (setq rrule ""))
4821 (setq summary (or summary hd))
4822 (if (string-match org-bracket-link-regexp summary)
4823 (setq summary
4824 (replace-match (if (match-end 3)
4825 (match-string 3 summary)
4826 (match-string 1 summary))
4827 t t summary)))
4828 (if deadlinep (setq summary (concat "DL: " summary)))
4829 (if scheduledp (setq summary (concat "S: " summary)))
4830 (if (string-match "\\`<%%" ts)
4831 (with-current-buffer sexp-buffer
4832 (insert (substring ts 1 -1) " " summary "\n"))
4833 (princ (format "BEGIN:VEVENT
4834UID: %s
4835%s
4836%s%s
4837SUMMARY:%s%s%s
4838CATEGORIES:%s
4839END:VEVENT\n"
4840 (concat prefix uid)
4841 (org-ical-ts-to-string ts "DTSTART")
4842 (org-ical-ts-to-string ts2 "DTEND" inc)
4843 rrule summary
4844 (if (and desc (string-match "\\S-" desc))
4845 (concat "\nDESCRIPTION: " desc) "")
4846 (if (and location (string-match "\\S-" location))
4847 (concat "\nLOCATION: " location) "")
4848 categories)))))
4849 (when (and org-icalendar-include-sexps
4850 (condition-case nil (require 'icalendar) (error nil))
4851 (fboundp 'icalendar-export-region))
4852 ;; Get all the literal sexps
4853 (goto-char (point-min))
4854 (while (re-search-forward "^&?%%(" nil t)
4855 (catch :skip
4856 (org-agenda-skip)
4857 (setq b (match-beginning 0))
4858 (goto-char (1- (match-end 0)))
4859 (forward-sexp 1)
4860 (end-of-line 1)
4861 (setq sexp (buffer-substring b (point)))
4862 (with-current-buffer sexp-buffer
4863 (insert sexp "\n"))))
4864 (princ (org-diary-to-ical-string sexp-buffer))
4865 (kill-buffer sexp-buffer))
4866
4867 (when org-icalendar-include-todo
4868 (setq prefix "TODO-")
4869 (goto-char (point-min))
4870 (while (re-search-forward org-todo-line-regexp nil t)
4871 (catch :skip
4872 (org-agenda-skip)
4873 (when (boundp 'org-icalendar-verify-function)
4874 (unless (funcall org-icalendar-verify-function)
4875 (outline-next-heading)
4876 (backward-char 1)
4877 (throw :skip nil)))
4878 (setq state (match-string 2))
4879 (setq status (if (member state org-done-keywords)
4880 "COMPLETED" "NEEDS-ACTION"))
4881 (when (and state
4882 (or (not (member state org-done-keywords))
4883 (eq org-icalendar-include-todo 'all))
4884 (not (member org-archive-tag (org-get-tags-at)))
4885 )
4886 (setq hd (match-string 3)
4887 summary (org-icalendar-cleanup-string
4888 (org-entry-get nil "SUMMARY"))
4889 desc (org-icalendar-cleanup-string
4890 (or (org-entry-get nil "DESCRIPTION")
4891 (and org-icalendar-include-body (org-get-entry)))
4892 t org-icalendar-include-body)
4893 location (org-icalendar-cleanup-string
4894 (org-entry-get nil "LOCATION" 'selective))
4895 due (and (member 'todo-due org-icalendar-use-deadline)
4896 (org-entry-get nil "DEADLINE"))
4897 start (and (member 'todo-start org-icalendar-use-scheduled)
4898 (org-entry-get nil "SCHEDULED"))
4899 categories (org-export-get-categories)
4900 uid (if org-icalendar-store-UID
4901 (org-id-get-create)
4902 (or (org-id-get) (org-id-new))))
4903 (and due (setq due (org-ical-ts-to-string due "DUE")))
4904 (and start (setq start (org-ical-ts-to-string start "DTSTART")))
4905
4906 (if (string-match org-bracket-link-regexp hd)
4907 (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
4908 (match-string 1 hd))
4909 t t hd)))
4910 (if (string-match org-priority-regexp hd)
4911 (setq pri (string-to-char (match-string 2 hd))
4912 hd (concat (substring hd 0 (match-beginning 1))
4913 (substring hd (match-end 1))))
4914 (setq pri org-default-priority))
4915 (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
4916 (- org-lowest-priority org-highest-priority))))))
4917
4918 (princ (format "BEGIN:VTODO
4919UID: %s
4920%s
4921SUMMARY:%s%s%s%s
4922CATEGORIES:%s
4923SEQUENCE:1
4924PRIORITY:%d
4925STATUS:%s
4926END:VTODO\n"
4927 (concat prefix uid)
4928 (or start dts)
4929 (or summary hd)
4930 (if (and location (string-match "\\S-" location))
4931 (concat "\nLOCATION: " location) "")
4932 (if (and desc (string-match "\\S-" desc))
4933 (concat "\nDESCRIPTION: " desc) "")
4934 (if due (concat "\n" due) "")
4935 categories
4936 pri status)))))))))
4937
4938(defun org-export-get-categories ()
4939 "Get categories according to `org-icalendar-categories'."
4940 (let ((cs org-icalendar-categories) c rtn tmp)
4941 (while (setq c (pop cs))
4942 (cond
4943 ((eq c 'category) (push (org-get-category) rtn))
4944 ((eq c 'todo-state)
4945 (setq tmp (org-get-todo-state))
4946 (and tmp (push tmp rtn)))
4947 ((eq c 'local-tags)
4948 (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
4949 ((eq c 'all-tags)
4950 (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
4951 (mapconcat 'identity (nreverse rtn) ",")))
4952
4953(defun org-icalendar-cleanup-string (s &optional is-body maxlength)
4954 "Take out stuff and quote what needs to be quoted.
4955When IS-BODY is non-nil, assume that this is the body of an item, clean up
4956whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
4957characters."
4958 (if (not s)
4959 nil
4960 (when is-body
4961 (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
4962 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
4963 (while (string-match re s) (setq s (replace-match "" t t s)))
4964 (while (string-match re2 s) (setq s (replace-match "" t t s)))))
4965 (let ((start 0))
4966 (while (string-match "\\([,;]\\)" s start)
4967 (setq start (+ (match-beginning 0) 2)
4968 s (replace-match "\\\\\\1" nil nil s))))
4969 (setq s (org-trim s))
4970 (when is-body
4971 (while (string-match "[ \t]*\n[ \t]*" s)
4972 (setq s (replace-match "\\n" t t s))))
4973 (if is-body
4974 (if maxlength
4975 (if (and (numberp maxlength)
4976 (> (length s) maxlength))
4977 (setq s (substring s 0 maxlength)))))
4978 s))
4979
4980(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength)
4981 "Take out stuff and quote what needs to be quoted.
4982When IS-BODY is non-nil, assume that this is the body of an item, clean up
4983whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
4984characters.
4985This seems to be more like RFC 2455, but it causes problems, so it is
4986not used right now."
4987 (if (not s)
4988 nil
4989 (if is-body
4990 (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
4991 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
4992 (while (string-match re s) (setq s (replace-match "" t t s)))
4993 (while (string-match re2 s) (setq s (replace-match "" t t s)))
4994 (setq s (org-trim s))
4995 (while (string-match "[ \t]*\n[ \t]*" s)
4996 (setq s (replace-match "\\n" t t s)))
4997 (if maxlength
4998 (if (and (numberp maxlength)
4999 (> (length s) maxlength))
5000 (setq s (substring s 0 maxlength)))))
5001 (setq s (org-trim s)))
5002 (while (string-match "\"" s) (setq s (replace-match "''" t t s)))
5003 (when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
5004 s))
5005
5006(defun org-get-entry ()
5007 "Clean-up description string."
5008 (save-excursion
5009 (org-back-to-heading t)
5010 (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
5011
5012(defun org-start-icalendar-file (name)
5013 "Start an iCalendar file by inserting the header."
5014 (let ((user user-full-name)
5015 (name (or name "unknown"))
5016 (timezone (cadr (current-time-zone))))
5017 (princ
5018 (format "BEGIN:VCALENDAR
5019VERSION:2.0
5020X-WR-CALNAME:%s
5021PRODID:-//%s//Emacs with Org-mode//EN
5022X-WR-TIMEZONE:%s
5023CALSCALE:GREGORIAN\n" name user timezone))))
5024
5025(defun org-finish-icalendar-file ()
5026 "Finish an iCalendar file by inserting the END statement."
5027 (princ "END:VCALENDAR\n"))
5028
5029(defun org-ical-ts-to-string (s keyword &optional inc)
5030 "Take a time string S and convert it to iCalendar format.
5031KEYWORD is added in front, to make a complete line like DTSTART....
5032When INC is non-nil, increase the hour by two (if time string contains
5033a time), or the day by one (if it does not contain a time)."
5034 (let ((t1 (org-parse-time-string s 'nodefault))
5035 t2 fmt have-time time)
5036 (if (and (car t1) (nth 1 t1) (nth 2 t1))
5037 (setq t2 t1 have-time t)
5038 (setq t2 (org-parse-time-string s)))
5039 (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
5040 (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
5041 (when inc
5042 (if have-time
5043 (if org-agenda-default-appointment-duration
5044 (setq mi (+ org-agenda-default-appointment-duration mi))
5045 (setq h (+ 2 h)))
5046 (setq d (1+ d))))
5047 (setq time (encode-time s mi h d m y)))
5048 (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
5049 (concat keyword (format-time-string fmt time))))
5050
5051;;; XOXO export
5052
5053(defun org-export-as-xoxo-insert-into (buffer &rest output)
5054 (with-current-buffer buffer
5055 (apply 'insert output)))
5056(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1)
5057
5058;;;###autoload
5059(defun org-export-as-xoxo (&optional buffer)
5060 "Export the org buffer as XOXO.
5061The XOXO buffer is named *xoxo-<source buffer name>*"
5062 (interactive (list (current-buffer)))
5063 ;; A quickie abstraction
5064
5065 ;; Output everything as XOXO
5066 (with-current-buffer (get-buffer buffer)
5067 (let* ((pos (point))
5068 (opt-plist (org-combine-plists (org-default-export-plist)
5069 (org-infile-export-plist)))
5070 (filename (concat (file-name-as-directory
5071 (org-export-directory :xoxo opt-plist))
5072 (file-name-sans-extension
5073 (file-name-nondirectory buffer-file-name))
5074 ".html"))
5075 (out (find-file-noselect filename))
5076 (last-level 1)
5077 (hanging-li nil))
5078 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed.
5079 ;; Check the output buffer is empty.
5080 (with-current-buffer out (erase-buffer))
5081 ;; Kick off the output
5082 (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
5083 (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't)
5084 (let* ((hd (match-string-no-properties 1))
5085 (level (length hd))
5086 (text (concat
5087 (match-string-no-properties 2)
5088 (save-excursion
5089 (goto-char (match-end 0))
5090 (let ((str ""))
5091 (catch 'loop
5092 (while 't
5093 (forward-line)
5094 (if (looking-at "^[ \t]\\(.*\\)")
5095 (setq str (concat str (match-string-no-properties 1)))
5096 (throw 'loop str)))))))))
5097
5098 ;; Handle level rendering
5099 (cond
5100 ((> level last-level)
5101 (org-export-as-xoxo-insert-into out "\n<ol>\n"))
5102
5103 ((< level last-level)
5104 (dotimes (- (- last-level level) 1)
5105 (if hanging-li
5106 (org-export-as-xoxo-insert-into out "</li>\n"))
5107 (org-export-as-xoxo-insert-into out "</ol>\n"))
5108 (when hanging-li
5109 (org-export-as-xoxo-insert-into out "</li>\n")
5110 (setq hanging-li nil)))
5111
5112 ((equal level last-level)
5113 (if hanging-li
5114 (org-export-as-xoxo-insert-into out "</li>\n")))
5115 )
5116
5117 (setq last-level level)
5118
5119 ;; And output the new li
5120 (setq hanging-li 't)
5121 (if (equal ?+ (elt text 0))
5122 (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>")
5123 (org-export-as-xoxo-insert-into out "<li>" text))))
5124
5125 ;; Finally finish off the ol
5126 (dotimes (- last-level 1)
5127 (if hanging-li
5128 (org-export-as-xoxo-insert-into out "</li>\n"))
5129 (org-export-as-xoxo-insert-into out "</ol>\n"))
5130
5131 (goto-char pos)
5132 ;; Finish the buffer off and clean it up.
5133 (switch-to-buffer-other-window out)
5134 (indent-region (point-min) (point-max) nil)
5135 (save-buffer)
5136 (goto-char (point-min))
5137 )))
5138 2816
5139(provide 'org-exp) 2817(provide 'org-exp)
5140 2818
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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -258,21 +258,21 @@ column view defines special faces for each outline level. See the file
258 '((((class color) (background light)) (:underline t)) 258 '((((class color) (background light)) (:underline t))
259 (((class color) (background dark)) (:underline t)) 259 (((class color) (background dark)) (:underline t))
260 (t (:underline t))) 260 (t (:underline t)))
261 "Face for links." 261 "Face for link targets."
262 :group 'org-faces) 262 :group 'org-faces)
263 263
264(defface org-date 264(defface org-date
265 '((((class color) (background light)) (:foreground "Purple" :underline t)) 265 '((((class color) (background light)) (:foreground "Purple" :underline t))
266 (((class color) (background dark)) (:foreground "Cyan" :underline t)) 266 (((class color) (background dark)) (:foreground "Cyan" :underline t))
267 (t (:underline t))) 267 (t (:underline t)))
268 "Face for links." 268 "Face for date/time stamps."
269 :group 'org-faces) 269 :group 'org-faces)
270 270
271(defface org-sexp-date 271(defface org-sexp-date
272 '((((class color) (background light)) (:foreground "Purple")) 272 '((((class color) (background light)) (:foreground "Purple"))
273 (((class color) (background dark)) (:foreground "Cyan")) 273 (((class color) (background dark)) (:foreground "Cyan"))
274 (t (:underline t))) 274 (t (:underline t)))
275 "Face for links." 275 "Face for diary-like sexp date specifications."
276 :group 'org-faces) 276 :group 'org-faces)
277 277
278(defface org-tag 278(defface org-tag
@@ -301,6 +301,20 @@ specific tags."
301 "Face used for todo keywords that indicate DONE items." 301 "Face used for todo keywords that indicate DONE items."
302 :group 'org-faces) 302 :group 'org-faces)
303 303
304(defface org-agenda-done ;; originally copied from font-lock-type-face
305 (org-compatible-face nil
306 '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
307 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
308 (((class color) (min-colors 8)) (:foreground "green"))
309 (t (:bold nil))))
310 "Face used in agenda, to indicate lines switched to DONE.
311This face is used to de-emphasize items that where brightly colord in the
312agenda because they were things to do, or overdue. The DONE state itself
313is of course immediately visible, but for example a passed deadline is
314\(by default) very bright read. This face could be simply the default face
315of the frame, for example."
316 :group 'org-faces)
317
304(defface org-headline-done ;; originally copied from font-lock-string-face 318(defface org-headline-done ;; originally copied from font-lock-string-face
305 (org-compatible-face nil 319 (org-compatible-face nil
306 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) 320 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
@@ -323,6 +337,18 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)."
323 (string :tag "keyword") 337 (string :tag "keyword")
324 (sexp :tag "face")))) 338 (sexp :tag "face"))))
325 339
340(defcustom org-priority-faces nil
341 "Faces for specific Priorities.
342This is a list of cons cells, with priority character in the car
343and faces in the cdr. The face can be a symbol, or a property
344list of attributes, like (:foreground \"blue\" :weight bold :underline t)."
345 :group 'org-faces
346 :group 'org-todo
347 :type '(repeat
348 (cons
349 (character :tag "Priority")
350 (sexp :tag "face"))))
351
326(defvar org-tags-special-faces-re nil) 352(defvar org-tags-special-faces-re nil)
327(defun org-set-tag-faces (var value) 353(defun org-set-tag-faces (var value)
328 (set var value) 354 (set var value)
@@ -331,6 +357,22 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)."
331 (setq org-tags-special-faces-re 357 (setq org-tags-special-faces-re
332 (concat ":\\(" (mapconcat 'car value "\\|") "\\):")))) 358 (concat ":\\(" (mapconcat 'car value "\\|") "\\):"))))
333 359
360(defface org-checkbox
361 (org-compatible-face 'bold
362 '((t (:bold t))))
363 "Face for checkboxes"
364 :group 'org-faces)
365
366(unless (facep 'org-checkbox-statistics-todo)
367 (copy-face 'org-todo 'org-checkbox-statistics-todo)
368 (set-face-doc-string 'org-checkbox-statistics-todo
369 "Face used for unfinished checkbox statistics."))
370
371(unless (facep 'org-checkbox-statistics-done)
372 (copy-face 'org-done 'org-checkbox-statistics-done)
373 (set-face-doc-string 'org-checkbox-statistics-done
374 "Face used for finished checkbox statistics."))
375
334(defcustom org-tag-faces nil 376(defcustom org-tag-faces nil
335 "Faces for specific tags. 377 "Faces for specific tags.
336This is a list of cons cells, with tags in the car and faces in the cdr. 378This is a list of cons cells, with tags in the car and faces in the cdr.
@@ -370,7 +412,7 @@ changes."
370 :group 'org-faces) 412 :group 'org-faces)
371 413
372(defface org-code 414(defface org-code
373 (org-compatible-face nil 415 (org-compatible-face 'shadow
374 '((((class color grayscale) (min-colors 88) (background light)) 416 '((((class color grayscale) (min-colors 88) (background light))
375 (:foreground "grey50")) 417 (:foreground "grey50"))
376 (((class color grayscale) (min-colors 88) (background dark)) 418 (((class color grayscale) (min-colors 88) (background dark))
@@ -383,8 +425,28 @@ changes."
383 :group 'org-faces 425 :group 'org-faces
384 :version "22.1") 426 :version "22.1")
385 427
428(defface org-meta-line
429 (org-compatible-face 'font-lock-comment-face nil)
430 "Face for meta lines startin with \"#+\"."
431 :group 'org-faces
432 :version "22.1")
433
434(defface org-block
435 (org-compatible-face 'shadow
436 '((((class color grayscale) (min-colors 88) (background light))
437 (:foreground "grey50"))
438 (((class color grayscale) (min-colors 88) (background dark))
439 (:foreground "grey70"))
440 (((class color) (min-colors 8) (background light))
441 (:foreground "green"))
442 (((class color) (min-colors 8) (background dark))
443 (:foreground "yellow"))))
444 "Face text in #+begin ... #+end blocks."
445 :group 'org-faces
446 :version "22.1")
447
386(defface org-verbatim 448(defface org-verbatim
387 (org-compatible-face nil 449 (org-compatible-face 'shadow
388 '((((class color grayscale) (min-colors 88) (background light)) 450 '((((class color grayscale) (min-colors 88) (background light))
389 (:foreground "grey50" :underline t)) 451 (:foreground "grey50" :underline t))
390 (((class color grayscale) (min-colors 88) (background dark)) 452 (((class color grayscale) (min-colors 88) (background dark))
@@ -429,6 +491,13 @@ changes."
429 (set-face-doc-string 'org-agenda-date 491 (set-face-doc-string 'org-agenda-date
430 "Face used in agenda for normal days.")) 492 "Face used in agenda for normal days."))
431 493
494(unless (facep 'org-agenda-date-today)
495 (copy-face 'org-agenda-date 'org-agenda-date-today)
496 (set-face-doc-string 'org-agenda-date-today
497 "Face used in agenda for today.")
498 (when (fboundp 'set-face-attribute)
499 (set-face-attribute 'org-agenda-date-today nil :weight 'bold :italic 't)))
500
432(unless (facep 'org-agenda-date-weekend) 501(unless (facep 'org-agenda-date-weekend)
433 (copy-face 'org-agenda-date 'org-agenda-date-weekend) 502 (copy-face 'org-agenda-date 'org-agenda-date-weekend)
434 (set-face-doc-string 'org-agenda-date-weekend 503 (set-face-doc-string 'org-agenda-date-weekend
@@ -535,7 +604,7 @@ month and 365.24 days for a year)."
535 "The number of different faces to be used for headlines. 604 "The number of different faces to be used for headlines.
536Org-mode defines 8 different headline faces, so this can be at most 8. 605Org-mode defines 8 different headline faces, so this can be at most 8.
537If it is less than 8, the level-1 face gets re-used for level N+1 etc." 606If it is less than 8, the level-1 face gets re-used for level N+1 etc."
538 :type 'number 607 :type 'integer
539 :group 'org-faces) 608 :group 'org-faces)
540 609
541(defface org-latex-and-export-specials 610(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."
554 "Face used to highlight math latex and other special exporter stuff." 623 "Face used to highlight math latex and other special exporter stuff."
555 :group 'org-faces) 624 :group 'org-faces)
556 625
626(unless (facep 'org-mode-line-clock)
627 (copy-face 'modeline 'org-mode-line-clock)
628 (set-face-doc-string 'org-agenda-date
629 "Face used for clock display in mode line."))
630
557(provide 'org-faces) 631(provide 'org-faces)
558 632
559;; arch-tag: 9dab5f91-c4b9-4d6f-bac3-1f6211ad0a04 633;; 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 @@
1;;; org-feed.el --- Add RSS feed items to Org files
2;;
3;; Copyright (C) 2009 Free Software Foundation, Inc.
4;;
5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
8;; Version: 6.29c
9;;
10;; This file is part of GNU Emacs.
11;;
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25;;
26;;; Commentary:
27;;
28;; This module allows to create and change entries in an Org-mode
29;; file triggered by items in an RSS feed. The basic functionality is
30;; geared toward simply adding new items found in a feed as outline nodes
31;; to an Org file. Using hooks, arbitrary actions can be triggered for
32;; new or changed items.
33;;
34;; Selecting feeds and target locations
35;; ------------------------------------
36;;
37;; This module is configured through a single variable, `org-feed-alist'.
38;; Here is an example, using a notes/tasks feed from reQall.com.
39;;
40;; (setq org-feed-alist
41;; '(("ReQall"
42;; "http://www.reqall.com/user/feeds/rss/a1b2c3....."
43;; "~/org/feeds.org" "ReQall Entries")
44;;
45;; With this setup, the command `M-x org-feed-update-all' will
46;; collect new entries in the feed at the given URL and create
47;; entries as subheadings under the "ReQall Entries" heading in the
48;; file "~/org-feeds.org". Each feed should normally have its own
49;; heading - however see the `:drawer' parameter.
50;;
51;; Besides these standard elements that need to be specified for each
52;; feed, keyword-value pairs can set additional options. For example,
53;; to de-select transitional entries with a title containing
54;;
55;; "reQall is typing what you said",
56;;
57;; you could use the `:filter' argument:
58;;
59;; (setq org-feed-alist
60;; '(("ReQall"
61;; "http://www.reqall.com/user/feeds/rss/a1b2c3....."
62;; "~/org/feeds.org" "ReQall Entries"
63;; :filter my-reqall-filter)))
64;;
65;; (defun my-reqall-filter (e)
66;; (if (string-match "reQall is typing what you said"
67;; (plist-get e :title))
68;; nil
69;; e))
70;;
71;; See the docstring for `org-feed-alist' for more details.
72;;
73;;
74;; Keeping track of previously added entries
75;; -----------------------------------------
76;;
77;; Since Org allows you to delete, archive, or move outline nodes,
78;; org-feed.el needs to keep track of which feed items have been handled
79;; before, so that they will not be handled again. For this, org-feed.el
80;; stores information in a special drawer, FEEDSTATUS, under the heading
81;; that received the input of the feed. You should add FEEDSTATUS
82;; to your list of drawers in the files that receive feed input:
83;;
84;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS
85;;
86;; Acknowledgments
87;; ----------------
88;;
89;; org-feed.el is based on ideas by Brad Bozarth who implemented a
90;; similar mechanism using shell and awk scripts.
91
92;;; Code:
93
94(require 'org)
95(require 'sha1)
96
97(declare-function url-retrieve-synchronously "url" (url))
98(declare-function xml-node-children "xml" (node))
99(declare-function xml-get-children "xml" (node child-name))
100(declare-function xml-get-attribute "xml" (node attribute))
101(declare-function xml-get-attribute-or-nil "xml" (node attribute))
102
103(defgroup org-feed nil
104 "Options concerning RSS feeds as inputs for Org files."
105 :tag "Org ID"
106 :group 'org)
107
108(defcustom org-feed-alist nil
109 "Alist specifying RSS feeds that should create inputs for Org.
110Each entry in this list specified an RSS feed tat should be queried
111to create inbox items in Org. Each entry is a list with the following items:
112
113name a custom name for this feed
114URL the Feed URL
115file the target Org file where entries should be listed
116headline the headline under which entries should be listed
117
118Additional arguments can be given using keyword-value pairs. Many of these
119specify functions that receive one or a list of \"entries\" as their single
120argument. An entry is a property list that describes a feed item. The
121property list has properties for each field in the item, for example `:title'
122for the `<title>' field and `:pubDate' for the publication date. In addition,
123it contains the following properties:
124
125`:item-full-text' the full text in the <item> tag
126`:guid-permalink' t when the guid property is a permalink
127
128Here are the keyword-value pair allows in `org-feed-alist'.
129
130:drawer drawer-name
131 The name of the drawer for storing feed information. The default is
132 \"FEEDSTATUS\". Using different drawers for different feeds allows
133 several feeds to target the same inbox heading.
134
135:filter filter-function
136 A function to select interesting entries in the feed. It gets a single
137 entry as parameter. It should return the entry if it is relevant, or
138 nil if it is not.
139
140:template template-string
141 The default action on new items in the feed is to add them as children
142 under the headline for the feed. The template describes how the entry
143 should be formatted. If not given, it defaults to
144 `org-feed-default-template'.
145
146:formatter formatter-function
147 Instead of relying on a template, you may specify a function to format
148 the outline node to be inserted as a child. This function gets passed
149 a property list describing a single feed item, and it should return a
150 string that is a properly formatted Org outline node of level 1.
151
152:new-handler function
153 If adding new items as children to the outline is not what you want
154 to do with new items, define a handler function that is called with
155 a list of all new items in the feed, each one represented as a property
156 list. The handler should do what needs to be done, and org-feed will
157 mark all items given to this handler as \"handled\", i.e. they will not
158 be passed to this handler again in future readings of the feed.
159 When the handler is called, point will be at the feed headline.
160
161:changed-handler function
162 This function gets passed a list of all entries that have been
163 handled before, but are now still in the feed and have *changed*
164 since last handled (as evidenced by a different sha1 hash).
165 When the handler is called, point will be at the feed headline.
166
167:parse-feed function
168 This function gets passed a buffer, and should return a list of entries,
169 each being a property list containing the `:guid' and `:item-full-text'
170 keys. The default is `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed'
171 is an alternative.
172
173:parse-entry function
174 This function gets passed an entry as returned by the parse-feed
175 function, and should return the entry with interesting properties added.
176 The default is `org-feed-parse-rss-entry'; `org-feed-parse-atom-entry'
177 is an alternative."
178 :group 'org-feed
179 :type '(repeat
180 (list :value ("" "http://" "" "")
181 (string :tag "Name")
182 (string :tag "Feed URL")
183 (file :tag "File for inbox")
184 (string :tag "Headline for inbox")
185 (repeat :inline t
186 (choice
187 (list :inline t :tag "Filter"
188 (const :filter)
189 (symbol :tag "Filter Function"))
190 (list :inline t :tag "Template"
191 (const :template)
192 (string :tag "Template"))
193 (list :inline t :tag "Formatter"
194 (const :formatter)
195 (symbol :tag "Formatter Function"))
196 (list :inline t :tag "New items handler"
197 (const :new-handler)
198 (symbol :tag "Handler Function"))
199 (list :inline t :tag "Changed items"
200 (const :changed-handler)
201 (symbol :tag "Handler Function"))
202 (list :inline t :tag "Parse Feed"
203 (const :parse-feed)
204 (symbol :tag "Parse Feed Function"))
205 (list :inline t :tag "Parse Entry"
206 (const :parse-entry)
207 (symbol :tag "Parse Entry Function"))
208 )))))
209
210(defcustom org-feed-drawer "FEEDSTATUS"
211 "The name of the drawer for feed status information.
212Each feed may also specify its own drawer name using the `:drawer'
213parameter in `org-feed-alist'.
214Note that in order to make these drawers behave like drawers, they must
215be added to the variable `org-drawers' or configured with a #+DRAWERS
216line."
217 :group 'org-feed
218 :type '(string :tag "Drawer Name"))
219
220(defcustom org-feed-default-template "\n* %h\n %U\n %description\n %a\n"
221 "Template for the Org node created from RSS feed items.
222This is just the default, each feed can specify its own.
223Any fields from the feed item can be interpolated into the template with
224%name, for example %title, %description, %pubDate etc. In addition, the
225following special escapes are valid as well:
226
227%h the title, or the first line of the description
228%t the date as a stamp, either from <pubDate> (if present), or
229 the current date.
230%T date and time
231%u,%U like %t,%T, but inactive time stamps
232%a A link, from <guid> if that is a permalink, else from <link>"
233 :group 'org-feed
234 :type '(string :tag "Template"))
235
236(defcustom org-feed-save-after-adding t
237 "Non-nil means, save buffer after adding new feed items."
238 :group 'org-feed
239 :type 'boolean)
240
241(defcustom org-feed-retrieve-method 'url-retrieve-synchronously
242 "The method to be used to retrieve a feed URL.
243This can be `curl' or `wget' to call these external programs, or it can be
244an Emacs Lisp function that will return a buffer containing the content
245of the file pointed to by the URL."
246 :group 'org-feed
247 :type '(choice
248 (const :tag "Internally with url.el" url-retrieve-synchronously)
249 (const :tag "Externally with curl" curl)
250 (const :tag "Externally with wget" wget)
251 (function :tag "Function")))
252
253 (defcustom org-feed-before-adding-hook nil
254 "Hook that is run before adding new feed items to a file.
255You might want to commit the file in its current state to version control,
256for example."
257 :group 'org-feed
258 :type 'hook)
259
260(defcustom org-feed-after-adding-hook nil
261 "Hook that is run after new items have been added to a file.
262Depending on `org-feed-save-after-adding', the buffer will already
263have been saved."
264 :group 'org-feed
265 :type 'hook)
266
267(defvar org-feed-buffer "*Org feed*"
268 "The buffer used to retrieve a feed.")
269
270;;;###autoload
271(defun org-feed-update-all ()
272 "Get inbox items from all feeds in `org-feed-alist'."
273 (interactive)
274 (let ((nfeeds (length org-feed-alist))
275 (nnew (apply '+ (mapcar 'org-feed-update org-feed-alist))))
276 (message "%s from %d %s"
277 (cond ((= nnew 0) "No new entries")
278 ((= nnew 1) "1 new entry")
279 (t (format "%d new entries" nnew)))
280 nfeeds
281 (if (= nfeeds 1) "feed" "feeds"))))
282
283;;;###autoload
284(defun org-feed-update (feed &optional retrieve-only)
285 "Get inbox items from FEED.
286FEED can be a string with an association in `org-feed-alist', or
287it can be a list structured like an entry in `org-feed-alist'."
288 (interactive (list (org-completing-read "Feed name: " org-feed-alist)))
289 (if (stringp feed) (setq feed (assoc feed org-feed-alist)))
290 (unless feed
291 (error "No such feed in `org-feed-alist"))
292 (catch 'exit
293 (let ((name (car feed))
294 (url (nth 1 feed))
295 (file (nth 2 feed))
296 (headline (nth 3 feed))
297 (filter (nth 1 (memq :filter feed)))
298 (formatter (nth 1 (memq :formatter feed)))
299 (new-handler (nth 1 (memq :new-handler feed)))
300 (changed-handler (nth 1 (memq :changed-handler feed)))
301 (template (or (nth 1 (memq :template feed))
302 org-feed-default-template))
303 (drawer (or (nth 1 (memq :drawer feed))
304 org-feed-drawer))
305 (parse-feed (or (nth 1 (memq :parse-feed feed))
306 'org-feed-parse-rss-feed))
307 (parse-entry (or (nth 1 (memq :parse-entry feed))
308 'org-feed-parse-rss-entry))
309 feed-buffer inbox-pos new-formatted
310 entries old-status status new changed guid-alist e guid olds)
311 (setq feed-buffer (org-feed-get-feed url))
312 (unless (and feed-buffer (bufferp (get-buffer feed-buffer)))
313 (error "Cannot get feed %s" name))
314 (when retrieve-only
315 (throw 'exit feed-buffer))
316 (setq entries (funcall parse-feed feed-buffer))
317 (ignore-errors (kill-buffer feed-buffer))
318 (save-excursion
319 (save-window-excursion
320 (setq inbox-pos (org-feed-goto-inbox-internal file headline))
321 (setq old-status (org-feed-read-previous-status inbox-pos drawer))
322 ;; Add the "handled" status to the appropriate entries
323 (setq entries (mapcar (lambda (e)
324 (setq e (plist-put e :handled
325 (nth 1 (assoc
326 (plist-get e :guid)
327 old-status)))))
328 entries))
329 ;; Find out which entries are new and which are changed
330 (dolist (e entries)
331 (if (not (plist-get e :handled))
332 (push e new)
333 (setq olds (nth 2 (assoc (plist-get e :guid) old-status)))
334 (if (and olds
335 (not (string= (sha1
336 (plist-get e :item-full-text))
337 olds)))
338 (push e changed))))
339
340 ;; Parse the relevant entries fully
341 (setq new (mapcar parse-entry new)
342 changed (mapcar parse-entry changed))
343
344 ;; Run the filter
345 (when filter
346 (setq new (delq nil (mapcar filter new))
347 changed (delq nil (mapcar filter new))))
348
349 (when (not (or new changed))
350 (message "No new items in feed %s" name)
351 (throw 'exit 0))
352
353 ;; Get alist based on guid, to look up entries
354 (setq guid-alist
355 (append
356 (mapcar (lambda (e) (list (plist-get e :guid) e)) new)
357 (mapcar (lambda (e) (list (plist-get e :guid) e)) changed)))
358
359 ;; Construct the new status
360 (setq status
361 (mapcar
362 (lambda (e)
363 (setq guid (plist-get e :guid))
364 (list guid
365 ;; things count as handled if we handle them now,
366 ;; or if they were handled previously
367 (if (assoc guid guid-alist) t (plist-get e :handled))
368 ;; A hash, to detect changes
369 (sha1 (plist-get e :item-full-text))))
370 entries))
371
372 ;; Handle new items in the feed
373 (when new
374 (if new-handler
375 (progn
376 (goto-char inbox-pos)
377 (funcall new-handler new))
378 ;; No custom handler, do the default adding
379 ;; Format the new entries into an alist with GUIDs in the car
380 (setq new-formatted
381 (mapcar
382 (lambda (e) (org-feed-format-entry e template formatter))
383 new)))
384
385 ;; Insert the new items
386 (org-feed-add-items inbox-pos new-formatted))
387
388 ;; Handle changed items in the feed
389 (when (and changed-handler changed)
390 (goto-char inbox-pos)
391 (funcall changed-handler changed))
392
393 ;; Write the new status
394 ;; We do this only now, in case something goes wrong above, so
395 ;; that would would end up with a status that does not reflect
396 ;; which items truely have been handled
397 (org-feed-write-status inbox-pos drawer status)
398
399 ;; Normalize the visibility of the inbox tree
400 (goto-char inbox-pos)
401 (hide-subtree)
402 (show-children)
403 (org-cycle-hide-drawers 'children)
404
405 ;; Hooks and messages
406 (when org-feed-save-after-adding (save-buffer))
407 (message "Added %d new item%s from feed %s to file %s, heading %s"
408 (length new) (if (> (length new) 1) "s" "")
409 name
410 (file-name-nondirectory file) headline)
411 (run-hooks 'org-feed-after-adding-hook)
412 (length new))))))
413
414;;;###autoload
415(defun org-feed-goto-inbox (feed)
416 "Go to the inbox that captures the feed named FEED."
417 (interactive
418 (list (if (= (length org-feed-alist) 1)
419 (car org-feed-alist)
420 (org-completing-read "Feed name: " org-feed-alist))))
421 (if (stringp feed) (setq feed (assoc feed org-feed-alist)))
422 (unless feed
423 (error "No such feed in `org-feed-alist"))
424 (org-feed-goto-inbox-internal (nth 2 feed) (nth 3 feed)))
425
426;;;###autoload
427(defun org-feed-show-raw-feed (feed)
428 "Show the raw feed buffer of a feed."
429 (interactive
430 (list (if (= (length org-feed-alist) 1)
431 (car org-feed-alist)
432 (org-completing-read "Feed name: " org-feed-alist))))
433 (if (stringp feed) (setq feed (assoc feed org-feed-alist)))
434 (unless feed
435 (error "No such feed in `org-feed-alist"))
436 (switch-to-buffer
437 (org-feed-update feed 'retrieve-only))
438 (goto-char (point-min)))
439
440(defun org-feed-goto-inbox-internal (file heading)
441 "Find or create HEADING in FILE.
442Switch to that buffer, and return the position of that headline."
443 (find-file file)
444 (widen)
445 (goto-char (point-min))
446 (if (re-search-forward
447 (concat "^\\*+[ \t]+" heading "[ \t]*\\(:.*?:[ \t]*\\)?$")
448 nil t)
449 (goto-char (match-beginning 0))
450 (goto-char (point-max))
451 (insert "\n\n* " heading "\n\n")
452 (org-back-to-heading t))
453 (point))
454
455(defun org-feed-read-previous-status (pos drawer)
456 "Get the alist of old GUIDs from the entry at POS.
457This will find DRAWER and extract the alist."
458 (save-excursion
459 (goto-char pos)
460 (let ((end (save-excursion (org-end-of-subtree t t))))
461 (if (re-search-forward
462 (concat "^[ \t]*:" drawer ":[ \t]*\n\\([^\000]*?\\)\n[ \t]*:END:")
463 end t)
464 (read (match-string 1))
465 nil))))
466
467(defun org-feed-write-status (pos drawer status)
468 "Write the feed STATUS to DRAWER in entry at POS."
469 (save-excursion
470 (goto-char pos)
471 (let ((end (save-excursion (org-end-of-subtree t t)))
472 guid)
473 (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*\n")
474 end t)
475 (progn
476 (goto-char (match-end 0))
477 (delete-region (point)
478 (save-excursion
479 (and (re-search-forward "^[ \t]*:END:" nil t)
480 (match-beginning 0)))))
481 (outline-next-heading)
482 (insert " :" drawer ":\n :END:\n")
483 (beginning-of-line 0))
484 (insert (pp-to-string status)))))
485
486(defun org-feed-add-items (pos entries)
487 "Add the formatted items to the headline as POS."
488 (let (entry level)
489 (save-excursion
490 (goto-char pos)
491 (unless (looking-at org-complex-heading-regexp)
492 (error "Wrong position"))
493 (setq level (org-get-valid-level (length (match-string 1)) 1))
494 (org-end-of-subtree t t)
495 (skip-chars-backward " \t\n")
496 (beginning-of-line 2)
497 (setq pos (point))
498 (while (setq entry (pop entries))
499 (org-paste-subtree level entry 'yank))
500 (org-mark-ring-push pos))))
501
502(defun org-feed-format-entry (entry template formatter)
503 "Format ENTRY so that it can be inserted into an Org file.
504ENTRY is a property list. This function adds a `:formatted-for-org' property
505and returns the full property list.
506If that property is already present, nothing changes."
507 (if formatter
508 (funcall formatter entry)
509 (let (dlines fmt tmp indent time name
510 v-h v-t v-T v-u v-U v-a)
511 (setq dlines (org-split-string (or (plist-get entry :description) "???")
512 "\n")
513 v-h (or (plist-get entry :title) (car dlines) "???")
514 time (or (if (plist-get entry :pubDate)
515 (org-read-date t t (plist-get entry :pubDate)))
516 (current-time))
517 v-t (format-time-string (org-time-stamp-format nil nil) time)
518 v-T (format-time-string (org-time-stamp-format t nil) time)
519 v-u (format-time-string (org-time-stamp-format nil t) time)
520 v-U (format-time-string (org-time-stamp-format t t) time)
521 v-a (if (setq tmp (or (and (plist-get entry :guid-permalink)
522 (plist-get entry :guid))
523 (plist-get entry :link)))
524 (concat "[[" tmp "]]\n")
525 ""))
526 (with-temp-buffer
527 (insert template)
528 (goto-char (point-min))
529 (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
530 (setq name (match-string 1))
531 (cond
532 ((member name '("h" "t" "T" "u" "U" "a"))
533 (replace-match (symbol-value (intern (concat "v-" name))) t t))
534 ((setq tmp (plist-get entry (intern (concat ":" name))))
535 (save-excursion
536 (save-match-data
537 (beginning-of-line 1)
538 (when (looking-at (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
539 (setq tmp (org-feed-make-indented-block
540 tmp (org-get-indentation))))))
541 (replace-match tmp t t))))
542 (buffer-string)))))
543
544(defun org-feed-make-indented-block (s n)
545 "Add indentaton of N spaces to a multiline string S."
546 (if (not (string-match "\n" s))
547 s
548 (mapconcat 'identity
549 (org-split-string s "\n")
550 (concat "\n" (make-string n ?\ )))))
551
552(defun org-feed-skip-http-headers (buffer)
553 "Remove HTTP headers from BUFFER, and return it.
554Assumes headers are indeed present!"
555 (with-current-buffer buffer
556 (widen)
557 (goto-char (point-min))
558 (search-forward "\n\n")
559 (delete-region (point-min) (point))
560 buffer))
561
562(defun org-feed-get-feed (url)
563 "Get the RSS feed file at URL and return the buffer."
564 (cond
565 ((eq org-feed-retrieve-method 'url-retrieve-synchronously)
566 (org-feed-skip-http-headers (url-retrieve-synchronously url)))
567 ((eq org-feed-retrieve-method 'curl)
568 (ignore-errors (kill-buffer org-feed-buffer))
569 (call-process "curl" nil org-feed-buffer nil "--silent" url)
570 org-feed-buffer)
571 ((eq org-feed-retrieve-method 'wget)
572 (ignore-errors (kill-buffer org-feed-buffer))
573 (call-process "wget" nil org-feed-buffer nil "-q" "-O" "-" url)
574 org-feed-buffer)
575 ((functionp org-feed-retrieve-method)
576 (funcall org-feed-retrieve-method url))))
577
578(defun org-feed-parse-rss-feed (buffer)
579 "Parse BUFFER for RSS feed entries.
580Returns a list of entries, with each entry a property list,
581containing the properties `:guid' and `:item-full-text'."
582 (let (entries beg end item guid entry)
583 (with-current-buffer buffer
584 (widen)
585 (goto-char (point-min))
586 (while (re-search-forward "<item>" nil t)
587 (setq beg (point)
588 end (and (re-search-forward "</item>" nil t)
589 (match-beginning 0)))
590 (setq item (buffer-substring beg end)
591 guid (if (string-match "<guid\\>.*?>\\(.*?\\)</guid>" item)
592 (org-match-string-no-properties 1 item)))
593 (setq entry (list :guid guid :item-full-text item))
594 (push entry entries)
595 (widen)
596 (goto-char end))
597 (nreverse entries))))
598
599(defun org-feed-parse-rss-entry (entry)
600 "Parse the `:item-full-text' field for xml tags and create new properties."
601 (with-temp-buffer
602 (insert (plist-get entry :item-full-text))
603 (goto-char (point-min))
604 (while (re-search-forward "<\\([a-zA-Z]+\\>\\).*?>\\([^\000]*?\\)</\\1>"
605 nil t)
606 (setq entry (plist-put entry
607 (intern (concat ":" (match-string 1)))
608 (match-string 2))))
609 (goto-char (point-min))
610 (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t)
611 (setq entry (plist-put entry :guid-permalink t))))
612 entry)
613
614(defun org-feed-parse-atom-feed (buffer)
615 "Parse BUFFER for Atom feed entries.
616Returns a list of enttries, with each entry a property list,
617containing the properties `:guid' and `:item-full-text'.
618
619The `:item-full-text' property actually contains the sexp
620formatted as a string, not the original XML data."
621 (with-current-buffer buffer
622 (widen)
623 (let ((feed (car (xml-parse-region (point-min) (point-max)))))
624 (mapcar
625 (lambda (entry)
626 (list
627 :guid (car (xml-node-children (car (xml-get-children entry 'id))))
628 :item-full-text (prin1-to-string entry)))
629 (xml-get-children feed 'entry)))))
630
631(defun org-feed-parse-atom-entry (entry)
632 "Parse the `:item-full-text' as a sexp and create new properties."
633 (let ((xml (car (read-from-string (plist-get entry :item-full-text)))))
634 ;; Get first <link href='foo'/>.
635 (setq entry (plist-put entry :link
636 (xml-get-attribute
637 (car (xml-get-children xml 'link))
638 'href)))
639 ;; Add <title/> as :title.
640 (setq entry (plist-put entry :title
641 (car (xml-node-children
642 (car (xml-get-children xml 'title))))))
643 (let* ((content (car (xml-get-children xml 'content)))
644 (type (xml-get-attribute-or-nil content 'type)))
645 (when content
646 (cond
647 ((string= type "text")
648 ;; We like plain text.
649 (setq entry (plist-put entry :description (car (xml-node-children content)))))
650 ((string= type "html")
651 ;; TODO: convert HTML to Org markup.
652 (setq entry (plist-put entry :description (car (xml-node-children content)))))
653 ((string= type "xhtml")
654 ;; TODO: convert XHTML to Org markup.
655 (setq entry (plist-put entry :description (prin1-to-string (xml-node-children content)))))
656 (t
657 (setq entry (plist-put entry :description (format "Unknown '%s' content." type)))))))
658 entry))
659
660(provide 'org-feed)
661
662;; arch-tag: 0929b557-9bc4-47f4-9633-30a12dbb5ae2
663
664;;; org-feed.el ends here
665
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 @@
5;; Author: Carsten Dominik <carsten at orgmode dot org> 5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org 7;; Homepage: http://orgmode.org
8;; Version: 6.21b 8;; Version: 6.29c
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -45,6 +45,7 @@
45(declare-function org-show-context "org" (&optional key)) 45(declare-function org-show-context "org" (&optional key))
46(declare-function org-back-to-heading "org" (&optional invisible-ok)) 46(declare-function org-back-to-heading "org" (&optional invisible-ok))
47(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) 47(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
48(defvar org-odd-levels-only) ;; defined in org.el
48 49
49(defconst org-footnote-re 50(defconst org-footnote-re
50 (concat "[^][\n]" ; to make sure it is not at the beginning of a line 51 (concat "[^][\n]" ; to make sure it is not at the beginning of a line
@@ -57,7 +58,7 @@
57 "\\]") 58 "\\]")
58 "Regular expression for matching footnotes.") 59 "Regular expression for matching footnotes.")
59 60
60(defconst org-footnote-definition-re 61(defconst org-footnote-definition-re
61 (org-re "^\\(\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]\\)") 62 (org-re "^\\(\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]\\)")
62 "Regular expression matching the definition of a footnote.") 63 "Regular expression matching the definition of a footnote.")
63 64
@@ -111,6 +112,23 @@ plain Automatically create plain number labels like [1]"
111 (const :tag "Offer automatic [fn:N] for editing" confirm) 112 (const :tag "Offer automatic [fn:N] for editing" confirm)
112 (const :tag "Create automatic [N]" plain))) 113 (const :tag "Create automatic [N]" plain)))
113 114
115(defcustom org-footnote-auto-adjust nil
116 "Non-nil means, automatically adjust footnotes after insert/delete.
117When this is t, after each insertion or deletion of a footnote,
118simple fn:N footnotes will be renumbered, and all footnotes will be sorted.
119If you want to have just sorting or just renumbering, set this variable
120to `sort' or `renumber'.
121
122The main values of this variable can be set with in-buffer options:
123
124#+STARTUP: fnadjust
125#+STARTUP: nofnadjust"
126 :group 'org-footnote
127 :type '(choice
128 (const :tag "Renumber" renumber)
129 (const :tag "Sort" sort)
130 (const :tag "Renumber and Sort" t)))
131
114(defcustom org-footnote-fill-after-inline-note-extraction nil 132(defcustom org-footnote-fill-after-inline-note-extraction nil
115 "Non-nil means, fill paragraphs after extracting footnotes. 133 "Non-nil means, fill paragraphs after extracting footnotes.
116When extracting inline footnotes, the lengths of lines can change a lot. 134When 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."
246 (message "New reference to existing note")) 264 (message "New reference to existing note"))
247 (org-footnote-define-inline 265 (org-footnote-define-inline
248 (insert "[" label ": ]") 266 (insert "[" label ": ]")
249 (backward-char 1)) 267 (backward-char 1)
268 (org-footnote-auto-adjust-maybe))
250 (t 269 (t
251 (insert "[" label "]") 270 (insert "[" label "]")
252 (org-footnote-create-definition label))))) 271 (org-footnote-create-definition label)
272 (org-footnote-auto-adjust-maybe)))))
253 273
254(defun org-footnote-create-definition (label) 274(defun org-footnote-create-definition (label)
255 "Start the definition of a footnote with label LABEL." 275 "Start the definition of a footnote with label LABEL."
@@ -295,11 +315,16 @@ With prefix arg SPECIAL, offer additional commands in a menu."
295 (let (tmp c) 315 (let (tmp c)
296 (cond 316 (cond
297 (special 317 (special
298 (message "Footnotes: [s]ort | convert to [n]umeric | [d]elete") 318 (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s |->[n]umeric | [d]elete")
299 (setq c (read-char-exclusive)) 319 (setq c (read-char-exclusive))
300 (cond 320 (cond
301 ((equal c ?s) 321 ((equal c ?s)
302 (org-footnote-normalize 'sort)) 322 (org-footnote-normalize 'sort))
323 ((equal c ?r)
324 (org-footnote-renumber-fn:N))
325 ((equal c ?S)
326 (org-footnote-renumber-fn:N)
327 (org-footnote-normalize 'sort))
303 ((equal c ?n) 328 ((equal c ?n)
304 (org-footnote-normalize)) 329 (org-footnote-normalize))
305 ((equal c ?d) 330 ((equal c ?d)
@@ -316,14 +341,24 @@ With prefix arg SPECIAL, offer additional commands in a menu."
316;;;###autoload 341;;;###autoload
317(defun org-footnote-normalize (&optional sort-only for-preprocessor) 342(defun org-footnote-normalize (&optional sort-only for-preprocessor)
318 "Collect the footnotes in various formats and normalize them. 343 "Collect the footnotes in various formats and normalize them.
319This find the different sorts of footnotes allowed in Org, and 344This finds the different sorts of footnotes allowed in Org, and
320normalizes them to the usual [N] format that is understood by the 345normalizes them to the usual [N] format that is understood by the
321Org-mode exporters. 346Org-mode exporters.
322When SORT-ONLY is set, only sort the footnote definitions into the 347When SORT-ONLY is set, only sort the footnote definitions into the
323referenced sequence." 348referenced sequence."
324 ;; This is based on Paul's function, but rewritten. 349 ;; This is based on Paul's function, but rewritten.
325 (let ((count 0) ref def idef ref-table beg beg1 marker a before 350 (let* ((limit-level
326 ins-point) 351 (and (boundp 'org-inlinetask-min-level)
352 org-inlinetask-min-level
353 (1- org-inlinetask-min-level)))
354 (nstars (and limit-level
355 (if org-odd-levels-only
356 (and limit-level (1- (* limit-level 2)))
357 limit-level)))
358 (outline-regexp
359 (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))
360 (count 0)
361 ref def idef ref-table beg beg1 marker a before ins-point)
327 (save-excursion 362 (save-excursion
328 ;; Now find footnote references, and extract the definitions 363 ;; Now find footnote references, and extract the definitions
329 (goto-char (point-min)) 364 (goto-char (point-min))
@@ -362,8 +397,8 @@ referenced sequence."
362 (and idef 397 (and idef
363 org-footnote-fill-after-inline-note-extraction 398 org-footnote-fill-after-inline-note-extraction
364 (fill-paragraph))) 399 (fill-paragraph)))
365 (if (not a) (push (list ref marker def) ref-table)))) 400 (if (not a) (push (list ref marker def (if idef t nil)) ref-table))))
366 401
367 ;; First find and remove the footnote section 402 ;; First find and remove the footnote section
368 (goto-char (point-min)) 403 (goto-char (point-min))
369 (cond 404 (cond
@@ -386,7 +421,7 @@ referenced sequence."
386 (insert "* " org-footnote-section "\n") 421 (insert "* " org-footnote-section "\n")
387 (setq ins-point (point)))))) 422 (setq ins-point (point))))))
388 (t 423 (t
389 (if (re-search-forward 424 (if (re-search-forward
390 (concat "^" 425 (concat "^"
391 (regexp-quote org-footnote-tag-for-non-org-mode-files) 426 (regexp-quote org-footnote-tag-for-non-org-mode-files)
392 "[ \t]*$") 427 "[ \t]*$")
@@ -397,16 +432,17 @@ referenced sequence."
397 (delete-region (point) (point-max)) 432 (delete-region (point) (point-max))
398 (insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n") 433 (insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n")
399 (setq ins-point (point)))) 434 (setq ins-point (point))))
400 435
401 ;; Insert the footnotes again 436 ;; Insert the footnotes again
402 (goto-char (or ins-point (point-max))) 437 (goto-char (or ins-point (point-max)))
403 (setq ref-table (reverse ref-table)) 438 (setq ref-table (reverse ref-table))
404 (when sort-only 439 (when sort-only
405 ;; remove anonymous fotnotes from the list 440 ;; remove anonymous and inline footnotes from the list
406 (setq ref-table 441 (setq ref-table
407 (delq nil (mapcar 442 (delq nil (mapcar
408 (lambda (x) (and (car x) 443 (lambda (x) (and (car x)
409 (not (equal (car x) "fn:")) 444 (not (equal (car x) "fn:"))
445 (not (nth 3 x))
410 x)) 446 x))
411 ref-table)))) 447 ref-table))))
412 ;; Make sure each footnote has a description, or an error message. 448 ;; Make sure each footnote has a description, or an error message.
@@ -451,12 +487,12 @@ ENTRY is (fn-label num-mark definition)."
451 487
452(defun org-footnote-goto-local-insertion-point () 488(defun org-footnote-goto-local-insertion-point ()
453 "Find insertion point for footnote, just before next outline heading." 489 "Find insertion point for footnote, just before next outline heading."
454 (outline-next-heading) 490 (org-with-limited-levels (outline-next-heading))
455 (or (bolp) (newline)) 491 (or (bolp) (newline))
456 (beginning-of-line 0) 492 (beginning-of-line 0)
457 (while (and (not (bobp)) (= (char-after) ?#)) 493 (while (and (not (bobp)) (= (char-after) ?#))
458 (beginning-of-line 0)) 494 (beginning-of-line 0))
459 (if (looking-at "#\\+TBLFM:") (beginning-of-line 2)) 495 (if (looking-at "[ \t]*#\\+TBLFM:") (beginning-of-line 2))
460 (end-of-line 1) 496 (end-of-line 1)
461 (skip-chars-backward "\n\r\t ")) 497 (skip-chars-backward "\n\r\t "))
462 498
@@ -493,9 +529,42 @@ and all references of a footnote label."
493 (goto-char (point-max))) 529 (goto-char (point-max)))
494 (delete-region beg (point)) 530 (delete-region beg (point))
495 (incf ndef)))) 531 (incf ndef))))
532 (org-footnote-auto-adjust-maybe)
496 (message "%d definition(s) of and %d reference(s) of footnote %s removed" 533 (message "%d definition(s) of and %d reference(s) of footnote %s removed"
497 ndef nref label)))) 534 ndef nref label))))
498 535
536(defun org-footnote-renumber-fn:N ()
537 "Renumber the simple footnotes like fn:17 into a sequence in the document."
538 (interactive)
539 (let (map i (n 0))
540 (save-excursion
541 (save-restriction
542 (widen)
543 (goto-char (point-min))
544 (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t)
545 (setq i (string-to-number (match-string 1)))
546 (when (and (string-match "\\S-" (buffer-substring
547 (point-at-bol) (match-beginning 0)))
548 (not (assq i map)))
549 (push (cons i (number-to-string (incf n))) map)))
550 (goto-char (point-min))
551 (while (re-search-forward "\\(\\[fn:\\)\\([0-9]+\\)\\([]:]\\)" nil t)
552 (replace-match (concat "\\1" (cdr (assq (string-to-number (match-string 2)) map)) "\\3")))))))
553
554(defun org-footnote-auto-adjust-maybe ()
555 "Renumber and/or sort footnotes according to user settings."
556 (when (memq org-footnote-auto-adjust '(t renumber))
557 (org-footnote-renumber-fn:N))
558 (when (memq org-footnote-auto-adjust '(t sort))
559 (let ((label (nth 1 (org-footnote-at-definition-p))))
560 (org-footnote-normalize 'sort)
561 (when label
562 (goto-char (point-min))
563 (and (re-search-forward (concat "^\\[" (regexp-quote label) "\\]")
564 nil t)
565 (progn (insert " ")
566 (just-one-space)))))))
567
499(provide 'org-footnote) 568(provide 'org-footnote)
500 569
501;; arch-tag: 1b5954df-fb5d-4da5-8709-78d944dbfc37 570;; 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 @@
7;; Tassilo Horn <tassilo at member dot fsf dot org> 7;; Tassilo Horn <tassilo at member dot fsf dot org>
8;; Keywords: outlines, hypermedia, calendar, wp 8;; Keywords: outlines, hypermedia, calendar, wp
9;; Homepage: http://orgmode.org 9;; Homepage: http://orgmode.org
10;; Version: 6.21b 10;; Version: 6.29c
11;; 11;;
12;; This file is part of GNU Emacs. 12;; This file is part of GNU Emacs.
13;; 13;;
@@ -53,6 +53,9 @@ negates this setting for the duration of the command."
53;; Declare external functions and variables 53;; Declare external functions and variables
54(declare-function gnus-article-show-summary "gnus-art" ()) 54(declare-function gnus-article-show-summary "gnus-art" ())
55(declare-function gnus-summary-last-subject "gnus-sum" ()) 55(declare-function gnus-summary-last-subject "gnus-sum" ())
56(declare-function message-fetch-field "message" (header &optional not-all))
57(declare-function message-narrow-to-head-1 "message" nil)
58
56(defvar gnus-other-frame-object) 59(defvar gnus-other-frame-object)
57(defvar gnus-group-name) 60(defvar gnus-group-name)
58(defvar gnus-article-current) 61(defvar gnus-article-current)
@@ -125,6 +128,11 @@ If `org-store-link' was called with a prefix arg the meaning of
125 (header (with-current-buffer gnus-article-buffer 128 (header (with-current-buffer gnus-article-buffer
126 (gnus-summary-toggle-header 1) 129 (gnus-summary-toggle-header 1)
127 (goto-char (point-min)) 130 (goto-char (point-min))
131 ;; mbox files may contain a first line starting with
132 ;; "From" followed by a space, which cannot be parsed as
133 ;; header line, so we skip it.
134 (when (looking-at "From ")
135 (beginning-of-line 2))
128 (mail-header-extract-no-properties))) 136 (mail-header-extract-no-properties)))
129 (from (mail-header 'from header)) 137 (from (mail-header 'from header))
130 (message-id (org-remove-angle-brackets 138 (message-id (org-remove-angle-brackets
@@ -134,7 +142,10 @@ If `org-store-link' was called with a prefix arg the meaning of
134 (newsgroups (mail-header 'newsgroups header)) 142 (newsgroups (mail-header 'newsgroups header))
135 (x-no-archive (mail-header 'x-no-archive header)) 143 (x-no-archive (mail-header 'x-no-archive header))
136 (subject (if (eq major-mode 'gnus-article-mode) 144 (subject (if (eq major-mode 'gnus-article-mode)
137 (message-fetch-field "subject") 145 (save-restriction
146 (require 'message)
147 (message-narrow-to-head-1)
148 (message-fetch-field "subject"))
138 (gnus-summary-subject-string))) 149 (gnus-summary-subject-string)))
139 desc link) 150 desc link)
140 (org-store-link-props :type "gnus" :from from :subject subject 151 (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 @@
1;;; org-html.el --- HTML export for Org-mode
2
3;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
4;; Free Software Foundation, Inc.
5
6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org
9;; Version: 6.29c
10;;
11;; This file is part of GNU Emacs.
12;;
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;
27;;; Commentary:
28
29(require 'org-exp)
30
31(declare-function org-id-find-id-file "org-id" (id))
32(declare-function htmlize-region "ext:htmlize" (beg end))
33
34(defgroup org-export-html nil
35 "Options specific for HTML export of Org-mode files."
36 :tag "Org Export HTML"
37 :group 'org-export)
38
39(defcustom org-export-html-footnotes-section "<div id=\"footnotes\">
40<h2 class=\"footnotes\">%s: </h2>
41<div id=\"text-footnotes\">
42%s
43</div>
44</div>"
45 "Format for the footnotes section.
46Should contain a two instances of %s. The first will be replaced with the
47language-specific word for \"Footnotes\", the second one will be replaced
48by the footnotes themselves."
49 :group 'org-export-html
50 :type 'string)
51
52(defcustom org-export-html-footnote-format "<sup>%s</sup>"
53 "The format for the footnote reference.
54%s will be replaced by the footnote reference itself."
55 :group 'org-export-html
56 :type 'string)
57
58(defcustom org-export-html-coding-system nil
59 "Coding system for HTML export, defaults to buffer-file-coding-system."
60 :group 'org-export-html
61 :type 'coding-system)
62
63(defcustom org-export-html-extension "html"
64 "The extension for exported HTML files."
65 :group 'org-export-html
66 :type 'string)
67
68(defcustom org-export-html-xml-declaration
69 '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>")
70 ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>"))
71 "The extension for exported HTML files.
72%s will be replaced with the charset of the exported file.
73This may be a string, or an alist with export extensions
74and corresponding declarations."
75 :group 'org-export-html
76 :type '(choice
77 (string :tag "Single declaration")
78 (repeat :tag "Dependent on extension"
79 (cons (string :tag "Extension")
80 (string :tag "Declaration")))))
81
82(defcustom org-export-html-style-include-scripts t
83 "Non-nil means, include the javascript snippets in exported HTML files.
84The actual script is defined in `org-export-html-scripts' and should
85not be modified."
86 :group 'org-export-html
87 :type 'boolean)
88
89(defconst org-export-html-scripts
90"<script type=\"text/javascript\">
91<!--/*--><![CDATA[/*><!--*/
92 function CodeHighlightOn(elem, id)
93 {
94 var target = document.getElementById(id);
95 if(null != target) {
96 elem.cacheClassElem = elem.className;
97 elem.cacheClassTarget = target.className;
98 target.className = \"code-highlighted\";
99 elem.className = \"code-highlighted\";
100 }
101 }
102 function CodeHighlightOff(elem, id)
103 {
104 var target = document.getElementById(id);
105 if(elem.cacheClassElem)
106 elem.className = elem.cacheClassElem;
107 if(elem.cacheClassTarget)
108 target.className = elem.cacheClassTarget;
109 }
110/*]]>*///-->
111</script>"
112"Basic javascript that is needed by HTML files produced by Org-mode.")
113
114(defconst org-export-html-style-default
115"<style type=\"text/css\">
116 <!--/*--><![CDATA[/*><!--*/
117 html { font-family: Times, serif; font-size: 12pt; }
118 .title { text-align: center; }
119 .todo { color: red; }
120 .done { color: green; }
121 .tag { background-color: #add8e6; font-weight:normal }
122 .target { }
123 .timestamp { color: #bebebe; }
124 .timestamp-kwd { color: #5f9ea0; }
125 p.verse { margin-left: 3% }
126 pre {
127 border: 1pt solid #AEBDCC;
128 background-color: #F3F5F7;
129 padding: 5pt;
130 font-family: courier, monospace;
131 font-size: 90%;
132 overflow:auto;
133 }
134 table { border-collapse: collapse; }
135 td, th { vertical-align: top; }
136 dt { font-weight: bold; }
137 div.figure { padding: 0.5em; }
138 div.figure p { text-align: center; }
139 .linenr { font-size:smaller }
140 .code-highlighted {background-color:#ffff00;}
141 .org-info-js_info-navigation { border-style:none; }
142 #org-info-js_console-label { font-size:10px; font-weight:bold;
143 white-space:nowrap; }
144 .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
145 font-weight:bold; }
146 /*]]>*/-->
147</style>"
148 "The default style specification for exported HTML files.
149Please use the variables `org-export-html-style' and
150`org-export-html-style-extra' to add to this style. If you wish to not
151have the default style included, customize the variable
152`org-export-html-style-include-default'.")
153
154(defcustom org-export-html-style-include-default t
155 "Non-nil means, include the default style in exported HTML files.
156The actual style is defined in `org-export-html-style-default' and should
157not be modified. Use the variables `org-export-html-style' to add
158your own style information."
159 :group 'org-export-html
160 :type 'boolean)
161;;;###autoload
162(put 'org-export-html-style 'safe-local-variable 'booleanp)
163
164(defcustom org-export-html-style ""
165 "Org-wide style definitions for exported HTML files.
166
167This variable needs to contain the full HTML structure to provide a style,
168including the surrounding HTML tags. If you set the value of this variable,
169you should consider to include definitions for the following classes:
170 title, todo, done, timestamp, timestamp-kwd, tag, target.
171
172For example, a valid value would be:
173
174 <style type=\"text/css\">
175 <![CDATA[
176 p { font-weight: normal; color: gray; }
177 h1 { color: black; }
178 .title { text-align: center; }
179 .todo, .timestamp-kwd { color: red; }
180 .done { color: green; }
181 ]]>
182 </style>
183
184If you'd like to refer to en external style file, use something like
185
186 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
187
188As the value of this option simply gets inserted into the HTML <head> header,
189you can \"misuse\" it to add arbitrary text to the header.
190See also the variable `org-export-html-style-extra'."
191 :group 'org-export-html
192 :type 'string)
193;;;###autoload
194(put 'org-export-html-style 'safe-local-variable 'stringp)
195
196(defcustom org-export-html-style-extra ""
197 "Additional style information for HTML export.
198The value of this variable is inserted into the HTML buffer right after
199the value of `org-export-html-style'. Use this variable for per-file
200settings of style information, and do not forget to surround the style
201settings with <style>...</style> tags."
202 :group 'org-export-html
203 :type 'string)
204;;;###autoload
205(put 'org-export-html-style-extra 'safe-local-variable 'stringp)
206
207(defcustom org-export-html-tag-class-prefix ""
208 "Prefix to clas names for TODO keywords.
209Each tag gets a class given by the tag itself, with this prefix.
210The default prefix is empty because it is nice to just use the keyword
211as a class name. But if you get into conflicts with other, existing
212CSS classes, then this prefic can be very useful."
213 :group 'org-export-html
214 :type 'string)
215
216(defcustom org-export-html-todo-kwd-class-prefix ""
217 "Prefix to clas names for TODO keywords.
218Each TODO keyword gets a class given by the keyword itself, with this prefix.
219The default prefix is empty because it is nice to just use the keyword
220as a class name. But if you get into conflicts with other, existing
221CSS classes, then this prefic can be very useful."
222 :group 'org-export-html
223 :type 'string)
224
225(defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n"
226 "Format for typesetting the document title in HTML export."
227 :group 'org-export-html
228 :type 'string)
229
230(defcustom org-export-html-home/up-format
231 "<div style=\"text-align:right;font-size:70%%;white-space:nowrap;\">
232 <a accesskey=\"h\" href=\"%s\"> UP </a>
233 |
234 <a accesskey=\"H\" href=\"%s\"> HOME </a>
235</div>"
236 "Snippet used to insert the HOME and UP links. This is a format,
237the first %s will receive the UP link, the second the HOME link.
238If both `org-export-html-link-up' and `org-export-html-link-home' are
239empty, the entire snippet will be ignored."
240 :group 'org-export-html
241 :type 'string)
242
243(defcustom org-export-html-toplevel-hlevel 2
244 "The <H> level for level 1 headings in HTML export.
245This is also important for the classes that will be wrapped around headlines
246and outline structure. If this variable is 1, the top-level headlines will
247be <h1>, and the corresponding classes will be outline-1, section-number-1,
248and outline-text-1. If this is 2, all of these will get a 2 instead.
249The default for this variable is 2, because we use <h1> for formatting the
250document title."
251 :group 'org-export-html
252 :type 'string)
253
254(defcustom org-export-html-link-org-files-as-html t
255 "Non-nil means, make file links to `file.org' point to `file.html'.
256When org-mode is exporting an org-mode file to HTML, links to
257non-html files are directly put into a href tag in HTML.
258However, links to other Org-mode files (recognized by the
259extension `.org.) should become links to the corresponding html
260file, assuming that the linked org-mode file will also be
261converted to HTML.
262When nil, the links still point to the plain `.org' file."
263 :group 'org-export-html
264 :type 'boolean)
265
266(defcustom org-export-html-inline-images 'maybe
267 "Non-nil means, inline images into exported HTML pages.
268This is done using an <img> tag. When nil, an anchor with href is used to
269link to the image. If this option is `maybe', then images in links with
270an empty description will be inlined, while images with a description will
271be linked only."
272 :group 'org-export-html
273 :type '(choice (const :tag "Never" nil)
274 (const :tag "Always" t)
275 (const :tag "When there is no description" maybe)))
276
277(defcustom org-export-html-inline-image-extensions
278 '("png" "jpeg" "jpg" "gif")
279 "Extensions of image files that can be inlined into HTML."
280 :group 'org-export-html
281 :type '(repeat (string :tag "Extension")))
282
283(defcustom org-export-html-table-tag
284 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
285 "The HTML tag that is used to start a table.
286This must be a <table> tag, but you may change the options like
287borders and spacing."
288 :group 'org-export-html
289 :type 'string)
290
291(defcustom org-export-table-header-tags '("<th scope=\"%s\">" . "</th>")
292 "The opening tag for table header fields.
293This is customizable so that alignment options can be specified.
294%s will be filled with the scope of the field, either row or col.
295See also the variable `org-export-html-table-use-header-tags-for-first-column'."
296 :group 'org-export-tables
297 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
298
299(defcustom org-export-table-data-tags '("<td>" . "</td>")
300 "The opening tag for table data fields.
301This is customizable so that alignment options can be specified."
302 :group 'org-export-tables
303 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
304
305(defcustom org-export-table-row-tags '("<tr>" . "</tr>")
306 "The opening tag for table data fields.
307This is customizable so that alignment options can be specified.
308Instead of strings, these can be Lisp forms that will be evaluated
309for each row in order to construct the table row tags. During evaluation,
310the variable `head' will be true when this is a header line, nil when this
311is a body line. And the variable `nline' will contain the line number,
312starting from 1 in the first header line. For example
313
314 (setq org-export-table-row-tags
315 (cons '(if head
316 \"<tr>\"
317 (if (= (mod nline 2) 1)
318 \"<tr class=\\\"tr-odd\\\">\"
319 \"<tr class=\\\"tr-even\\\">\"))
320 \"</tr>\"))
321
322will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"."
323 :group 'org-export-tables
324 :type '(cons
325 (choice :tag "Opening tag"
326 (string :tag "Specify")
327 (sexp))
328 (choice :tag "Closing tag"
329 (string :tag "Specify")
330 (sexp))))
331
332
333
334(defcustom org-export-html-table-use-header-tags-for-first-column nil
335 "Non-nil means, format column one in tables with header tags.
336When nil, also column one will use data tags."
337 :group 'org-export-tables
338 :type 'boolean)
339
340(defcustom org-export-html-validation-link nil
341 "Non-nil means, add validationlink to postamble of HTML exported files."
342 :group 'org-export-html
343 :type '(choice
344 (const :tag "Nothing" nil)
345 (const :tag "XHTML 1.0" "<p class=\"xhtml-validation\"><a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a></p>")
346 (string :tag "Specify full HTML")))
347
348
349(defcustom org-export-html-with-timestamp nil
350 "If non-nil, write `org-export-html-html-helper-timestamp'
351into the exported HTML text. Otherwise, the buffer will just be saved
352to a file."
353 :group 'org-export-html
354 :type 'boolean)
355
356(defcustom org-export-html-html-helper-timestamp
357 "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n"
358 "The HTML tag used as timestamp delimiter for HTML-helper-mode."
359 :group 'org-export-html
360 :type 'string)
361
362(defgroup org-export-htmlize nil
363 "Options for processing examples with htmlize.el."
364 :tag "Org Export Htmlize"
365 :group 'org-export-html)
366
367(defcustom org-export-htmlize-output-type 'inline-css
368 "Output type to be used by htmlize when formatting code snippets.
369We use as default `inline-css', in order to make the resulting
370HTML self-containing.
371However, this will fail when using Emacs in batch mode for export, because
372then no rich font definitions are in place. It will also not be good if
373people with different Emacs setup contribute HTML files to a website,
374because the fonts will represent the individual setups. In these cases,
375it is much better to let Org/Htmlize assign classes only, and to use
376a style file to define the look of these classes.
377To get a start for your css file, start Emacs session and make sure that
378all the faces you are interested in are defined, for example by loading files
379in all modes you want. Then, use the command
380\\[org-export-htmlize-generate-css] to extract class definitions."
381 :group 'org-export-htmlize
382 :type '(choice (const css) (const inline-css)))
383
384(defcustom org-export-htmlize-css-font-prefix "org-"
385 "The prefix for CSS class names for htmlize font specifications."
386 :group 'org-export-htmlize
387 :type 'string)
388
389(defcustom org-export-htmlized-org-css-url nil
390 "URL pointing to a CSS file defining text colors for htmlized Emacs buffers.
391Normally when creating an htmlized version of an Org buffer, htmlize will
392create CSS to define the font colors. However, this does not work when
393converting in batch mode, and it also can look bad if different people
394with different fontification setup work on the same website.
395When this variable is non-nil, creating an htmlized version of an Org buffer
396using `org-export-as-org' will remove the internal CSS section and replace it
397with a link to this URL."
398 :group 'org-export-htmlize
399 :type '(choice
400 (const :tag "Keep internal css" nil)
401 (string :tag "URL or local href")))
402
403;;; Variables, constants, and parameter plists
404
405(defvar org-export-html-preamble nil
406 "Preamble, to be inserted just before <body>. Set by publishing functions.
407This may also be a function, building and inserting the preamble.")
408(defvar org-export-html-postamble nil
409 "Preamble, to be inserted just after </body>. Set by publishing functions.
410This may also be a function, building and inserting the postamble.")
411(defvar org-export-html-auto-preamble t
412 "Should default preamble be inserted? Set by publishing functions.")
413(defvar org-export-html-auto-postamble t
414 "Should default postamble be inserted? Set by publishing functions.")
415
416;;; Hooks
417
418(defvar org-export-html-after-blockquotes-hook nil
419 "Hook run during HTML export, after blockquote, verse, center are done.")
420
421;;; HTML export
422
423(defun org-export-html-preprocess (parameters)
424 ;; Convert LaTeX fragments to images
425 (when (and org-current-export-file
426 (plist-get parameters :LaTeX-fragments))
427 (org-format-latex
428 (concat "ltxpng/" (file-name-sans-extension
429 (file-name-nondirectory
430 org-current-export-file)))
431 org-current-export-dir nil "Creating LaTeX image %s"))
432 (message "Exporting..."))
433
434;;;###autoload
435(defun org-export-as-html-and-open (arg)
436 "Export the outline as HTML and immediately open it with a browser.
437If there is an active region, export only the region.
438The prefix ARG specifies how many levels of the outline should become
439headlines. The default is 3. Lower levels will become bulleted lists."
440 (interactive "P")
441 (org-export-as-html arg 'hidden)
442 (org-open-file buffer-file-name))
443
444;;;###autoload
445(defun org-export-as-html-batch ()
446 "Call `org-export-as-html', may be used in batch processing as
447emacs --batch
448 --load=$HOME/lib/emacs/org.el
449 --eval \"(setq org-export-headline-levels 2)\"
450 --visit=MyFile --funcall org-export-as-html-batch"
451 (org-export-as-html org-export-headline-levels 'hidden))
452
453;;;###autoload
454(defun org-export-as-html-to-buffer (arg)
455 "Call `org-export-as-html` with output to a temporary buffer.
456No file is created. The prefix ARG is passed through to `org-export-as-html'."
457 (interactive "P")
458 (org-export-as-html arg nil nil "*Org HTML Export*")
459 (when org-export-show-temporary-export-buffer
460 (switch-to-buffer-other-window "*Org HTML Export*")))
461
462;;;###autoload
463(defun org-replace-region-by-html (beg end)
464 "Assume the current region has org-mode syntax, and convert it to HTML.
465This can be used in any buffer. For example, you could write an
466itemized list in org-mode syntax in an HTML buffer and then use this
467command to convert it."
468 (interactive "r")
469 (let (reg html buf pop-up-frames)
470 (save-window-excursion
471 (if (org-mode-p)
472 (setq html (org-export-region-as-html
473 beg end t 'string))
474 (setq reg (buffer-substring beg end)
475 buf (get-buffer-create "*Org tmp*"))
476 (with-current-buffer buf
477 (erase-buffer)
478 (insert reg)
479 (org-mode)
480 (setq html (org-export-region-as-html
481 (point-min) (point-max) t 'string)))
482 (kill-buffer buf)))
483 (delete-region beg end)
484 (insert html)))
485
486;;;###autoload
487(defun org-export-region-as-html (beg end &optional body-only buffer)
488 "Convert region from BEG to END in org-mode buffer to HTML.
489If prefix arg BODY-ONLY is set, omit file header, footer, and table of
490contents, and only produce the region of converted text, useful for
491cut-and-paste operations.
492If BUFFER is a buffer or a string, use/create that buffer as a target
493of the converted HTML. If BUFFER is the symbol `string', return the
494produced HTML as a string and leave not buffer behind. For example,
495a Lisp program could call this function in the following way:
496
497 (setq html (org-export-region-as-html beg end t 'string))
498
499When called interactively, the output buffer is selected, and shown
500in a window. A non-interactive call will only return the buffer."
501 (interactive "r\nP")
502 (when (interactive-p)
503 (setq buffer "*Org HTML Export*"))
504 (let ((transient-mark-mode t) (zmacs-regions t)
505 ext-plist rtn)
506 (setq ext-plist (plist-put ext-plist :ignore-subree-p t))
507 (goto-char end)
508 (set-mark (point)) ;; to activate the region
509 (goto-char beg)
510 (setq rtn (org-export-as-html
511 nil nil ext-plist
512 buffer body-only))
513 (if (fboundp 'deactivate-mark) (deactivate-mark))
514 (if (and (interactive-p) (bufferp rtn))
515 (switch-to-buffer-other-window rtn)
516 rtn)))
517
518(defvar html-table-tag nil) ; dynamically scoped into this.
519(defvar org-par-open nil)
520;;;###autoload
521(defun org-export-as-html (arg &optional hidden ext-plist
522 to-buffer body-only pub-dir)
523 "Export the outline as a pretty HTML file.
524If there is an active region, export only the region. The prefix
525ARG specifies how many levels of the outline should become
526headlines. The default is 3. Lower levels will become bulleted
527lists. HIDDEN is obsolete and does nothing.
528EXT-PLIST is a property list with external parameters overriding
529org-mode's default settings, but still inferior to file-local
530settings. When TO-BUFFER is non-nil, create a buffer with that
531name and export to that buffer. If TO-BUFFER is the symbol
532`string', don't leave any buffer behind but just return the
533resulting HTML as a string. When BODY-ONLY is set, don't produce
534the file header and footer, simply return the content of
535<body>...</body>, without even the body tags themselves. When
536PUB-DIR is set, use this as the publishing directory."
537 (interactive "P")
538
539 ;; Make sure we have a file name when we need it.
540 (when (and (not (or to-buffer body-only))
541 (not buffer-file-name))
542 (if (buffer-base-buffer)
543 (org-set-local 'buffer-file-name
544 (with-current-buffer (buffer-base-buffer)
545 buffer-file-name))
546 (error "Need a file name to be able to export.")))
547
548 (message "Exporting...")
549 (setq-default org-todo-line-regexp org-todo-line-regexp)
550 (setq-default org-deadline-line-regexp org-deadline-line-regexp)
551 (setq-default org-done-keywords org-done-keywords)
552 (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
553 (let* ((opt-plist
554 (org-export-process-option-filters
555 (org-combine-plists (org-default-export-plist)
556 ext-plist
557 (org-infile-export-plist))))
558 (body-only (or body-only (plist-get opt-plist :body-only)))
559 (style (concat (if (plist-get opt-plist :style-include-default)
560 org-export-html-style-default)
561 (plist-get opt-plist :style)
562 (plist-get opt-plist :style-extra)
563 "\n"
564 (if (plist-get opt-plist :style-include-scripts)
565 org-export-html-scripts)))
566 (html-extension (plist-get opt-plist :html-extension))
567 (link-validate (plist-get opt-plist :link-validation-function))
568 valid thetoc have-headings first-heading-pos
569 (odd org-odd-levels-only)
570 (region-p (org-region-active-p))
571 (rbeg (and region-p (region-beginning)))
572 (rend (and region-p (region-end)))
573 (subtree-p
574 (if (plist-get opt-plist :ignore-subree-p)
575 nil
576 (when region-p
577 (save-excursion
578 (goto-char rbeg)
579 (and (org-at-heading-p)
580 (>= (org-end-of-subtree t t) rend))))))
581 (level-offset (if subtree-p
582 (save-excursion
583 (goto-char rbeg)
584 (+ (funcall outline-level)
585 (if org-odd-levels-only 1 0)))
586 0))
587 (opt-plist (setq org-export-opt-plist
588 (if subtree-p
589 (org-export-add-subtree-options opt-plist rbeg)
590 opt-plist)))
591 ;; The following two are dynamically scoped into other
592 ;; routines below.
593 (org-current-export-dir
594 (or pub-dir (org-export-directory :html opt-plist)))
595 (org-current-export-file buffer-file-name)
596 (level 0) (line "") (origline "") txt todo
597 (umax nil)
598 (umax-toc nil)
599 (filename (if to-buffer nil
600 (expand-file-name
601 (concat
602 (file-name-sans-extension
603 (or (and subtree-p
604 (org-entry-get (region-beginning)
605 "EXPORT_FILE_NAME" t))
606 (file-name-nondirectory buffer-file-name)))
607 "." html-extension)
608 (file-name-as-directory
609 (or pub-dir (org-export-directory :html opt-plist))))))
610 (current-dir (if buffer-file-name
611 (file-name-directory buffer-file-name)
612 default-directory))
613 (buffer (if to-buffer
614 (cond
615 ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
616 (t (get-buffer-create to-buffer)))
617 (find-file-noselect filename)))
618 (org-levels-open (make-vector org-level-max nil))
619 (date (plist-get opt-plist :date))
620 (author (plist-get opt-plist :author))
621 (title (or (and subtree-p (org-export-get-title-from-subtree))
622 (plist-get opt-plist :title)
623 (and (not
624 (plist-get opt-plist :skip-before-1st-heading))
625 (org-export-grab-title-from-buffer))
626 (and buffer-file-name
627 (file-name-sans-extension
628 (file-name-nondirectory buffer-file-name)))
629 "UNTITLED"))
630 (link-up (and (plist-get opt-plist :link-up)
631 (string-match "\\S-" (plist-get opt-plist :link-up))
632 (plist-get opt-plist :link-up)))
633 (link-home (and (plist-get opt-plist :link-home)
634 (string-match "\\S-" (plist-get opt-plist :link-home))
635 (plist-get opt-plist :link-home)))
636 (dummy (setq opt-plist (plist-put opt-plist :title title)))
637 (html-table-tag (plist-get opt-plist :html-table-tag))
638 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
639 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
640 (inquote nil)
641 (infixed nil)
642 (inverse nil)
643 (in-local-list nil)
644 (local-list-type nil)
645 (local-list-indent nil)
646 (llt org-plain-list-ordered-item-terminator)
647 (email (plist-get opt-plist :email))
648 (language (plist-get opt-plist :language))
649 (keywords (plist-get opt-plist :keywords))
650 (description (plist-get opt-plist :description))
651 (lang-words nil)
652 (head-count 0) cnt
653 (start 0)
654 (coding-system (and (boundp 'buffer-file-coding-system)
655 buffer-file-coding-system))
656 (coding-system-for-write (or org-export-html-coding-system
657 coding-system))
658 (save-buffer-coding-system (or org-export-html-coding-system
659 coding-system))
660 (charset (and coding-system-for-write
661 (fboundp 'coding-system-get)
662 (coding-system-get coding-system-for-write
663 'mime-charset)))
664 (region
665 (buffer-substring
666 (if region-p (region-beginning) (point-min))
667 (if region-p (region-end) (point-max))))
668 (lines
669 (org-split-string
670 (org-export-preprocess-string
671 region
672 :emph-multiline t
673 :for-html t
674 :skip-before-1st-heading
675 (plist-get opt-plist :skip-before-1st-heading)
676 :drawers (plist-get opt-plist :drawers)
677 :todo-keywords (plist-get opt-plist :todo-keywords)
678 :tags (plist-get opt-plist :tags)
679 :priority (plist-get opt-plist :priority)
680 :footnotes (plist-get opt-plist :footnotes)
681 :timestamps (plist-get opt-plist :timestamps)
682 :archived-trees
683 (plist-get opt-plist :archived-trees)
684 :select-tags (plist-get opt-plist :select-tags)
685 :exclude-tags (plist-get opt-plist :exclude-tags)
686 :add-text
687 (plist-get opt-plist :text)
688 :LaTeX-fragments
689 (plist-get opt-plist :LaTeX-fragments))
690 "[\r\n]"))
691 table-open type
692 table-buffer table-orig-buffer
693 ind item-type starter didclose
694 rpl path attr desc descp desc1 desc2 link
695 snumber fnc item-tag
696 footnotes footref-seen
697 id-file href
698 )
699
700 (let ((inhibit-read-only t))
701 (org-unmodified
702 (remove-text-properties (point-min) (point-max)
703 '(:org-license-to-kill t))))
704
705 (message "Exporting...")
706
707 (setq org-min-level (org-get-min-level lines level-offset))
708 (setq org-last-level org-min-level)
709 (org-init-section-numbers)
710
711 (cond
712 ((and date (string-match "%" date))
713 (setq date (format-time-string date)))
714 (date)
715 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
716
717 ;; Get the language-dependent settings
718 (setq lang-words (or (assoc language org-export-language-setup)
719 (assoc "en" org-export-language-setup)))
720
721 ;; Switch to the output buffer
722 (set-buffer buffer)
723 (let ((inhibit-read-only t)) (erase-buffer))
724 (fundamental-mode)
725 (org-install-letbind)
726
727 (and (fboundp 'set-buffer-file-coding-system)
728 (set-buffer-file-coding-system coding-system-for-write))
729
730 (let ((case-fold-search nil)
731 (org-odd-levels-only odd))
732 ;; create local variables for all options, to make sure all called
733 ;; functions get the correct information
734 (mapc (lambda (x)
735 (set (make-local-variable (nth 2 x))
736 (plist-get opt-plist (car x))))
737 org-export-plist-vars)
738 (setq umax (if arg (prefix-numeric-value arg)
739 org-export-headline-levels))
740 (setq umax-toc (if (integerp org-export-with-toc)
741 (min org-export-with-toc umax)
742 umax))
743 (unless body-only
744 ;; File header
745 (insert (format
746 "%s
747<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
748 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
749<html xmlns=\"http://www.w3.org/1999/xhtml\"
750lang=\"%s\" xml:lang=\"%s\">
751<head>
752%s
753<title>%s</title>
754<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
755<meta name=\"generator\" content=\"Org-mode\"/>
756<meta name=\"generated\" content=\"%s\"/>
757<meta name=\"author\" content=\"%s\"/>
758<meta name=\"description\" content=\"%s\"/>
759<meta name=\"keywords\" content=\"%s\"/>
760%s
761</head>
762<body>
763<div id=\"content\">
764"
765 (format
766 (or (and (stringp org-export-html-xml-declaration)
767 org-export-html-xml-declaration)
768 (cdr (assoc html-extension org-export-html-xml-declaration))
769 (cdr (assoc "html" org-export-html-xml-declaration))
770
771 "")
772 (or charset "iso-8859-1"))
773 language language
774 (if (or link-up link-home)
775 (concat
776 (format org-export-html-home/up-format
777 (or link-up link-home)
778 (or link-home link-up))
779 "\n")
780 "")
781 (org-html-expand title)
782 (or charset "iso-8859-1")
783 date author description keywords
784 style))
785
786 (org-export-html-insert-plist-item opt-plist :preamble opt-plist)
787
788 (when (plist-get opt-plist :auto-preamble)
789 (if title (insert (format org-export-html-title-format
790 (org-html-expand title))))))
791
792 (if (and org-export-with-toc (not body-only))
793 (progn
794 (push (format "<h%d>%s</h%d>\n"
795 org-export-html-toplevel-hlevel
796 (nth 3 lang-words)
797 org-export-html-toplevel-hlevel)
798 thetoc)
799 (push "<div id=\"text-table-of-contents\">\n" thetoc)
800 (push "<ul>\n<li>" thetoc)
801 (setq lines
802 (mapcar '(lambda (line)
803 (if (string-match org-todo-line-regexp line)
804 ;; This is a headline
805 (progn
806 (setq have-headings t)
807 (setq level (- (match-end 1) (match-beginning 1)
808 level-offset)
809 level (org-tr-level level)
810 txt (save-match-data
811 (org-html-expand
812 (org-export-cleanup-toc-line
813 (match-string 3 line))))
814 todo
815 (or (and org-export-mark-todo-in-toc
816 (match-beginning 2)
817 (not (member (match-string 2 line)
818 org-done-keywords)))
819 ; TODO, not DONE
820 (and org-export-mark-todo-in-toc
821 (= level umax-toc)
822 (org-search-todo-below
823 line lines level))))
824 (if (string-match
825 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
826 (setq txt (replace-match "&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
827 (if (string-match quote-re0 txt)
828 (setq txt (replace-match "" t t txt)))
829 (setq snumber (org-section-number level))
830 (if org-export-with-section-numbers
831 (setq txt (concat snumber " " txt)))
832 (if (<= level (max umax umax-toc))
833 (setq head-count (+ head-count 1)))
834 (if (<= level umax-toc)
835 (progn
836 (if (> level org-last-level)
837 (progn
838 (setq cnt (- level org-last-level))
839 (while (>= (setq cnt (1- cnt)) 0)
840 (push "\n<ul>\n<li>" thetoc))
841 (push "\n" thetoc)))
842 (if (< level org-last-level)
843 (progn
844 (setq cnt (- org-last-level level))
845 (while (>= (setq cnt (1- cnt)) 0)
846 (push "</li>\n</ul>" thetoc))
847 (push "\n" thetoc)))
848 ;; Check for targets
849 (while (string-match org-any-target-regexp line)
850 (setq line (replace-match
851 (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
852 t t line)))
853 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
854 (setq txt (replace-match "" t t txt)))
855 (setq href (format "sec-%s" snumber))
856 (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href))
857 (push
858 (format
859 (if todo
860 "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
861 "</li>\n<li><a href=\"#%s\">%s</a>")
862 href txt) thetoc)
863
864 (setq org-last-level level))
865 )))
866 line)
867 lines))
868 (while (> org-last-level (1- org-min-level))
869 (setq org-last-level (1- org-last-level))
870 (push "</li>\n</ul>\n" thetoc))
871 (push "</div>\n" thetoc)
872 (setq thetoc (if have-headings (nreverse thetoc) nil))))
873
874 (setq head-count 0)
875 (org-init-section-numbers)
876
877 (org-open-par)
878
879 (while (setq line (pop lines) origline line)
880 (catch 'nextline
881
882 ;; end of quote section?
883 (when (and inquote (string-match "^\\*+ " line))
884 (insert "</pre>\n")
885 (org-open-par)
886 (setq inquote nil))
887 ;; inside a quote section?
888 (when inquote
889 (insert (org-html-protect line) "\n")
890 (throw 'nextline nil))
891
892 ;; Fixed-width, verbatim lines (examples)
893 (when (and org-export-with-fixed-width
894 (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
895 (when (not infixed)
896 (setq infixed t)
897 (org-close-par-maybe)
898
899 (insert "<pre class=\"example\">\n"))
900 (insert (org-html-protect (match-string 3 line)) "\n")
901 (when (or (not lines)
902 (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
903 (car lines))))
904 (setq infixed nil)
905 (insert "</pre>\n")
906 (org-open-par))
907 (throw 'nextline nil))
908
909 (org-export-html-close-lists-maybe line)
910
911 ;; Protected HTML
912 (when (get-text-property 0 'org-protected line)
913 (let (par (ind (get-text-property 0 'original-indentation line)))
914 (when (re-search-backward
915 "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
916 (setq par (match-string 1))
917 (replace-match "\\2\n"))
918 (insert line "\n")
919 (while (and lines
920 (or (= (length (car lines)) 0)
921 (not ind)
922 (equal ind (get-text-property 0 'original-indentation (car lines))))
923 (or (= (length (car lines)) 0)
924 (get-text-property 0 'org-protected (car lines))))
925 (insert (pop lines) "\n"))
926 (and par (insert "<p>\n")))
927 (throw 'nextline nil))
928
929 ;; Blockquotes, verse, and center
930 (when (equal "ORG-BLOCKQUOTE-START" line)
931 (org-close-par-maybe)
932 (insert "<blockquote>\n")
933 (org-open-par)
934 (throw 'nextline nil))
935 (when (equal "ORG-BLOCKQUOTE-END" line)
936 (org-close-par-maybe)
937 (insert "\n</blockquote>\n")
938 (org-open-par)
939 (throw 'nextline nil))
940 (when (equal "ORG-VERSE-START" line)
941 (org-close-par-maybe)
942 (insert "\n<p class=\"verse\">\n")
943 (setq inverse t)
944 (throw 'nextline nil))
945 (when (equal "ORG-VERSE-END" line)
946 (insert "</p>\n")
947 (org-open-par)
948 (setq inverse nil)
949 (throw 'nextline nil))
950 (when (equal "ORG-CENTER-START" line)
951 (org-close-par-maybe)
952 (insert "\n<div style=\"text-align: center\">")
953 (org-open-par)
954 (throw 'nextline nil))
955 (when (equal "ORG-CENTER-END" line)
956 (org-close-par-maybe)
957 (insert "\n</div>")
958 (org-open-par)
959 (throw 'nextline nil))
960 (run-hooks 'org-export-html-after-blockquotes-hook)
961 (when inverse
962 (let ((i (org-get-string-indentation line)))
963 (if (> i 0)
964 (setq line (concat (mapconcat 'identity
965 (make-list (* 2 i) "\\nbsp") "")
966 " " (org-trim line))))
967 (unless (string-match "\\\\\\\\[ \t]*$" line)
968 (setq line (concat line "\\\\")))))
969
970 ;; make targets to anchors
971 (while (string-match
972 "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line)
973 (cond
974 ((match-end 2)
975 (setq line (replace-match
976 (format
977 "@<a name=\"%s\" id=\"%s\">@</a>"
978 (org-solidify-link-text (match-string 1 line))
979 (org-solidify-link-text (match-string 1 line)))
980 t t line)))
981 ((and org-export-with-toc (equal (string-to-char line) ?*))
982 ;; FIXME: NOT DEPENDENT on TOC?????????????????????
983 (setq line (replace-match
984 (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
985; (concat "@<i>" (match-string 1 line) "@</i> ")
986 t t line)))
987 (t
988 (setq line (replace-match
989 (concat "@<a name=\""
990 (org-solidify-link-text (match-string 1 line))
991 "\" class=\"target\">" (match-string 1 line) "@</a> ")
992 t t line)))))
993
994 (setq line (org-html-handle-time-stamps line))
995
996 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
997 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
998 ;; Also handle sub_superscripts and checkboxes
999 (or (string-match org-table-hline-regexp line)
1000 (setq line (org-html-expand line)))
1001
1002 ;; Format the links
1003 (setq start 0)
1004 (while (string-match org-bracket-link-analytic-regexp++ line start)
1005 (setq start (match-beginning 0))
1006 (setq path (save-match-data (org-link-unescape
1007 (match-string 3 line))))
1008 (setq type (cond
1009 ((match-end 2) (match-string 2 line))
1010 ((save-match-data
1011 (or (file-name-absolute-p path)
1012 (string-match "^\\.\\.?/" path)))
1013 "file")
1014 (t "internal")))
1015 (setq path (org-extract-attributes (org-link-unescape path)))
1016 (setq attr (get-text-property 0 'org-attributes path))
1017 (setq desc1 (if (match-end 5) (match-string 5 line))
1018 desc2 (if (match-end 2) (concat type ":" path) path)
1019 descp (and desc1 (not (equal desc1 desc2)))
1020 desc (or desc1 desc2))
1021 ;; Make an image out of the description if that is so wanted
1022 (when (and descp (org-file-image-p
1023 desc org-export-html-inline-image-extensions))
1024 (save-match-data
1025 (if (string-match "^file:" desc)
1026 (setq desc (substring desc (match-end 0)))))
1027 (setq desc (org-add-props
1028 (concat "<img src=\"" desc "\"/>")
1029 '(org-protected t))))
1030 ;; FIXME: do we need to unescape here somewhere?
1031 (cond
1032 ((equal type "internal")
1033 (setq rpl
1034 (concat
1035 "<a href=\""
1036 (if (= (string-to-char path) ?#) "" "#")
1037 (org-solidify-link-text
1038 (save-match-data (org-link-unescape path)) nil)
1039 "\"" attr ">"
1040 (org-export-html-format-desc desc)
1041 "</a>")))
1042 ((and (equal type "id")
1043 (setq id-file (org-id-find-id-file path)))
1044 ;; This is an id: link to another file (if it was the same file,
1045 ;; it would have become an internal link...)
1046 (save-match-data
1047 (setq id-file (file-relative-name
1048 id-file (file-name-directory org-current-export-file)))
1049 (setq id-file (concat (file-name-sans-extension id-file)
1050 "." html-extension))
1051 (setq rpl (concat "<a href=\"" id-file "#"
1052 (if (org-uuidgen-p path) "ID-")
1053 path "\""
1054 attr ">"
1055 (org-export-html-format-desc desc)
1056 "</a>"))))
1057 ((member type '("http" "https"))
1058 ;; standard URL, just check if we need to inline an image
1059 (if (and (or (eq t org-export-html-inline-images)
1060 (and org-export-html-inline-images (not descp)))
1061 (org-file-image-p
1062 path org-export-html-inline-image-extensions))
1063 (setq rpl (org-export-html-format-image
1064 (concat type ":" path) org-par-open))
1065 (setq link (concat type ":" path))
1066 (setq rpl (concat "<a href=\""
1067 (org-export-html-format-href link)
1068 "\"" attr ">"
1069 (org-export-html-format-desc desc)
1070 "</a>"))))
1071 ((member type '("ftp" "mailto" "news"))
1072 ;; standard URL
1073 (setq link (concat type ":" path))
1074 (setq rpl (concat "<a href=\""
1075 (org-export-html-format-href link)
1076 "\"" attr ">"
1077 (org-export-html-format-desc desc)
1078 "</a>")))
1079
1080 ((string= type "coderef")
1081 (setq rpl (format "<a href=\"#coderef-%s\" class=\"coderef\" onmouseover=\"CodeHighlightOn(this, 'coderef-%s');\" onmouseout=\"CodeHighlightOff(this, 'coderef-%s');\">%s</a>"
1082 path path path
1083 (format (org-export-get-coderef-format path (and descp desc))
1084 (cdr (assoc path org-export-code-refs))))))
1085
1086 ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
1087 ;; The link protocol has a function for format the link
1088 (setq rpl
1089 (save-match-data
1090 (funcall fnc (org-link-unescape path) desc1 'html))))
1091
1092 ((string= type "file")
1093 ;; FILE link
1094 (let* ((filename path)
1095 (abs-p (file-name-absolute-p filename))
1096 thefile file-is-image-p search)
1097 (save-match-data
1098 (if (string-match "::\\(.*\\)" filename)
1099 (setq search (match-string 1 filename)
1100 filename (replace-match "" t nil filename)))
1101 (setq valid
1102 (if (functionp link-validate)
1103 (funcall link-validate filename current-dir)
1104 t))
1105 (setq file-is-image-p
1106 (org-file-image-p
1107 filename org-export-html-inline-image-extensions))
1108 (setq thefile (if abs-p (expand-file-name filename) filename))
1109 (when (and org-export-html-link-org-files-as-html
1110 (string-match "\\.org$" thefile))
1111 (setq thefile (concat (substring thefile 0
1112 (match-beginning 0))
1113 "." html-extension))
1114 (if (and search
1115 ;; make sure this is can be used as target search
1116 (not (string-match "^[0-9]*$" search))
1117 (not (string-match "^\\*" search))
1118 (not (string-match "^/.*/$" search)))
1119 (setq thefile (concat thefile "#"
1120 (org-solidify-link-text
1121 (org-link-unescape search)))))
1122 (when (string-match "^file:" desc)
1123 (setq desc (replace-match "" t t desc))
1124 (if (string-match "\\.org$" desc)
1125 (setq desc (replace-match "" t t desc))))))
1126 (setq rpl (if (and file-is-image-p
1127 (or (eq t org-export-html-inline-images)
1128 (and org-export-html-inline-images
1129 (not descp))))
1130 (progn
1131 (message "image %s %s" thefile org-par-open)
1132 (org-export-html-format-image thefile org-par-open))
1133 (concat "<a href=\"" thefile "\"" attr ">"
1134 (org-export-html-format-desc desc)
1135 "</a>")))
1136 (if (not valid) (setq rpl desc))))
1137
1138 (t
1139 ;; just publish the path, as default
1140 (setq rpl (concat "<i>&lt;" type ":"
1141 (save-match-data (org-link-unescape path))
1142 "&gt;</i>"))))
1143 (setq line (replace-match rpl t t line)
1144 start (+ start (length rpl))))
1145
1146 ;; TODO items
1147 (if (and (string-match org-todo-line-regexp line)
1148 (match-beginning 2))
1149
1150 (setq line
1151 (concat (substring line 0 (match-beginning 2))
1152 "<span class=\""
1153 (if (member (match-string 2 line)
1154 org-done-keywords)
1155 "done" "todo")
1156 " " (match-string 2 line)
1157 "\"> " (org-export-html-get-todo-kwd-class-name
1158 (match-string 2 line))
1159 "</span>" (substring line (match-end 2)))))
1160
1161 ;; Does this contain a reference to a footnote?
1162 (when org-export-with-footnotes
1163 (setq start 0)
1164 (while (string-match "\\([^* \t].*\\)?\\[\\([0-9]+\\)\\]" line start)
1165 (if (get-text-property (match-beginning 2) 'org-protected line)
1166 (setq start (match-end 2))
1167 (let ((n (match-string 2 line)) extra a)
1168 (if (setq a (assoc n footref-seen))
1169 (progn
1170 (setcdr a (1+ (cdr a)))
1171 (setq extra (format ".%d" (cdr a))))
1172 (setq extra "")
1173 (push (cons n 1) footref-seen))
1174 (setq line
1175 (replace-match
1176 (format
1177 (concat (if (match-string 1 line) "%s" "")
1178 (format org-export-html-footnote-format
1179 "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>"))
1180 (match-string 1 line) n extra n n)
1181 t t line))))))
1182
1183 (cond
1184 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
1185 ;; This is a headline
1186 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
1187 level-offset))
1188 txt (match-string 2 line))
1189 (if (string-match quote-re0 txt)
1190 (setq txt (replace-match "" t t txt)))
1191 (if (<= level (max umax umax-toc))
1192 (setq head-count (+ head-count 1)))
1193 (when in-local-list
1194 ;; Close any local lists before inserting a new header line
1195 (while local-list-type
1196 (org-close-li (car local-list-type))
1197 (insert (format "</%sl>\n" (car local-list-type)))
1198 (pop local-list-type))
1199 (setq local-list-indent nil
1200 in-local-list nil))
1201 (setq first-heading-pos (or first-heading-pos (point)))
1202 (org-html-level-start level txt umax
1203 (and org-export-with-toc (<= level umax))
1204 head-count)
1205
1206 ;; QUOTES
1207 (when (string-match quote-re line)
1208 (org-close-par-maybe)
1209 (insert "<pre>")
1210 (setq inquote t)))
1211
1212 ((string-match "^[ \t]*- __+[ \t]*$" line)
1213 ;; Explicit list closure
1214 (when local-list-type
1215 (let ((ind (org-get-indentation line)))
1216 (while (and local-list-indent
1217 (<= ind (car local-list-indent)))
1218 (org-close-li (car local-list-type))
1219 (insert (format "</%sl>\n" (car local-list-type)))
1220 (pop local-list-type)
1221 (pop local-list-indent))
1222 (or local-list-indent (setq in-local-list nil))))
1223 (throw 'nextline nil))
1224
1225 ((and org-export-with-tables
1226 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
1227 (when (not table-open)
1228 ;; New table starts
1229 (setq table-open t table-buffer nil table-orig-buffer nil))
1230
1231 ;; Accumulate lines
1232 (setq table-buffer (cons line table-buffer)
1233 table-orig-buffer (cons origline table-orig-buffer))
1234 (when (or (not lines)
1235 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
1236 (car lines))))
1237 (setq table-open nil
1238 table-buffer (nreverse table-buffer)
1239 table-orig-buffer (nreverse table-orig-buffer))
1240 (org-close-par-maybe)
1241 (insert (org-format-table-html table-buffer table-orig-buffer))))
1242 (t
1243 ;; Normal lines
1244 (when (string-match
1245 (cond
1246 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
1247 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
1248 ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
1249 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
1250 line)
1251 (setq ind (or (get-text-property 0 'original-indentation line)
1252 (org-get-string-indentation line))
1253 item-type (if (match-beginning 4) "o" "u")
1254 starter (if (match-beginning 2)
1255 (substring (match-string 2 line) 0 -1))
1256 line (substring line (match-beginning 5))
1257 item-tag nil)
1258 (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line))
1259 (setq item-type "d"
1260 item-tag (match-string 1 line)
1261 line (substring line (match-end 0))))
1262 (when (and (not (equal item-type "d"))
1263 (not (string-match "[^ \t]" line)))
1264 ;; empty line. Pretend indentation is large.
1265 (setq ind (if org-empty-line-terminates-plain-lists
1266 0
1267 (1+ (or (car local-list-indent) 1)))))
1268 (setq didclose nil)
1269 (while (and in-local-list
1270 (or (and (= ind (car local-list-indent))
1271 (not starter))
1272 (< ind (car local-list-indent))))
1273 (setq didclose t)
1274 (org-close-li (car local-list-type))
1275 (insert (format "</%sl>\n" (car local-list-type)))
1276 (pop local-list-type) (pop local-list-indent)
1277 (setq in-local-list local-list-indent))
1278 (cond
1279 ((and starter
1280 (or (not in-local-list)
1281 (> ind (car local-list-indent))))
1282 ;; Start new (level of) list
1283 (org-close-par-maybe)
1284 (insert (cond
1285 ((equal item-type "u") "<ul>\n<li>\n")
1286 ((equal item-type "o") "<ol>\n<li>\n")
1287 ((equal item-type "d")
1288 (format "<dl>\n<dt>%s</dt><dd>\n" item-tag))))
1289 (push item-type local-list-type)
1290 (push ind local-list-indent)
1291 (setq in-local-list t))
1292 (starter
1293 ;; continue current list
1294 (org-close-li (car local-list-type))
1295 (insert (cond
1296 ((equal (car local-list-type) "d")
1297 (format "<dt>%s</dt><dd>\n" (or item-tag "???")))
1298 (t "<li>\n"))))
1299 (didclose
1300 ;; we did close a list, normal text follows: need <p>
1301 (org-open-par)))
1302 (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
1303 (setq line
1304 (replace-match
1305 (if (equal (match-string 1 line) "X")
1306 "<b>[X]</b>"
1307 "<b>[<span style=\"visibility:hidden;\">X</span>]</b>")
1308 t t line))))
1309
1310 ;; Horizontal line
1311 (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
1312 (if org-par-open
1313 (insert "\n</p>\n<hr/>\n<p>\n")
1314 (insert "\n<hr/>\n"))
1315 (throw 'nextline nil))
1316
1317 ;; Empty lines start a new paragraph. If hand-formatted lists
1318 ;; are not fully interpreted, lines starting with "-", "+", "*"
1319 ;; also start a new paragraph.
1320 (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
1321
1322 ;; Is this the start of a footnote?
1323 (when org-export-with-footnotes
1324 (when (and (boundp 'footnote-section-tag-regexp)
1325 (string-match (concat "^" footnote-section-tag-regexp)
1326 line))
1327 ;; ignore this line
1328 (throw 'nextline nil))
1329 (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
1330 (org-close-par-maybe)
1331 (let ((n (match-string 1 line)))
1332 (setq org-par-open t
1333 line (replace-match
1334 (concat "<p class=\"footnote\">"
1335 (format org-export-html-footnote-format
1336 "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>"
1337 n n n) t t line))))))
1338 ;; Check if the line break needs to be conserved
1339 (cond
1340 ((string-match "\\\\\\\\[ \t]*$" line)
1341 (setq line (replace-match "<br/>" t t line)))
1342 (org-export-preserve-breaks
1343 (setq line (concat line "<br/>"))))
1344
1345 ;; Check if a paragraph should be started
1346 (let ((start 0))
1347 (while (and org-par-open
1348 (string-match "\\\\par\\>" line start))
1349 ;; Leave a space in the </p> so that the footnote matcher
1350 ;; does not see this.
1351 (if (not (get-text-property (match-beginning 0)
1352 'org-protected line))
1353 (setq line (replace-match "</p ><p >" t t line)))
1354 (setq start (match-end 0))))
1355
1356 (insert line "\n")))))
1357
1358 ;; Properly close all local lists and other lists
1359 (when inquote
1360 (insert "</pre>\n")
1361 (org-open-par))
1362 (when in-local-list
1363 ;; Close any local lists before inserting a new header line
1364 (while local-list-type
1365 (org-close-li (car local-list-type))
1366 (insert (format "</%sl>\n" (car local-list-type)))
1367 (pop local-list-type))
1368 (setq local-list-indent nil
1369 in-local-list nil))
1370 (org-html-level-start 1 nil umax
1371 (and org-export-with-toc (<= level umax))
1372 head-count)
1373 ;; the </div> to close the last text-... div.
1374 (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
1375
1376 (save-excursion
1377 (goto-char (point-min))
1378 (while (re-search-forward "<p class=\"footnote\">[^\000]*?\\(</p>\\|\\'\\)" nil t)
1379 (push (match-string 0) footnotes)
1380 (replace-match "" t t)))
1381 (when footnotes
1382 (insert (format org-export-html-footnotes-section
1383 (nth 4 lang-words)
1384 (mapconcat 'identity (nreverse footnotes) "\n"))
1385 "\n"))
1386 (let ((bib (org-export-html-get-bibliography)))
1387 (when bib
1388 (insert "\n" bib "\n")))
1389 (unless body-only
1390 (when (plist-get opt-plist :auto-postamble)
1391 (insert "<div id=\"postamble\">\n")
1392 (when (and org-export-author-info author)
1393 (insert "<p class=\"author\"> "
1394 (nth 1 lang-words) ": " author "\n")
1395 (when email
1396 (if (listp (split-string email ",+ *"))
1397 (mapc (lambda(e)
1398 (insert "<a href=\"mailto:" e "\">&lt;"
1399 e "&gt;</a>\n"))
1400 (split-string email ",+ *"))
1401 (insert "<a href=\"mailto:" email "\">&lt;"
1402 email "&gt;</a>\n")))
1403 (insert "</p>\n"))
1404 (when (and date org-export-time-stamp-file)
1405 (insert "<p class=\"date\"> "
1406 (nth 2 lang-words) ": "
1407 date "</p>\n"))
1408 (when org-export-creator-info
1409 (insert (format "<p class=\"creator\">HTML generated by org-mode %s in emacs %s</p>\n"
1410 org-version emacs-major-version)))
1411 (when org-export-html-validation-link
1412 (insert org-export-html-validation-link "\n"))
1413 (insert "</div>"))
1414
1415 (if org-export-html-with-timestamp
1416 (insert org-export-html-html-helper-timestamp))
1417 (org-export-html-insert-plist-item opt-plist :postamble opt-plist)
1418 (insert "\n</div>\n</body>\n</html>\n"))
1419
1420 (unless (plist-get opt-plist :buffer-will-be-killed)
1421 (normal-mode)
1422 (if (eq major-mode default-major-mode) (html-mode)))
1423
1424 ;; insert the table of contents
1425 (goto-char (point-min))
1426 (when thetoc
1427 (if (or (re-search-forward
1428 "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
1429 (re-search-forward
1430 "\\[TABLE-OF-CONTENTS\\]" nil t))
1431 (progn
1432 (goto-char (match-beginning 0))
1433 (replace-match ""))
1434 (goto-char first-heading-pos)
1435 (when (looking-at "\\s-*</p>")
1436 (goto-char (match-end 0))
1437 (insert "\n")))
1438 (insert "<div id=\"table-of-contents\">\n")
1439 (mapc 'insert thetoc)
1440 (insert "</div>\n"))
1441 ;; remove empty paragraphs and lists
1442 (goto-char (point-min))
1443 (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
1444 (replace-match ""))
1445 (goto-char (point-min))
1446 (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
1447 (replace-match ""))
1448 (goto-char (point-min))
1449 (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t)
1450 (replace-match ""))
1451 ;; Convert whitespace place holders
1452 (goto-char (point-min))
1453 (let (beg end n)
1454 (while (setq beg (next-single-property-change (point) 'org-whitespace))
1455 (setq n (get-text-property beg 'org-whitespace)
1456 end (next-single-property-change beg 'org-whitespace))
1457 (goto-char beg)
1458 (delete-region beg end)
1459 (insert (format "<span style=\"visibility:hidden;\">%s</span>"
1460 (make-string n ?x)))))
1461 (or to-buffer (save-buffer))
1462 (goto-char (point-min))
1463 (or (org-export-push-to-kill-ring "HTML")
1464 (message "Exporting... done"))
1465 (if (eq to-buffer 'string)
1466 (prog1 (buffer-substring (point-min) (point-max))
1467 (kill-buffer (current-buffer)))
1468 (current-buffer)))))
1469
1470(defun org-export-html-insert-plist-item (plist key &rest args)
1471 (let ((item (plist-get plist key)))
1472 (cond ((functionp item)
1473 (apply item args))
1474 (item
1475 (insert item)))))
1476
1477(defun org-export-html-format-href (s)
1478 "Make sure the S is valid as a href reference in an XHTML document."
1479 (save-match-data
1480 (let ((start 0))
1481 (while (string-match "&" s start)
1482 (setq start (+ (match-beginning 0) 3)
1483 s (replace-match "&amp;" t t s)))))
1484 s)
1485
1486(defun org-export-html-format-desc (s)
1487 "Make sure the S is valid as a description in a link."
1488 (if (and s (not (get-text-property 1 'org-protected s)))
1489 (save-match-data
1490 (org-html-do-expand s))
1491 s))
1492
1493(defun org-export-html-format-image (src par-open)
1494 "Create image tag with source and attributes."
1495 (save-match-data
1496 (if (string-match "^ltxpng/" src)
1497 (format "<img src=\"%s\"/>" src)
1498 (let* ((caption (org-find-text-property-in-string 'org-caption src))
1499 (attr (org-find-text-property-in-string 'org-attributes src))
1500 (label (org-find-text-property-in-string 'org-label src)))
1501 (format "%s<div %sclass=\"figure\">
1502<p><img src=\"%s\"%s /></p>%s
1503</div>%s"
1504 (if org-par-open "</p>\n" "")
1505 (if label (format "id=\"%s\" " label) "")
1506 src
1507 (if (string-match "\\<alt=" (or attr ""))
1508 (concat " " attr )
1509 (concat " " attr " alt=\"" src "\""))
1510 (if caption (concat "\n<p>" caption "</p>") "")
1511 (if org-par-open "\n<p>" ""))))))
1512
1513(defun org-export-html-get-bibliography ()
1514 "Find bibliography, cut it out and return it."
1515 (catch 'exit
1516 (let (beg end (cnt 1) bib)
1517 (save-excursion
1518 (goto-char (point-min))
1519 (when (re-search-forward "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t)
1520 (setq beg (match-beginning 0))
1521 (while (re-search-forward "</?div\\>" nil t)
1522 (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1)))
1523 (when (= cnt 0)
1524 (and (looking-at ">") (forward-char 1))
1525 (setq bib (buffer-substring beg (point)))
1526 (delete-region beg (point))
1527 (throw 'exit bib))))
1528 nil))))
1529
1530(defvar org-table-number-regexp) ; defined in org-table.el
1531(defun org-format-table-html (lines olines)
1532 "Find out which HTML converter to use and return the HTML code."
1533 (if (stringp lines)
1534 (setq lines (org-split-string lines "\n")))
1535 (if (string-match "^[ \t]*|" (car lines))
1536 ;; A normal org table
1537 (org-format-org-table-html lines)
1538 ;; Table made by table.el - test for spanning
1539 (let* ((hlines (delq nil (mapcar
1540 (lambda (x)
1541 (if (string-match "^[ \t]*\\+-" x) x
1542 nil))
1543 lines)))
1544 (first (car hlines))
1545 (ll (and (string-match "\\S-+" first)
1546 (match-string 0 first)))
1547 (re (concat "^[ \t]*" (regexp-quote ll)))
1548 (spanning (delq nil (mapcar (lambda (x) (not (string-match re x)))
1549 hlines))))
1550 (if (and (not spanning)
1551 (not org-export-prefer-native-exporter-for-tables))
1552 ;; We can use my own converter with HTML conversions
1553 (org-format-table-table-html lines)
1554 ;; Need to use the code generator in table.el, with the original text.
1555 (org-format-table-table-html-using-table-generate-source olines)))))
1556
1557(defvar org-table-number-fraction) ; defined in org-table.el
1558(defun org-format-org-table-html (lines &optional splice)
1559 "Format a table into HTML."
1560 (require 'org-table)
1561 ;; Get rid of hlines at beginning and end
1562 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1563 (setq lines (nreverse lines))
1564 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1565 (setq lines (nreverse lines))
1566 (when org-export-table-remove-special-lines
1567 ;; Check if the table has a marking column. If yes remove the
1568 ;; column and the special lines
1569 (setq lines (org-table-clean-before-export lines)))
1570
1571 (let* ((caption (or (get-text-property 0 'org-caption (car lines))
1572 (get-text-property (or (next-single-property-change
1573 0 'org-caption (car lines))
1574 0)
1575 'org-caption (car lines))))
1576 (attributes (or (get-text-property 0 'org-attributes (car lines))
1577 (get-text-property (or (next-single-property-change
1578 0 'org-attributes (car lines))
1579 0)
1580 'org-attributes (car lines))))
1581 (html-table-tag (org-export-splice-attributes
1582 html-table-tag attributes))
1583 (head (and org-export-highlight-first-table-line
1584 (delq nil (mapcar
1585 (lambda (x) (string-match "^[ \t]*|-" x))
1586 (cdr lines)))))
1587
1588 (nline 0) fnum i
1589 tbopen line fields html gr colgropen rowstart rowend)
1590 (if splice (setq head nil))
1591 (unless splice (push (if head "<thead>" "<tbody>") html))
1592 (setq tbopen t)
1593 (while (setq line (pop lines))
1594 (catch 'next-line
1595 (if (string-match "^[ \t]*|-" line)
1596 (progn
1597 (unless splice
1598 (push (if head "</thead>" "</tbody>") html)
1599 (if lines (push "<tbody>" html) (setq tbopen nil)))
1600 (setq head nil) ;; head ends here, first time around
1601 ;; ignore this line
1602 (throw 'next-line t)))
1603 ;; Break the line into fields
1604 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
1605 (unless fnum (setq fnum (make-vector (length fields) 0)))
1606 (setq nline (1+ nline) i -1
1607 rowstart (eval (car org-export-table-row-tags))
1608 rowend (eval (cdr org-export-table-row-tags)))
1609 (push (concat rowstart
1610 (mapconcat
1611 (lambda (x)
1612 (setq i (1+ i))
1613 (if (and (< i nline)
1614 (string-match org-table-number-regexp x))
1615 (incf (aref fnum i)))
1616 (cond
1617 (head
1618 (concat
1619 (format (car org-export-table-header-tags) "col")
1620 x
1621 (cdr org-export-table-header-tags)))
1622 ((and (= i 0) org-export-html-table-use-header-tags-for-first-column)
1623 (concat
1624 (format (car org-export-table-header-tags) "row")
1625 x
1626 (cdr org-export-table-header-tags)))
1627 (t
1628 (concat (car org-export-table-data-tags) x
1629 (cdr org-export-table-data-tags)))))
1630 fields "")
1631 rowend)
1632 html)))
1633 (unless splice (if tbopen (push "</tbody>" html)))
1634 (unless splice (push "</table>\n" html))
1635 (setq html (nreverse html))
1636 (unless splice
1637 ;; Put in col tags with the alignment (unfortuntely often ignored...)
1638 (unless (car org-table-colgroup-info)
1639 (setq org-table-colgroup-info
1640 (cons :start (cdr org-table-colgroup-info))))
1641 (push (mapconcat
1642 (lambda (x)
1643 (setq gr (pop org-table-colgroup-info))
1644 (format "%s<col align=\"%s\"></col>%s"
1645 (if (memq gr '(:start :startend))
1646 (prog1
1647 (if colgropen "</colgroup>\n<colgroup>" "<colgroup>")
1648 (setq colgropen t))
1649 "")
1650 (if (> (/ (float x) nline) org-table-number-fraction)
1651 "right" "left")
1652 (if (memq gr '(:end :startend))
1653 (progn (setq colgropen nil) "</colgroup>")
1654 "")))
1655 fnum "")
1656 html)
1657 (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html)))))
1658 ;; Since the output of HTML table formatter can also be used in
1659 ;; DocBook document, we want to always include the caption to make
1660 ;; DocBook XML file valid.
1661 (push (format "<caption>%s</caption>" (or caption "")) html)
1662 (push html-table-tag html))
1663 (concat (mapconcat 'identity html "\n") "\n")))
1664
1665(defun org-export-splice-attributes (tag attributes)
1666 "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG."
1667 (if (not attributes)
1668 tag
1669 (let (oldatt newatt)
1670 (setq oldatt (org-extract-attributes-from-string tag)
1671 tag (pop oldatt)
1672 newatt (cdr (org-extract-attributes-from-string attributes)))
1673 (while newatt
1674 (setq oldatt (plist-put oldatt (pop newatt) (pop newatt))))
1675 (if (string-match ">" tag)
1676 (setq tag
1677 (replace-match (concat (org-attributes-to-string oldatt) ">")
1678 t t tag)))
1679 tag)))
1680
1681(defun org-format-table-table-html (lines)
1682 "Format a table generated by table.el into HTML.
1683This conversion does *not* use `table-generate-source' from table.el.
1684This has the advantage that Org-mode's HTML conversions can be used.
1685But it has the disadvantage, that no cell- or row-spanning is allowed."
1686 (let (line field-buffer
1687 (head org-export-highlight-first-table-line)
1688 fields html empty i)
1689 (setq html (concat html-table-tag "\n"))
1690 (while (setq line (pop lines))
1691 (setq empty "&nbsp;")
1692 (catch 'next-line
1693 (if (string-match "^[ \t]*\\+-" line)
1694 (progn
1695 (if field-buffer
1696 (progn
1697 (setq
1698 html
1699 (concat
1700 html
1701 "<tr>"
1702 (mapconcat
1703 (lambda (x)
1704 (if (equal x "") (setq x empty))
1705 (if head
1706 (concat
1707 (format (car org-export-table-header-tags) "col")
1708 x
1709 (cdr org-export-table-header-tags))
1710 (concat (car org-export-table-data-tags) x
1711 (cdr org-export-table-data-tags))))
1712 field-buffer "\n")
1713 "</tr>\n"))
1714 (setq head nil)
1715 (setq field-buffer nil)))
1716 ;; Ignore this line
1717 (throw 'next-line t)))
1718 ;; Break the line into fields and store the fields
1719 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
1720 (if field-buffer
1721 (setq field-buffer (mapcar
1722 (lambda (x)
1723 (concat x "<br/>" (pop fields)))
1724 field-buffer))
1725 (setq field-buffer fields))))
1726 (setq html (concat html "</table>\n"))
1727 html))
1728
1729(defun org-format-table-table-html-using-table-generate-source (lines)
1730 "Format a table into html, using `table-generate-source' from table.el.
1731This has the advantage that cell- or row-spanning is allowed.
1732But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
1733 (require 'table)
1734 (with-current-buffer (get-buffer-create " org-tmp1 ")
1735 (erase-buffer)
1736 (insert (mapconcat 'identity lines "\n"))
1737 (goto-char (point-min))
1738 (if (not (re-search-forward "|[^+]" nil t))
1739 (error "Error processing table"))
1740 (table-recognize-table)
1741 (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
1742 (table-generate-source 'html " org-tmp2 ")
1743 (set-buffer " org-tmp2 ")
1744 (buffer-substring (point-min) (point-max))))
1745
1746(defun org-export-splice-style (style extra)
1747 "Splice EXTRA into STYLE, just before \"</style>\"."
1748 (if (and (stringp extra)
1749 (string-match "\\S-" extra)
1750 (string-match "</style>" style))
1751 (concat (substring style 0 (match-beginning 0))
1752 "\n" extra "\n"
1753 (substring style (match-beginning 0)))
1754 style))
1755
1756(defun org-html-handle-time-stamps (s)
1757 "Format time stamps in string S, or remove them."
1758 (catch 'exit
1759 (let (r b)
1760 (while (string-match org-maybe-keyword-time-regexp s)
1761 (or b (setq b (substring s 0 (match-beginning 0))))
1762 (setq r (concat
1763 r (substring s 0 (match-beginning 0))
1764 " @<span class=\"timestamp-wrapper\">"
1765 (if (match-end 1)
1766 (format "@<span class=\"timestamp-kwd\">%s @</span>"
1767 (match-string 1 s)))
1768 (format " @<span class=\"timestamp\">%s@</span>"
1769 (substring
1770 (org-translate-time (match-string 3 s)) 1 -1))
1771 "@</span>")
1772 s (substring s (match-end 0))))
1773 ;; Line break if line started and ended with time stamp stuff
1774 (if (not r)
1775 s
1776 (setq r (concat r s))
1777 (unless (string-match "\\S-" (concat b s))
1778 (setq r (concat r "@<br/>")))
1779 r))))
1780
1781(defvar htmlize-buffer-places) ; from htmlize.el
1782(defun org-export-htmlize-region-for-paste (beg end)
1783 "Convert the region to HTML, using htmlize.el.
1784This is much like `htmlize-region-for-paste', only that it uses
1785the settings define in the org-... variables."
1786 (let* ((htmlize-output-type org-export-htmlize-output-type)
1787 (htmlize-css-name-prefix org-export-htmlize-css-font-prefix)
1788 (htmlbuf (htmlize-region beg end)))
1789 (unwind-protect
1790 (with-current-buffer htmlbuf
1791 (buffer-substring (plist-get htmlize-buffer-places 'content-start)
1792 (plist-get htmlize-buffer-places 'content-end)))
1793 (kill-buffer htmlbuf))))
1794
1795;;;###autoload
1796(defun org-export-htmlize-generate-css ()
1797 "Create the CSS for all font definitions in the current Emacs session.
1798Use this to create face definitions in your CSS style file that can then
1799be used by code snippets transformed by htmlize.
1800This command just produces a buffer that contains class definitions for all
1801faces used in the current Emacs session. You can copy and paste the ones you
1802need into your CSS file.
1803
1804If you then set `org-export-htmlize-output-type' to `css', calls to
1805the function `org-export-htmlize-region-for-paste' will produce code
1806that uses these same face definitions."
1807 (interactive)
1808 (require 'htmlize)
1809 (and (get-buffer "*html*") (kill-buffer "*html*"))
1810 (with-temp-buffer
1811 (let ((fl (face-list))
1812 (htmlize-css-name-prefix "org-")
1813 (htmlize-output-type 'css)
1814 f i)
1815 (while (setq f (pop fl)
1816 i (and f (face-attribute f :inherit)))
1817 (when (and (symbolp f) (or (not i) (not (listp i))))
1818 (insert (org-add-props (copy-sequence "1") nil 'face f))))
1819 (htmlize-region (point-min) (point-max))))
1820 (switch-to-buffer "*html*")
1821 (goto-char (point-min))
1822 (if (re-search-forward "<style" nil t)
1823 (delete-region (point-min) (match-beginning 0)))
1824 (if (re-search-forward "</style>" nil t)
1825 (delete-region (1+ (match-end 0)) (point-max)))
1826 (beginning-of-line 1)
1827 (if (looking-at " +") (replace-match ""))
1828 (goto-char (point-min)))
1829
1830(defun org-html-protect (s)
1831 ;; convert & to &amp;, < to &lt; and > to &gt;
1832 (let ((start 0))
1833 (while (string-match "&" s start)
1834 (setq s (replace-match "&amp;" t t s)
1835 start (1+ (match-beginning 0))))
1836 (while (string-match "<" s)
1837 (setq s (replace-match "&lt;" t t s)))
1838 (while (string-match ">" s)
1839 (setq s (replace-match "&gt;" t t s)))
1840; (while (string-match "\"" s)
1841; (setq s (replace-match "&quot;" t t s)))
1842 )
1843 s)
1844
1845(defun org-html-expand (string)
1846 "Prepare STRING for HTML export. Applies all active conversions.
1847If there are links in the string, don't modify these."
1848 (let* ((re (concat org-bracket-link-regexp "\\|"
1849 (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$")))
1850 m s l res)
1851 (while (setq m (string-match re string))
1852 (setq s (substring string 0 m)
1853 l (match-string 0 string)
1854 string (substring string (match-end 0)))
1855 (push (org-html-do-expand s) res)
1856 (push l res))
1857 (push (org-html-do-expand string) res)
1858 (apply 'concat (nreverse res))))
1859
1860(defun org-html-do-expand (s)
1861 "Apply all active conversions to translate special ASCII to HTML."
1862 (setq s (org-html-protect s))
1863 (if org-export-html-expand
1864 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
1865 (setq s (replace-match "<\\1>" t nil s))))
1866 (if org-export-with-emphasize
1867 (setq s (org-export-html-convert-emphasize s)))
1868 (if org-export-with-special-strings
1869 (setq s (org-export-html-convert-special-strings s)))
1870 (if org-export-with-sub-superscripts
1871 (setq s (org-export-html-convert-sub-super s)))
1872 (if org-export-with-TeX-macros
1873 (let ((start 0) wd ass)
1874 (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?"
1875 s start))
1876 (if (get-text-property (match-beginning 0) 'org-protected s)
1877 (setq start (match-end 0))
1878 (setq wd (match-string 1 s))
1879 (if (setq ass (assoc wd org-html-entities))
1880 (setq s (replace-match (or (cdr ass)
1881 (concat "&" (car ass) ";"))
1882 t t s))
1883 (setq start (+ start (length wd))))))))
1884 s)
1885
1886(defconst org-export-html-special-string-regexps
1887 '(("\\\\-" . "&shy;")
1888 ("---\\([^-]\\)" . "&mdash;\\1")
1889 ("--\\([^-]\\)" . "&ndash;\\1")
1890 ("\\.\\.\\." . "&hellip;"))
1891 "Regular expressions for special string conversion.")
1892
1893(defun org-export-html-convert-special-strings (string)
1894 "Convert special characters in STRING to HTML."
1895 (let ((all org-export-html-special-string-regexps)
1896 e a re rpl start)
1897 (while (setq a (pop all))
1898 (setq re (car a) rpl (cdr a) start 0)
1899 (while (string-match re string start)
1900 (if (get-text-property (match-beginning 0) 'org-protected string)
1901 (setq start (match-end 0))
1902 (setq string (replace-match rpl t nil string)))))
1903 string))
1904
1905(defun org-export-html-convert-sub-super (string)
1906 "Convert sub- and superscripts in STRING to HTML."
1907 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
1908 (while (string-match org-match-substring-regexp string s)
1909 (cond
1910 ((and requireb (match-end 8)) (setq s (match-end 2)))
1911 ((get-text-property (match-beginning 2) 'org-protected string)
1912 (setq s (match-end 2)))
1913 (t
1914 (setq s (match-end 1)
1915 key (if (string= (match-string 2 string) "_") "sub" "sup")
1916 c (or (match-string 8 string)
1917 (match-string 6 string)
1918 (match-string 5 string))
1919 string (replace-match
1920 (concat (match-string 1 string)
1921 "<" key ">" c "</" key ">")
1922 t t string)))))
1923 (while (string-match "\\\\\\([_^]\\)" string)
1924 (setq string (replace-match (match-string 1 string) t t string)))
1925 string))
1926
1927(defun org-export-html-convert-emphasize (string)
1928 "Apply emphasis."
1929 (let ((s 0) rpl)
1930 (while (string-match org-emph-re string s)
1931 (if (not (equal
1932 (substring string (match-beginning 3) (1+ (match-beginning 3)))
1933 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
1934 (setq s (match-beginning 0)
1935 rpl
1936 (concat
1937 (match-string 1 string)
1938 (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
1939 (match-string 4 string)
1940 (nth 3 (assoc (match-string 3 string)
1941 org-emphasis-alist))
1942 (match-string 5 string))
1943 string (replace-match rpl t t string)
1944 s (+ s (- (length rpl) 2)))
1945 (setq s (1+ s))))
1946 string))
1947
1948(defun org-open-par ()
1949 "Insert <p>, but first close previous paragraph if any."
1950 (org-close-par-maybe)
1951 (insert "\n<p>")
1952 (setq org-par-open t))
1953(defun org-close-par-maybe ()
1954 "Close paragraph if there is one open."
1955 (when org-par-open
1956 (insert "</p>")
1957 (setq org-par-open nil)))
1958(defun org-close-li (&optional type)
1959 "Close <li> if necessary."
1960 (org-close-par-maybe)
1961 (insert (if (equal type "d") "</dd>\n" "</li>\n")))
1962
1963(defvar in-local-list)
1964(defvar local-list-indent)
1965(defvar local-list-type)
1966(defun org-export-html-close-lists-maybe (line)
1967 (let ((ind (or (get-text-property 0 'original-indentation line)))
1968; (and (string-match "\\S-" line)
1969; (org-get-indentation line))))
1970 didclose)
1971 (when ind
1972 (while (and in-local-list
1973 (<= ind (car local-list-indent)))
1974 (setq didclose t)
1975 (org-close-li (car local-list-type))
1976 (insert (format "</%sl>\n" (car local-list-type)))
1977 (pop local-list-type) (pop local-list-indent)
1978 (setq in-local-list local-list-indent))
1979 (and didclose (org-open-par)))))
1980
1981(defvar body-only) ; dynamically scoped into this.
1982(defun org-html-level-start (level title umax with-toc head-count)
1983 "Insert a new level in HTML export.
1984When TITLE is nil, just close all open levels."
1985 (org-close-par-maybe)
1986 (let* ((target (and title (org-get-text-property-any 0 'target title)))
1987 (extra-targets (assoc target org-export-target-aliases))
1988 (preferred (cdr (assoc target org-export-preferred-target-alist)))
1989 (remove (or preferred target))
1990 (l org-level-max)
1991 snumber href suffix)
1992 (setq extra-targets (remove remove extra-targets))
1993 (setq extra-targets
1994 (mapconcat (lambda (x)
1995 (if (org-uuidgen-p x) (setq x (concat "ID-" x)))
1996 (format "<a name=\"%s\" id=\"%s\"></a>"
1997 x x))
1998 extra-targets
1999 ""))
2000 (while (>= l level)
2001 (if (aref org-levels-open (1- l))
2002 (progn
2003 (org-html-level-close l umax)
2004 (aset org-levels-open (1- l) nil)))
2005 (setq l (1- l)))
2006 (when title
2007 ;; If title is nil, this means this function is called to close
2008 ;; all levels, so the rest is done only if title is given
2009 (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
2010 (setq title (replace-match
2011 (if org-export-with-tags
2012 (save-match-data
2013 (concat
2014 "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
2015 (mapconcat
2016 (lambda (x)
2017 (format "<span class=\"%s\">%s</span>"
2018 (org-export-html-get-tag-class-name x)
2019 x))
2020 (org-split-string (match-string 1 title) ":")
2021 "&nbsp;")
2022 "</span>"))
2023 "")
2024 t t title)))
2025 (if (> level umax)
2026 (progn
2027 (if (aref org-levels-open (1- level))
2028 (progn
2029 (org-close-li)
2030 (if target
2031 (insert (format "<li id=\"%s\">" target) extra-targets title "<br/>\n")
2032 (insert "<li>" title "<br/>\n")))
2033 (aset org-levels-open (1- level) t)
2034 (org-close-par-maybe)
2035 (if target
2036 (insert (format "<ul>\n<li id=\"%s\">" target)
2037 extra-targets title "<br/>\n")
2038 (insert "<ul>\n<li>" title "<br/>\n"))))
2039 (aset org-levels-open (1- level) t)
2040 (setq snumber (org-section-number level))
2041 (setq level (+ level org-export-html-toplevel-hlevel -1))
2042 (if (and org-export-with-section-numbers (not body-only))
2043 (setq title (concat
2044 (format "<span class=\"section-number-%d\">%s</span>"
2045 level snumber)
2046 " " title)))
2047 (unless (= head-count 1) (insert "\n</div>\n"))
2048 (setq href (cdr (assoc (concat "sec-" snumber) org-export-preferred-target-alist)))
2049 (setq suffix (or href snumber))
2050 (setq href (or href (concat "sec-" snumber)))
2051 (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"
2052 suffix level level href
2053 extra-targets
2054 title level level suffix))
2055 (org-open-par)))))
2056
2057(defun org-export-html-get-tag-class-name (tag)
2058 "Turn tag into a valid class name.
2059Replaces invalid characters with \"_\" and then prepends a prefix."
2060 (save-match-data
2061 (while (string-match "[^a-zA-Z0-9_]" tag)
2062 (setq tag (replace-match "_" t t tag))))
2063 (concat org-export-html-tag-class-prefix tag))
2064
2065(defun org-export-html-get-todo-kwd-class-name (kwd)
2066 "Turn todo keyword into a valid class name.
2067Replaces invalid characters with \"_\" and then prepends a prefix."
2068 (save-match-data
2069 (while (string-match "[^a-zA-Z0-9_]" kwd)
2070 (setq kwd (replace-match "_" t t kwd))))
2071 (concat org-export-html-todo-kwd-class-prefix kwd))
2072
2073(defun org-html-level-close (level max-outline-level)
2074 "Terminate one level in HTML export."
2075 (if (<= level max-outline-level)
2076 (insert "</div>\n")
2077 (org-close-li)
2078 (insert "</ul>\n")))
2079
2080(provide 'org-html)
2081
2082;; arch-tag: 8109d84d-eb8f-460b-b1a8-f45f3a6c7ea1
2083
2084;;; 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 @@
1;;; org-icalendar.el --- iCalendar export for Org-mode
2
3;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
4;; Free Software Foundation, Inc.
5
6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org
9;; Version: 6.29c
10;;
11;; This file is part of GNU Emacs.
12;;
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;
27;;; Commentary:
28
29(require 'org-exp)
30
31(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
32
33(defgroup org-export-icalendar nil
34 "Options specific for iCalendar export of Org-mode files."
35 :tag "Org Export iCalendar"
36 :group 'org-export)
37
38(defcustom org-combined-agenda-icalendar-file "~/org.ics"
39 "The file name for the iCalendar file covering all agenda files.
40This file is created with the command \\[org-export-icalendar-all-agenda-files].
41The file name should be absolute, the file will be overwritten without warning."
42 :group 'org-export-icalendar
43 :type 'file)
44
45(defcustom org-icalendar-combined-name "OrgMode"
46 "Calendar name for the combined iCalendar representing all agenda files."
47 :group 'org-export-icalendar
48 :type 'string)
49
50(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
51 "Contexts where iCalendar export should use a deadline time stamp.
52This is a list with several symbols in it. Valid symbol are:
53
54event-if-todo Deadlines in TODO entries become calendar events.
55event-if-not-todo Deadlines in non-TODO entries become calendar events.
56todo-due Use deadlines in TODO entries as due-dates"
57 :group 'org-export-icalendar
58 :type '(set :greedy t
59 (const :tag "Deadlines in non-TODO entries become events"
60 event-if-not-todo)
61 (const :tag "Deadline in TODO entries become events"
62 event-if-todo)
63 (const :tag "Deadlines in TODO entries become due-dates"
64 todo-due)))
65
66(defcustom org-icalendar-use-scheduled '(todo-start)
67 "Contexts where iCalendar export should use a scheduling time stamp.
68This is a list with several symbols in it. Valid symbol are:
69
70event-if-todo Scheduling time stamps in TODO entries become an event.
71event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
72todo-start Scheduling time stamps in TODO entries become start date.
73 Some calendar applications show TODO entries only after
74 that date."
75 :group 'org-export-icalendar
76 :type '(set :greedy t
77 (const :tag
78 "SCHEDULED timestamps in non-TODO entries become events"
79 event-if-not-todo)
80 (const :tag "SCHEDULED timestamps in TODO entries become events"
81 event-if-todo)
82 (const :tag "SCHEDULED in TODO entries become start date"
83 todo-start)))
84
85(defcustom org-icalendar-categories '(local-tags category)
86 "Items that should be entered into the categories field.
87This is a list of symbols, the following are valid:
88
89category The Org-mode category of the current file or tree
90todo-state The todo state, if any
91local-tags The tags, defined in the current line
92all-tags All tags, including inherited ones."
93 :group 'org-export-icalendar
94 :type '(repeat
95 (choice
96 (const :tag "The file or tree category" category)
97 (const :tag "The TODO state" todo-state)
98 (const :tag "Tags defined in current line" local-tags)
99 (const :tag "All tags, including inherited ones" all-tags))))
100
101(defcustom org-icalendar-include-todo nil
102 "Non-nil means, export to iCalendar files should also cover TODO items.
103Valid values are:
104nil don't inlcude any TODO items
105t include all TODO items that are not in a DONE state
106unblocked include all TODO idems that are not blocked
107all include both done and not done items."
108 :group 'org-export-icalendar
109 :type '(choice
110 (const :tag "None" nil)
111 (const :tag "Unfinished" t)
112 (const :tag "Unblocked" unblocked)
113 (const :tag "All" all)))
114
115(defcustom org-icalendar-include-bbdb-anniversaries nil
116 "Non-nil means, a combined iCalendar files should include anniversaries.
117The anniversaries are define in the BBDB database."
118 :group 'org-export-icalendar
119 :type 'boolean)
120
121(defcustom org-icalendar-include-sexps t
122 "Non-nil means, export to iCalendar files should also cover sexp entries.
123These are entries like in the diary, but directly in an Org-mode file."
124 :group 'org-export-icalendar
125 :type 'boolean)
126
127(defcustom org-icalendar-include-body 100
128 "Amount of text below headline to be included in iCalendar export.
129This is a number of characters that should maximally be included.
130Properties, scheduling and clocking lines will always be removed.
131The text will be inserted into the DESCRIPTION field."
132 :group 'org-export-icalendar
133 :type '(choice
134 (const :tag "Nothing" nil)
135 (const :tag "Everything" t)
136 (integer :tag "Max characters")))
137
138(defcustom org-icalendar-store-UID nil
139 "Non-nil means, store any created UIDs in properties.
140The iCalendar standard requires that all entries have a unique identifier.
141Org will create these identifiers as needed. When this variable is non-nil,
142the created UIDs will be stored in the ID property of the entry. Then the
143next time this entry is exported, it will be exported with the same UID,
144superceding the previous form of it. This is essential for
145synchronization services.
146This variable is not turned on by default because we want to avoid creating
147a property drawer in every entry if people are only playing with this feature,
148or if they are only using it locally."
149 :group 'org-export-icalendar
150 :type 'boolean)
151
152(defcustom org-icalendar-timezone (getenv "TZ")
153 "The time zone string for iCalendar export.
154When nil of the empty string, use the abbreviation retrieved from Emacs."
155 :group 'org-export-icalendar
156 :type '(choice
157 (const :tag "Unspecified" nil)
158 (string :tag "Time zone")))
159
160;;; iCalendar export
161
162;;;###autoload
163(defun org-export-icalendar-this-file ()
164 "Export current file as an iCalendar file.
165The iCalendar file will be located in the same directory as the Org-mode
166file, but with extension `.ics'."
167 (interactive)
168 (org-export-icalendar nil buffer-file-name))
169
170;;;###autoload
171(defun org-export-icalendar-all-agenda-files ()
172 "Export all files in `org-agenda-files' to iCalendar .ics files.
173Each iCalendar file will be located in the same directory as the Org-mode
174file, but with extension `.ics'."
175 (interactive)
176 (apply 'org-export-icalendar nil (org-agenda-files t)))
177
178;;;###autoload
179(defun org-export-icalendar-combine-agenda-files ()
180 "Export all files in `org-agenda-files' to a single combined iCalendar file.
181The file is stored under the name `org-combined-agenda-icalendar-file'."
182 (interactive)
183 (apply 'org-export-icalendar t (org-agenda-files t)))
184
185(defun org-export-icalendar (combine &rest files)
186 "Create iCalendar files for all elements of FILES.
187If COMBINE is non-nil, combine all calendar entries into a single large
188file and store it under the name `org-combined-agenda-icalendar-file'."
189 (save-excursion
190 (org-prepare-agenda-buffers files)
191 (let* ((dir (org-export-directory
192 :ical (list :publishing-directory
193 org-export-publishing-directory)))
194 file ical-file ical-buffer category started org-agenda-new-buffers)
195 (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
196 (when combine
197 (setq ical-file
198 (if (file-name-absolute-p org-combined-agenda-icalendar-file)
199 org-combined-agenda-icalendar-file
200 (expand-file-name org-combined-agenda-icalendar-file dir))
201 ical-buffer (org-get-agenda-file-buffer ical-file))
202 (set-buffer ical-buffer) (erase-buffer))
203 (while (setq file (pop files))
204 (catch 'nextfile
205 (org-check-agenda-file file)
206 (set-buffer (org-get-agenda-file-buffer file))
207 (unless combine
208 (setq ical-file (concat (file-name-as-directory dir)
209 (file-name-sans-extension
210 (file-name-nondirectory buffer-file-name))
211 ".ics"))
212 (setq ical-buffer (org-get-agenda-file-buffer ical-file))
213 (with-current-buffer ical-buffer (erase-buffer)))
214 (setq category (or org-category
215 (file-name-sans-extension
216 (file-name-nondirectory buffer-file-name))))
217 (if (symbolp category) (setq category (symbol-name category)))
218 (let ((standard-output ical-buffer))
219 (if combine
220 (and (not started) (setq started t)
221 (org-start-icalendar-file org-icalendar-combined-name))
222 (org-start-icalendar-file category))
223 (org-print-icalendar-entries combine)
224 (when (or (and combine (not files)) (not combine))
225 (when (and combine org-icalendar-include-bbdb-anniversaries)
226 (require 'org-bbdb)
227 (org-bbdb-anniv-export-ical))
228 (org-finish-icalendar-file)
229 (set-buffer ical-buffer)
230 (run-hooks 'org-before-save-iCalendar-file-hook)
231 (save-buffer)
232 (run-hooks 'org-after-save-iCalendar-file-hook)
233 (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
234 ))))
235 (org-release-buffers org-agenda-new-buffers))))
236
237(defvar org-before-save-iCalendar-file-hook nil
238 "Hook run before an iCalendar file has been saved.
239This can be used to modify the result of the export.")
240
241(defvar org-after-save-iCalendar-file-hook nil
242 "Hook run after an iCalendar file has been saved.
243The iCalendar buffer is still current when this hook is run.
244A good way to use this is to tell a desktop calendar application to re-read
245the iCalendar file.")
246
247(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
248(defun org-print-icalendar-entries (&optional combine)
249 "Print iCalendar entries for the current Org-mode file to `standard-output'.
250When COMBINE is non nil, add the category to each line."
251 (require 'org-agenda)
252 (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
253 (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
254 (dts (org-ical-ts-to-string
255 (format-time-string (cdr org-time-stamp-formats) (current-time))
256 "DTSTART"))
257 hd ts ts2 state status (inc t) pos b sexp rrule
258 scheduledp deadlinep todo prefix due start
259 tmp pri categories location summary desc uid
260 (sexp-buffer (get-buffer-create "*ical-tmp*")))
261 (org-refresh-category-properties)
262 (save-excursion
263 (goto-char (point-min))
264 (while (re-search-forward re1 nil t)
265 (catch :skip
266 (org-agenda-skip)
267 (when (boundp 'org-icalendar-verify-function)
268 (unless (funcall org-icalendar-verify-function)
269 (outline-next-heading)
270 (backward-char 1)
271 (throw :skip nil)))
272 (setq pos (match-beginning 0)
273 ts (match-string 0)
274 inc t
275 hd (condition-case nil
276 (org-icalendar-cleanup-string
277 (org-get-heading))
278 (error (throw :skip nil)))
279 summary (org-icalendar-cleanup-string
280 (org-entry-get nil "SUMMARY"))
281 desc (org-icalendar-cleanup-string
282 (or (org-entry-get nil "DESCRIPTION")
283 (and org-icalendar-include-body (org-get-entry)))
284 t org-icalendar-include-body)
285 location (org-icalendar-cleanup-string
286 (org-entry-get nil "LOCATION" 'selective))
287 uid (if org-icalendar-store-UID
288 (org-id-get-create)
289 (or (org-id-get) (org-id-new)))
290 categories (org-export-get-categories)
291 deadlinep nil scheduledp nil)
292 (if (looking-at re2)
293 (progn
294 (goto-char (match-end 0))
295 (setq ts2 (match-string 1)
296 inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
297 (setq tmp (buffer-substring (max (point-min)
298 (- pos org-ds-keyword-length))
299 pos)
300 ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
301 (progn
302 (setq inc nil)
303 (replace-match "\\1" t nil ts))
304 ts)
305 deadlinep (string-match org-deadline-regexp tmp)
306 scheduledp (string-match org-scheduled-regexp tmp)
307 todo (org-get-todo-state)
308 ;; donep (org-entry-is-done-p)
309 ))
310 (when (and
311 deadlinep
312 (if todo
313 (not (memq 'event-if-todo org-icalendar-use-deadline))
314 (not (memq 'event-if-not-todo org-icalendar-use-deadline))))
315 (throw :skip t))
316 (when (and
317 scheduledp
318 (if todo
319 (not (memq 'event-if-todo org-icalendar-use-scheduled))
320 (not (memq 'event-if-not-todo org-icalendar-use-scheduled))))
321 (throw :skip t))
322 (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-")))
323 (if (or (string-match org-tr-regexp hd)
324 (string-match org-ts-regexp hd))
325 (setq hd (replace-match "" t t hd)))
326 (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
327 (setq rrule
328 (concat "\nRRULE:FREQ="
329 (cdr (assoc
330 (match-string 2 ts)
331 '(("d" . "DAILY")("w" . "WEEKLY")
332 ("m" . "MONTHLY")("y" . "YEARLY"))))
333 ";INTERVAL=" (match-string 1 ts)))
334 (setq rrule ""))
335 (setq summary (or summary hd))
336 (if (string-match org-bracket-link-regexp summary)
337 (setq summary
338 (replace-match (if (match-end 3)
339 (match-string 3 summary)
340 (match-string 1 summary))
341 t t summary)))
342 (if deadlinep (setq summary (concat "DL: " summary)))
343 (if scheduledp (setq summary (concat "S: " summary)))
344 (if (string-match "\\`<%%" ts)
345 (with-current-buffer sexp-buffer
346 (insert (substring ts 1 -1) " " summary "\n"))
347 (princ (format "BEGIN:VEVENT
348UID: %s
349%s
350%s%s
351SUMMARY:%s%s%s
352CATEGORIES:%s
353END:VEVENT\n"
354 (concat prefix uid)
355 (org-ical-ts-to-string ts "DTSTART")
356 (org-ical-ts-to-string ts2 "DTEND" inc)
357 rrule summary
358 (if (and desc (string-match "\\S-" desc))
359 (concat "\nDESCRIPTION: " desc) "")
360 (if (and location (string-match "\\S-" location))
361 (concat "\nLOCATION: " location) "")
362 categories)))))
363 (when (and org-icalendar-include-sexps
364 (condition-case nil (require 'icalendar) (error nil))
365 (fboundp 'icalendar-export-region))
366 ;; Get all the literal sexps
367 (goto-char (point-min))
368 (while (re-search-forward "^&?%%(" nil t)
369 (catch :skip
370 (org-agenda-skip)
371 (setq b (match-beginning 0))
372 (goto-char (1- (match-end 0)))
373 (forward-sexp 1)
374 (end-of-line 1)
375 (setq sexp (buffer-substring b (point)))
376 (with-current-buffer sexp-buffer
377 (insert sexp "\n"))))
378 (princ (org-diary-to-ical-string sexp-buffer))
379 (kill-buffer sexp-buffer))
380
381 (when org-icalendar-include-todo
382 (setq prefix "TODO-")
383 (goto-char (point-min))
384 (while (re-search-forward org-todo-line-regexp nil t)
385 (catch :skip
386 (org-agenda-skip)
387 (when (boundp 'org-icalendar-verify-function)
388 (unless (save-match-data
389 (funcall org-icalendar-verify-function))
390 (outline-next-heading)
391 (backward-char 1)
392 (throw :skip nil)))
393 (setq state (match-string 2))
394 (setq status (if (member state org-done-keywords)
395 "COMPLETED" "NEEDS-ACTION"))
396 (when (and state
397 (cond
398 ;; check if the state is one we should use
399 ((eq org-icalendar-include-todo 'all)
400 ;; all should be included
401 t)
402 ((eq org-icalendar-include-todo 'unblocked)
403 ;; only undone entries that are not blocked
404 (and (member state org-not-done-keywords)
405 (or (not org-blocker-hook)
406 (save-match-data
407 (run-hook-with-args-until-failure
408 'org-blocker-hook
409 (list :type 'todo-state-change
410 :position (point-at-bol)
411 :from 'todo
412 :to 'done))))))
413 ((eq org-icalendar-include-todo t)
414 ;; include everything that is not done
415 (member state org-not-done-keywords))))
416 (setq hd (match-string 3)
417 summary (org-icalendar-cleanup-string
418 (org-entry-get nil "SUMMARY"))
419 desc (org-icalendar-cleanup-string
420 (or (org-entry-get nil "DESCRIPTION")
421 (and org-icalendar-include-body (org-get-entry)))
422 t org-icalendar-include-body)
423 location (org-icalendar-cleanup-string
424 (org-entry-get nil "LOCATION" 'selective))
425 due (and (member 'todo-due org-icalendar-use-deadline)
426 (org-entry-get nil "DEADLINE"))
427 start (and (member 'todo-start org-icalendar-use-scheduled)
428 (org-entry-get nil "SCHEDULED"))
429 categories (org-export-get-categories)
430 uid (if org-icalendar-store-UID
431 (org-id-get-create)
432 (or (org-id-get) (org-id-new))))
433 (and due (setq due (org-ical-ts-to-string due "DUE")))
434 (and start (setq start (org-ical-ts-to-string start "DTSTART")))
435
436 (if (string-match org-bracket-link-regexp hd)
437 (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
438 (match-string 1 hd))
439 t t hd)))
440 (if (string-match org-priority-regexp hd)
441 (setq pri (string-to-char (match-string 2 hd))
442 hd (concat (substring hd 0 (match-beginning 1))
443 (substring hd (match-end 1))))
444 (setq pri org-default-priority))
445 (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
446 (- org-lowest-priority org-highest-priority))))))
447
448 (princ (format "BEGIN:VTODO
449UID: %s
450%s
451SUMMARY:%s%s%s%s
452CATEGORIES:%s
453SEQUENCE:1
454PRIORITY:%d
455STATUS:%s
456END:VTODO\n"
457 (concat prefix uid)
458 (or start dts)
459 (or summary hd)
460 (if (and location (string-match "\\S-" location))
461 (concat "\nLOCATION: " location) "")
462 (if (and desc (string-match "\\S-" desc))
463 (concat "\nDESCRIPTION: " desc) "")
464 (if due (concat "\n" due) "")
465 categories
466 pri status)))))))))
467
468(defun org-export-get-categories ()
469 "Get categories according to `org-icalendar-categories'."
470 (let ((cs org-icalendar-categories) c rtn tmp)
471 (while (setq c (pop cs))
472 (cond
473 ((eq c 'category) (push (org-get-category) rtn))
474 ((eq c 'todo-state)
475 (setq tmp (org-get-todo-state))
476 (and tmp (push tmp rtn)))
477 ((eq c 'local-tags)
478 (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
479 ((eq c 'all-tags)
480 (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
481 (mapconcat 'identity (nreverse rtn) ",")))
482
483(defun org-icalendar-cleanup-string (s &optional is-body maxlength)
484 "Take out stuff and quote what needs to be quoted.
485When IS-BODY is non-nil, assume that this is the body of an item, clean up
486whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
487characters."
488 (if (not s)
489 nil
490 (when is-body
491 (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
492 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
493 (while (string-match re s) (setq s (replace-match "" t t s)))
494 (while (string-match re2 s) (setq s (replace-match "" t t s)))))
495 (let ((start 0))
496 (while (string-match "\\([,;]\\)" s start)
497 (setq start (+ (match-beginning 0) 2)
498 s (replace-match "\\\\\\1" nil nil s))))
499 (setq s (org-trim s))
500 (when is-body
501 (while (string-match "[ \t]*\n[ \t]*" s)
502 (setq s (replace-match "\\n" t t s))))
503 (if is-body
504 (if maxlength
505 (if (and (numberp maxlength)
506 (> (length s) maxlength))
507 (setq s (substring s 0 maxlength)))))
508 s))
509
510(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength)
511 "Take out stuff and quote what needs to be quoted.
512When IS-BODY is non-nil, assume that this is the body of an item, clean up
513whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
514characters.
515This seems to be more like RFC 2455, but it causes problems, so it is
516not used right now."
517 (if (not s)
518 nil
519 (if is-body
520 (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
521 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
522 (while (string-match re s) (setq s (replace-match "" t t s)))
523 (while (string-match re2 s) (setq s (replace-match "" t t s)))
524 (setq s (org-trim s))
525 (while (string-match "[ \t]*\n[ \t]*" s)
526 (setq s (replace-match "\\n" t t s)))
527 (if maxlength
528 (if (and (numberp maxlength)
529 (> (length s) maxlength))
530 (setq s (substring s 0 maxlength)))))
531 (setq s (org-trim s)))
532 (while (string-match "\"" s) (setq s (replace-match "''" t t s)))
533 (when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
534 s))
535
536(defun org-start-icalendar-file (name)
537 "Start an iCalendar file by inserting the header."
538 (let ((user user-full-name)
539 (name (or name "unknown"))
540 (timezone (if (> (length org-icalendar-timezone) 0)
541 org-icalendar-timezone
542 (cadr (current-time-zone)))))
543 (princ
544 (format "BEGIN:VCALENDAR
545VERSION:2.0
546X-WR-CALNAME:%s
547PRODID:-//%s//Emacs with Org-mode//EN
548X-WR-TIMEZONE:%s
549CALSCALE:GREGORIAN\n" name user timezone))))
550
551(defun org-finish-icalendar-file ()
552 "Finish an iCalendar file by inserting the END statement."
553 (princ "END:VCALENDAR\n"))
554
555(defun org-ical-ts-to-string (s keyword &optional inc)
556 "Take a time string S and convert it to iCalendar format.
557KEYWORD is added in front, to make a complete line like DTSTART....
558When INC is non-nil, increase the hour by two (if time string contains
559a time), or the day by one (if it does not contain a time)."
560 (let ((t1 (org-parse-time-string s 'nodefault))
561 t2 fmt have-time time)
562 (if (and (car t1) (nth 1 t1) (nth 2 t1))
563 (setq t2 t1 have-time t)
564 (setq t2 (org-parse-time-string s)))
565 (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
566 (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
567 (when inc
568 (if have-time
569 (if org-agenda-default-appointment-duration
570 (setq mi (+ org-agenda-default-appointment-duration mi))
571 (setq h (+ 2 h)))
572 (setq d (1+ d))))
573 (setq time (encode-time s mi h d m y)))
574 (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
575 (concat keyword (format-time-string fmt time))))
576
577(provide 'org-icalendar)
578
579;; arch-tag: 2dee2b6e-9211-4aee-8a47-a3c7e5bc30cf
580
581;;; 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 @@
5;; Author: Carsten Dominik <carsten at orgmode dot org> 5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org 7;; Homepage: http://orgmode.org
8;; Version: 6.21b 8;; Version: 6.29c
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -79,11 +79,16 @@
79 :tag "Org ID" 79 :tag "Org ID"
80 :group 'org) 80 :group 'org)
81 81
82(defcustom org-id-uuid-program "uuidgen"
83 "The uuidgen program."
84 :group 'org-id
85 :type 'string)
82 86
83(defcustom org-id-method 87(defcustom org-id-method
84 (condition-case nil 88 (condition-case nil
85 (if (string-match "\\`[-0-9a-fA-F]\\{36\\}\\'" 89 (if (string-match "\\`[-0-9a-fA-F]\\{36\\}\\'"
86 (org-trim (shell-command-to-string "uuidgen"))) 90 (org-trim (shell-command-to-string
91 org-id-uuid-program)))
87 'uuidgen 92 'uuidgen
88 'org) 93 'org)
89 (error 'org)) 94 (error 'org))
@@ -197,7 +202,7 @@ With optional argument FORCE, force the creation of a new ID."
197 "Copy the ID of the entry at point to the kill ring. 202 "Copy the ID of the entry at point to the kill ring.
198Create an ID if necessary." 203Create an ID if necessary."
199 (interactive) 204 (interactive)
200 (kill-new (org-id-get nil 'create))) 205 (org-kill-new (org-id-get nil 'create)))
201 206
202;;;###autoload 207;;;###autoload
203(defun org-id-get (&optional pom create prefix) 208(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."
228 (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10))))) 233 (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10)))))
229 (org-refile-use-outline-path 234 (org-refile-use-outline-path
230 (if (caar org-refile-targets) 'file t)) 235 (if (caar org-refile-targets) 'file t))
236 (org-refile-target-verify-function nil)
231 (spos (org-refile-get-location "Entry: ")) 237 (spos (org-refile-get-location "Entry: "))
232 (pom (and spos (move-marker (make-marker) (nth 3 spos) 238 (pom (and spos (move-marker (make-marker) (nth 3 spos)
233 (get-file-buffer (nth 1 spos)))))) 239 (get-file-buffer (nth 1 spos))))))
@@ -300,7 +306,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
300 (if (equal prefix ":") (setq prefix "")) 306 (if (equal prefix ":") (setq prefix ""))
301 (cond 307 (cond
302 ((eq org-id-method 'uuidgen) 308 ((eq org-id-method 'uuidgen)
303 (setq unique (org-trim (shell-command-to-string "uuidgen")))) 309 (setq unique (org-trim (shell-command-to-string org-id-uuid-program))))
304 ((eq org-id-method 'org) 310 ((eq org-id-method 'org)
305 (let* ((etime (org-id-reverse-string (org-id-time-to-b36))) 311 (let* ((etime (org-id-reverse-string (org-id-time-to-b36)))
306 (postfix (if org-id-include-domain 312 (postfix (if org-id-include-domain
@@ -571,11 +577,22 @@ optional argument MARKERP, return the position as a new marker."
571(defun org-id-open (id) 577(defun org-id-open (id)
572 "Go to the entry with id ID." 578 "Go to the entry with id ID."
573 (org-mark-ring-push) 579 (org-mark-ring-push)
574 (let ((m (org-id-find id 'marker))) 580 (let ((m (org-id-find id 'marker))
581 cmd)
575 (unless m 582 (unless m
576 (error "Cannot find entry with ID \"%s\"" id)) 583 (error "Cannot find entry with ID \"%s\"" id))
584 ;; Use a buffer-switching command in analogy to finding files
585 (setq cmd
586 (or
587 (cdr
588 (assq
589 (cdr (assq 'file org-link-frame-setup))
590 '((find-file . switch-to-buffer)
591 (find-file-other-window . switch-to-buffer-other-window)
592 (find-file-other-frame . switch-to-buffer-other-frame))))
593 'switch-to-buffer-other-window))
577 (if (not (equal (current-buffer) (marker-buffer m))) 594 (if (not (equal (current-buffer) (marker-buffer m)))
578 (switch-to-buffer-other-window (marker-buffer m))) 595 (funcall cmd (marker-buffer m)))
579 (goto-char m) 596 (goto-char m)
580 (move-marker m nil) 597 (move-marker m nil)
581 (org-show-context))) 598 (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 @@
1;;; org-indent.el --- Dynamic indentation for Org-mode
2;; Copyright (C) 2008 Free Software Foundation, Inc.
3;;
4;; Author: Carsten Dominik <carsten at orgmode dot org>
5;; Keywords: outlines, hypermedia, calendar, wp
6;; Homepage: http://orgmode.org
7;; Version: 6.29c
8;;
9;; This file is part of GNU Emacs.
10;;
11;; This file is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;
27;;; Commentary:
28
29;; This is an implementation of dynamic virtual indentation. It works
30;; by adding text properties to a buffer to make sure lines are
31;; indented according to outline structure.
32
33(require 'org-macs)
34(require 'org-compat)
35(require 'org)
36(eval-when-compile
37 (require 'cl))
38
39
40(defgroup org-indent nil
41 "Options concerning dynamic virtual outline indentation."
42 :tag "Org Structure"
43 :group 'org)
44
45(defconst org-indent-max 40
46 "Maximum indentation in characters")
47(defconst org-indent-max-levels 40
48 "Maximum indentation in characters")
49
50(defvar org-indent-strings nil
51 "Vector with all indentation strings.
52It will be set in `org-indent-initialize'.")
53(defvar org-indent-stars nil
54 "Vector with all indentation star strings.
55It will be set in `org-indent-initialize'.")
56(defvar org-hide-leading-stars-before-indent-mode nil
57 "Used locally")
58
59(defcustom org-indent-boundary-char ?\ ; comment to protect space char
60 "The end of the virtual indentation strings, a single-character string.
61The default is just a space, but if you wish, you can use \"|\" or so.
62This can be useful on a terminal window - under a windowing system,
63it may be prettier to customize the org-indent face."
64 :group 'org-indent
65 :set (lambda (var val)
66 (set var val)
67 (and org-indent-strings (org-indent-initialize)))
68 :type 'character)
69
70(defcustom org-indent-mode-turns-off-org-adapt-indentation t
71 "Non-nil means, turning on org-indent-mode turns off indentation adaptation.
72For details see the variable `org-adapt-indentation'."
73 :group 'org-indent
74 :type 'boolean)
75
76(defcustom org-indent-mode-turns-on-hiding-stars t
77 "Non-nil means, turning on org-indent-mode turns on `org-hide-leading-stars'."
78 :group 'org-indent
79 :type 'boolean)
80
81(defcustom org-indent-indentation-per-level 2
82 "Indentation per level in number of characters."
83 :group 'org-indent
84 :type 'integer)
85
86(defcustom org-indent-fix-section-after-idle-time 0.2
87 "Seconds of idle time before fixing virtual indentation of section.
88The hooking-in of virtual indentation is not yet perfect. Occasionally,
89a change does not trigger to proper change of indentation. For this we
90have a timer action that fixes indentation in the current section after
91a short amount idle time. If we ever get the integration to work perfectly,
92this variable can be set to nil to get rid of the timer."
93 :group 'org-indent
94 :type '(choice
95 (const "Do not install idle timer" nil)
96 (number :tag "Idle time")))
97
98(defun org-indent-initialize ()
99 "Initialize the indentation strings and set the idle timer."
100 ;; We use an idle timer to "repair" the current section, because the
101 ;; redisplay seems to have some problems.
102 (unless org-indent-strings
103 (when org-indent-fix-section-after-idle-time
104 (run-with-idle-timer
105 org-indent-fix-section-after-idle-time
106 t 'org-indent-refresh-section)))
107 ;; Initialize the indentation and star vectors
108 (setq org-indent-strings (make-vector (1+ org-indent-max) nil))
109 (setq org-indent-stars (make-vector (1+ org-indent-max) nil))
110 (aset org-indent-strings 0 "")
111 (aset org-indent-stars 0 "")
112 (loop for i from 1 to org-indent-max do
113 (aset org-indent-strings i
114 (org-add-props
115 (concat (make-string (1- i) ?\ )
116 (char-to-string org-indent-boundary-char))
117 nil 'face 'org-indent)))
118 (loop for i from 1 to org-indent-max-levels do
119 (aset org-indent-stars i
120 (org-add-props (make-string i ?*)
121 nil 'face 'org-hide))))
122
123;;;###autoload
124(define-minor-mode org-indent-mode
125 "When active, indent text according to outline structure.
126
127Internally this works by adding `line-prefix' properties to all non-headlines.
128These properties are updated locally in idle time.
129FIXME: How to update when broken?"
130 nil " Ind" nil
131 (if (org-bound-and-true-p org-inhibit-startup)
132 (setq org-indent-mode nil)
133 (if org-indent-mode
134 (progn
135 (or org-indent-strings (org-indent-initialize))
136 (when org-indent-mode-turns-off-org-adapt-indentation
137 (org-set-local 'org-adapt-indentation nil))
138 (when org-indent-mode-turns-on-hiding-stars
139 (org-set-local 'org-hide-leading-stars-before-indent-mode
140 org-hide-leading-stars)
141 (org-set-local 'org-hide-leading-stars t))
142 (make-local-variable 'buffer-substring-filters)
143 (add-to-list 'buffer-substring-filters
144 'org-indent-remove-properties-from-string)
145 (org-add-hook 'org-after-demote-entry-hook
146 'org-indent-refresh-section nil 'local)
147 (org-add-hook 'org-after-promote-entry-hook
148 'org-indent-refresh-section nil 'local)
149 (org-add-hook 'org-font-lock-hook
150 'org-indent-refresh-to nil 'local)
151 (and font-lock-mode (org-restart-font-lock))
152 )
153 (save-excursion
154 (save-restriction
155 (org-indent-remove-properties (point-min) (point-max))
156 (kill-local-variable 'org-adapt-indentation)
157 (when (boundp 'org-hide-leading-stars-before-indent-mode)
158 (org-set-local 'org-hide-leading-stars
159 org-hide-leading-stars-before-indent-mode))
160 (setq buffer-substring-filters
161 (delq 'org-indent-remove-properties-from-string
162 buffer-substring-filters))
163 (remove-hook 'org-after-promote-entry-hook
164 'org-indent-refresh-section 'local)
165 (remove-hook 'org-after-demote-entry-hook
166 'org-indent-refresh-section 'local)
167 (and font-lock-mode (org-restart-font-lock))
168 (redraw-display))))))
169
170
171(defface org-indent
172 (org-compatible-face nil nil)
173 "Face for outline indentation.
174The default is to make it look like whitespace. But you may find it
175useful to make it evver so slightly different."
176 :group 'org-faces)
177
178(defun org-indent-indent-buffer ()
179 "Add indentation properties for the whole buffer."
180 (interactive)
181 (when org-indent-mode
182 (save-excursion
183 (save-restriction
184 (widen)
185 (org-indent-remove-properties (point-min) (point-max))
186 (org-indent-add-properties (point-min) (point-max))))))
187
188(defun org-indent-remove-properties (beg end)
189 "Remove indentations between BEG and END."
190 (org-unmodified
191 (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
192
193(defun org-indent-remove-properties-from-string (string)
194 "Remove indentations between BEG and END."
195 (remove-text-properties 0 (length string)
196 '(line-prefix nil wrap-prefix nil) string)
197 string)
198
199(defvar org-indent-outline-re (concat "^" org-outline-regexp)
200 "Outline heading regexp.")
201
202(defun org-indent-add-properties (beg end)
203 "Add indentation properties between BEG and END.
204Assumes that BEG is at the beginning of a line."
205 (when (or t org-indent-mode)
206 (let (ov b e n level exit nstars)
207 (org-unmodified
208 (save-excursion
209 (goto-char beg)
210 (while (not exit)
211 (setq e end)
212 (if (not (re-search-forward org-indent-outline-re nil t))
213 (setq e (point-max) exit t)
214 (setq e (match-beginning 0))
215 (if (>= e end) (setq exit t))
216 (setq level (- (match-end 0) (match-beginning 0) 1))
217 (setq nstars (- (* (1- level) org-indent-indentation-per-level)
218 (1- level)))
219 (add-text-properties
220 (point-at-bol) (point-at-eol)
221 (list 'line-prefix
222 (aref org-indent-stars nstars)
223 'wrap-prefix
224 (aref org-indent-strings
225 (* level org-indent-indentation-per-level)))))
226 (when (and b (> e b))
227 (add-text-properties
228 b e (list 'line-prefix (aref org-indent-strings n)
229 'wrap-prefix (aref org-indent-strings n))))
230 (setq b (1+ (point-at-eol))
231 n (* level org-indent-indentation-per-level))))))))
232
233(defun org-indent-refresh-section ()
234 "Refresh indentation properties in the current outline section.
235Point is assumed to be at the beginning of a headline."
236 (interactive)
237 (when org-indent-mode
238 (let (beg end)
239 (save-excursion
240 (when (ignore-errors (org-back-to-heading))
241 (setq beg (point))
242 (setq end (or (save-excursion (or (outline-next-heading) (point)))))
243 (org-indent-remove-properties beg end)
244 (org-indent-add-properties beg end))))))
245
246(defun org-indent-refresh-to (limit)
247 "Refresh indentation properties in the current outline section.
248Point is assumed to be at the beginning of a headline."
249 (interactive)
250 (when org-indent-mode
251 (let ((beg (point)) (end limit))
252 (save-excursion
253 (and (ignore-errors (org-back-to-heading t))
254 (setq beg (point))))
255 (org-indent-remove-properties beg end)
256 (org-indent-add-properties beg end)))
257 (goto-char limit))
258
259(defun org-indent-refresh-subtree ()
260 "Refresh indentation properties in the current outline subtree.
261Point is assumed to be at the beginning of a headline."
262 (interactive)
263 (when org-indent-mode
264 (save-excursion
265 (let (beg end)
266 (setq beg (point))
267 (setq end (save-excursion (org-end-of-subtree t t)))
268 (org-indent-remove-properties beg end)
269 (org-indent-add-properties beg end)))))
270
271(defun org-indent-refresh-buffer ()
272 "Refresh indentation properties in the current outline subtree.
273Point is assumed to be at the beginning of a headline."
274 (interactive)
275 (when org-indent-mode
276 (org-indent-mode -1)
277 (org-indent-mode 1)))
278
279(provide 'org-indent)
280
281;;; org-indent.el ends here
282
283
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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
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 @@
1;;; org-inlinetask.el --- Tasks independent of outline hierarchy
2;; Copyright (C) 2009 Free Software Foundation, Inc.
3;;
4;; Author: Carsten Dominik <carsten at orgmode dot org>
5;; Keywords: outlines, hypermedia, calendar, wp
6;; Homepage: http://orgmode.org
7;; Version: 6.29c
8;;
9;; This file is not yet part of GNU Emacs.
10;;
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;
27;;; Commentary:
28;;
29;; This module implements inline tasks in Org-mode. Inline tasks are
30;; tasks that have all the properties of normal outline nodes, including
31;; the ability to store meta data like scheduling dates, TODO state, tags
32;; and properties. However, these nodes are treated specially by the
33;; visibility cycling and export commands.
34;;
35;; Visibility cycling exempts these nodes from cycling. So whenever their
36;; parent is opened, so are these tasks. This will only work with
37;; `org-cycle', so if you are also using orther commands to show/hide
38;; entries, you will occasionally find these tasks to behave like
39;; all other outline nodes, seemingly splitting the text of the parent
40;; into children.
41;;
42;; Export commands do not treat these nodes as part of the sectioning
43;; structure, but as a special inline text that is either removed, or
44;; formatted in some special way.
45;;
46;; Special fontification of inline tasks, so that they can be immediately
47;; recognized. From the stars of the headline, only the first and the
48;; last two will be visible, the others will be hidden using the
49;; `org-hide' face.
50;;
51;; An inline task is identified solely by a minimum outline level, given
52;; by the variable `org-inlinetask-min-level', default 15.
53;;
54;; Inline tasks are normally assumed to contain at most a time planning
55;; line (DEADLINE etc) after it, and then any number of drawers, for
56;; example LOGBOOK of PROPERTIES. No empty lines are allowed.
57;; If you need to have normal text as part of an inline task, you
58;; can do so by adding an "END" headline with the same number of stars,
59;; for example
60;;
61;; **************** TODO some small task
62;; DEADLINE: <2009-03-30 Mon>
63;; :PROPERTIES:
64;; :SOMETHING: or other
65;; :END:
66;; And here is some extra text
67;; **************** END
68;;
69;; Also, if you want to use refiling and archiving for inline tasks,
70;; The END line must be present to make things work properly.
71;;
72;; This package installs one new comand:
73;;
74;; C-c C-x t Insert a new inline task with END line
75
76
77;;; Code
78
79(require 'org)
80
81(defgroup org-inlinetask nil
82 "Options concerning inline tasks in Org mode."
83 :tag "Org Inline Tasks"
84 :group 'org-structure)
85
86(defcustom org-inlinetask-min-level 15
87 "Minimum level a headline must have before it is treated as an inline task.
88It is strongly recommended that you set `org-cycle-max-level' not at all,
89or to a number smaller than this one. In fact, when `org-cycle-max-level' is
90not set, it will be assumed to be one less than the value of smaller than
91the value of this variable."
92 :group 'org-inlinetask
93 :type 'boolean)
94
95(defcustom org-inlinetask-export 'arrow+content
96 "What should be done with inlinetasks upon export?
97Possible values:
98
99nil Remove entirely, headline and \"content\"
100arrow Insert heading in bold, preceeded by an arrow
101arrow+content Insert arrow and headline, add content below in an
102 #+begin_example box (ugly, but works for now)
103
104The \"content\" of an inline task is the material below the planning
105line and any drawers, up to a lines wit the same number of stars,
106but containing only the word END."
107 :group 'org-inlinetask
108 :group 'org-export-general
109 :type '(choice
110 (const :tag "Remove entirely" nil)
111 (const :tag "Headline preceeded by arrow" arrow)
112 (const :tag "Arrow, headline, + content" arrow+content)))
113
114(defvar org-odd-levels-only)
115(defvar org-keyword-time-regexp)
116(defvar org-drawer-regexp)
117(defvar org-complex-heading-regexp)
118(defvar org-property-end-re)
119
120(defun org-inlinetask-insert-task ()
121 "Insert an inline task."
122 (interactive)
123 (or (bolp) (newline))
124 (insert (make-string org-inlinetask-min-level ?*) " \n"
125 (make-string org-inlinetask-min-level ?*) " END\n")
126 (end-of-line -1))
127(define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)
128
129(defun org-inlinetask-export-handler ()
130 "Handle headlines with level larger or equal to `org-inlinetask-min-level'.
131Either remove headline and meta data, or do special formatting."
132 (goto-char (point-min))
133 (let* ((nstars (if org-odd-levels-only
134 (1- (* 2 (or org-inlinetask-min-level 200)))
135 (or org-inlinetask-min-level 200)))
136 (re1 (format "^\\(\\*\\{%d,\\}\\) .*\n" nstars))
137 (re2 (concat "^[ \t]*" org-keyword-time-regexp))
138 headline beg end stars content)
139 (while (re-search-forward re1 nil t)
140 (setq headline (match-string 0)
141 stars (match-string 1)
142 content nil)
143 (replace-match "")
144 (while (looking-at re2)
145 (delete-region (point) (1+ (point-at-eol))))
146 (while (looking-at org-drawer-regexp)
147 (setq beg (point))
148 (if (re-search-forward org-property-end-re nil t)
149 (delete-region beg (1+ (match-end 0)))))
150 (setq beg (point))
151 (when (and (re-search-forward "^\\(\\*+\\) " nil t)
152 (= (length (match-string 1)) (length stars))
153 (progn (goto-char (match-end 0))
154 (looking-at "END[ \t]*$")))
155 (setq content (buffer-substring beg (1- (point-at-bol))))
156 (delete-region beg (1+ (match-end 0))))
157 (goto-char beg)
158 (when (and org-inlinetask-export
159 (string-match org-complex-heading-regexp headline))
160 (when (memq org-inlinetask-export '(arrow+content arrow))
161 (insert "\n\n\\Rightarrow\\Rightarrow\\Rightarrow *"
162 (if (match-end 2) (concat (match-string 2 headline) " ") "")
163 (match-string 4 headline) "*\n"))
164 (when (and content (eq org-inlinetask-export 'arrow+content))
165 (insert "#+BEGIN_EXAMPLE\n" content "\n#+END_EXAMPLE\n"))
166 (insert "\n")))))
167
168(defun org-inlinetask-fontify (limit)
169 "Fontify the inline tasks."
170 (let* ((nstars (if org-odd-levels-only
171 (1- (* 2 (or org-inlinetask-min-level 200)))
172 (or org-inlinetask-min-level 200)))
173 (re (concat "^\\(\\*\\)\\(\\*\\{"
174 (format "%d" (- nstars 3))
175 ",\\}\\)\\(\\*\\* .*\\)")))
176 (while (re-search-forward re limit t)
177 (add-text-properties (match-beginning 1) (match-end 1)
178 '(face org-warning font-lock-fontified t))
179 (add-text-properties (match-beginning 2) (match-end 2)
180 '(face org-hide font-lock-fontified t))
181 (add-text-properties (match-beginning 3) (match-end 3)
182 '(face shadow font-lock-fontified t)))))
183
184(defun org-inlinetask-remove-END-maybe ()
185 "Remove an END line when present."
186 (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$"
187 org-inlinetask-min-level))
188 (replace-match "")))
189
190(eval-after-load "org-exp"
191 '(add-hook 'org-export-preprocess-after-tree-selection-hook
192 'org-inlinetask-export-handler))
193(eval-after-load "org"
194 '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify))
195
196(provide 'org-inlinetask)
197
198;;; org-inlinetask.el ends here
199
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 @@
4;; 4;;
5;; Author: Philip Jackson <emacs@shellarchive.co.uk> 5;; Author: Philip Jackson <emacs@shellarchive.co.uk>
6;; Keywords: erc, irc, link, org 6;; Keywords: erc, irc, link, org
7;; Version: 6.21b 7;; Version: 6.29c
8;; 8;;
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
10;; 10;;
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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -41,6 +41,7 @@
41;;; Code: 41;;; Code:
42 42
43(require 'org-exp) 43(require 'org-exp)
44(require 'org-html)
44 45
45(add-to-list 'org-export-inbuffer-options-extra '("INFOJS_OPT" :infojs-opt)) 46(add-to-list 'org-export-inbuffer-options-extra '("INFOJS_OPT" :infojs-opt))
46(add-hook 'org-export-options-filters 'org-infojs-handle-options) 47(add-hook 'org-export-options-filters 'org-infojs-handle-options)
@@ -110,7 +111,7 @@ means to use the maximum value consistent with other options."
110<!--/*--><![CDATA[/*><!--*/ 111<!--/*--><![CDATA[/*><!--*/
111%MANAGER_OPTIONS 112%MANAGER_OPTIONS
112org_html_manager.setup(); // activate after the parameters are set 113org_html_manager.setup(); // activate after the parameters are set
113/*]]>*/--> 114/*]]>*///-->
114</script>" 115</script>"
115 "The template for the export style additions when org-info.js is used. 116 "The template for the export style additions when org-info.js is used.
116Option settings will replace the %MANAGER-OPTIONS cookie." 117Option 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 @@
1;;; org-export-latex.el --- LaTeX exporter for org-mode 1;;; org-latex.el --- LaTeX exporter for org-mode
2;; 2;;
3;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. 3;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
4;; 4;;
5;; Emacs Lisp Archive Entry 5;; Emacs Lisp Archive Entry
6;; Filename: org-export-latex.el 6;; Filename: org-latex.el
7;; Version: 6.21b 7;; Version: 6.29c
8;; Author: Bastien Guerry <bzg AT altern DOT org> 8;; Author: Bastien Guerry <bzg AT altern DOT org>
9;; Maintainer: Bastien Guerry <bzg AT altern DOT org> 9;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
10;; Keywords: org, wp, tex 10;; Keywords: org, wp, tex
11;; Description: Converts an org-mode buffer into LaTeX 11;; Description: Converts an org-mode buffer into LaTeX
12;; URL: http://www.cognition.ens.fr/~guerry/u/org-export-latex.el
13 12
14;; This file is part of GNU Emacs. 13;; This file is part of GNU Emacs.
15 14
@@ -30,8 +29,7 @@
30;; 29;;
31;; This library implements a LaTeX exporter for org-mode. 30;; This library implements a LaTeX exporter for org-mode.
32;; 31;;
33;; Put this file into your load-path and the following into your ~/.emacs: 32;; It is part of Org and will be autoloaded
34;; (require 'org-export-latex)
35;; 33;;
36;; The interactive functions are similar to those of the HTML exporter: 34;; The interactive functions are similar to those of the HTML exporter:
37;; 35;;
@@ -58,6 +56,10 @@
58(defvar org-export-latex-append-header nil) 56(defvar org-export-latex-append-header nil)
59(defvar org-export-latex-options-plist nil) 57(defvar org-export-latex-options-plist nil)
60(defvar org-export-latex-todo-keywords-1 nil) 58(defvar org-export-latex-todo-keywords-1 nil)
59(defvar org-export-latex-complex-heading-re nil)
60(defvar org-export-latex-not-done-keywords nil)
61(defvar org-export-latex-done-keywords nil)
62(defvar org-export-latex-display-custom-times nil)
61(defvar org-export-latex-all-targets-re nil) 63(defvar org-export-latex-all-targets-re nil)
62(defvar org-export-latex-add-level 0) 64(defvar org-export-latex-add-level 0)
63(defvar org-export-latex-sectioning "") 65(defvar org-export-latex-sectioning "")
@@ -165,12 +167,14 @@ to represent the section title."
165 ("/" "\\emph{%s}" nil) 167 ("/" "\\emph{%s}" nil)
166 ("_" "\\underline{%s}" nil) 168 ("_" "\\underline{%s}" nil)
167 ("+" "\\texttt{%s}" nil) 169 ("+" "\\texttt{%s}" nil)
168 ("=" "\\verb=%s=" nil) 170 ("=" "\\verb" t)
169 ("~" "\\verb~%s~" t)) 171 ("~" "\\verb" t))
170 "Alist of LaTeX expressions to convert emphasis fontifiers. 172 "Alist of LaTeX expressions to convert emphasis fontifiers.
171Each element of the list is a list of three elements. 173Each element of the list is a list of three elements.
172The first element is the character used as a marker for fontification. 174The first element is the character used as a marker for fontification.
173The second element is a formatting string to wrap fontified text with. 175The second element is a formatting string to wrap fontified text with.
176If it is \"\\verb\", Org will automatically select a deimiter
177character that is not in the string.
174The third element decides whether to protect converted text from other 178The third element decides whether to protect converted text from other
175conversions." 179conversions."
176 :group 'org-export-latex 180 :group 'org-export-latex
@@ -184,19 +188,58 @@ argument."
184 :group 'org-export-latex 188 :group 'org-export-latex
185 :type 'string) 189 :type 'string)
186 190
191(defcustom org-export-latex-import-inbuffer-stuff nil
192 "Non-nil means define TeX macros for Org's inbuffer definitions.
193For example \orgTITLE for #+TITLE."
194 :group 'org-export-latex
195 :type 'boolean)
196
187(defcustom org-export-latex-date-format 197(defcustom org-export-latex-date-format
188 "%d %B %Y" 198 "%d %B %Y"
189 "Format string for \\date{...}." 199 "Format string for \\date{...}."
190 :group 'org-export-latex 200 :group 'org-export-latex
191 :type 'string) 201 :type 'string)
192 202
203(defcustom org-export-latex-todo-keyword-markup "\\textbf{%s}"
204 "Markup for TODO keywords, as a printf format.
205This can be a single format for all keywords, a cons cell with separate
206formats for not-done and done states, or an association list with setup
207for individual keywords. If a keyword shows up for which there is no
208markup defined, the first one in the association list will be used."
209 :group 'org-export-latex
210 :type '(choice
211 (string :tag "Default")
212 (cons :tag "Distinguish undone and done"
213 (string :tag "Not-DONE states")
214 (string :tag "DONE states"))
215 (repeat :tag "Per keyword markup"
216 (cons
217 (string :tag "Keyword")
218 (string :tag "Markup")))))
219
220(defcustom org-export-latex-timestamp-markup "\\textit{%s}"
221 "A printf format string to be applied to time stamps."
222 :group 'org-export-latex
223 :type 'string)
224
225(defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}"
226 "A printf format string to be applied to time stamps."
227 :group 'org-export-latex
228 :type 'string)
229
193(defcustom org-export-latex-tables-verbatim nil 230(defcustom org-export-latex-tables-verbatim nil
194 "When non-nil, tables are exported verbatim." 231 "When non-nil, tables are exported verbatim."
195 :group 'org-export-latex 232 :group 'org-export-latex
196 :type 'boolean) 233 :type 'boolean)
197 234
235(defcustom org-export-latex-tables-centered t
236 "When non-nil, tables are exported in a center environment."
237 :group 'org-export-latex
238 :type 'boolean)
239
198(defcustom org-export-latex-tables-column-borders nil 240(defcustom org-export-latex-tables-column-borders nil
199 "When non-nil, group of columns are surrounded with borders." 241 "When non-nil, grouping columns can cause outer vertical lines in tables.
242When nil, grouping causes only separation lines between groups."
200 :group 'org-export-latex 243 :group 'org-export-latex
201 :type 'boolean) 244 :type 'boolean)
202 245
@@ -206,22 +249,35 @@ Each cell is of the forma \( \"option\" . \"package\" \)."
206 :group 'org-export-latex 249 :group 'org-export-latex
207 :type 'alist) 250 :type 'alist)
208 251
209(defcustom org-export-latex-low-levels 'description 252(defcustom org-export-latex-low-levels 'itemize
210 "How to convert sections below the current level of sectioning. 253 "How to convert sections below the current level of sectioning.
211This is specified by the `org-export-headline-levels' option or the 254This is specified by the `org-export-headline-levels' option or the
212value of \"H:\" in Org's #+OPTION line. 255value of \"H:\" in Org's #+OPTION line.
213 256
214This can be either nil (skip the sections), 'description (convert 257This can be either nil (skip the sections), `description', `itemize',
215the sections as descriptive lists) or a string to be used instead 258or `enumerate' (convert the sections as the corresponding list type), or
216of \\section{%s}. In this latter case, the %s stands here for the 259a string to be used instead of \\section{%s}. In this latter case,
217inserted headline and is mandatory." 260the %s stands here for the inserted headline and is mandatory.
261
262It may also be a list of three string to define a user-defined environment
263that should be used. The first string should be the like
264\"\\begin{itemize}\", the second should be like \"\\item %s %s\" with up
265to two occurrences of %s for the title and a lable, respectively. The third
266string should be like \"\\end{itemize\"."
218 :group 'org-export-latex 267 :group 'org-export-latex
219 :type '(choice (const :tag "Ignore" nil) 268 :type '(choice (const :tag "Ignore" nil)
220 (symbol :tag "Convert as descriptive list" description) 269 (const :tag "Convert as descriptive list" description)
270 (const :tag "Convert as itemized list" itemize)
271 (const :tag "Convert as enumerated list" enumerate)
272 (list :tag "User-defined environment"
273 :value ("\\begin{itemize}" "\\end{itemize}" "\\item %s")
274 (string :tag "Start")
275 (string :tag "End")
276 (string :tag "item"))
221 (string :tag "Use a section string" :value "\\subparagraph{%s}"))) 277 (string :tag "Use a section string" :value "\\subparagraph{%s}")))
222 278
223(defcustom org-export-latex-list-parameters 279(defcustom org-export-latex-list-parameters
224 '(:cbon "\\texttt{[ ]}" :cboff "\\texttt{[ ]}") 280 '(:cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
225 "Parameters for the LaTeX list exporter. 281 "Parameters for the LaTeX list exporter.
226These parameters will be passed on to `org-list-to-latex', which in turn 282These parameters will be passed on to `org-list-to-latex', which in turn
227will pass them (combined with the LaTeX default list parameters) to 283will 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
229 :group 'org-export-latex 285 :group 'org-export-latex
230 :type 'plist) 286 :type 'plist)
231 287
288(defcustom org-export-latex-verbatim-wrap
289 '("\\begin{verbatim}\n" . "\\end{verbatim}\n")
290 "Environment to be wrapped around a fixed-width section in LaTeX export.
291This is a cons with two strings, to be added before and after the
292fixed-with text.
293
294Defaults to \\begin{verbatim} and \\end{verbatim}."
295 :group 'org-export-translation
296 :group 'org-export-latex
297 :type '(cons (string :tag "Open")
298 (string :tag "Close")))
299
232(defcustom org-export-latex-remove-from-headlines 300(defcustom org-export-latex-remove-from-headlines
233 '(:todo nil :priority nil :tags nil) 301 '(:todo nil :priority nil :tags nil)
234 "A plist of keywords to remove from headlines. OBSOLETE. 302 "A plist of keywords to remove from headlines. OBSOLETE.
@@ -248,13 +316,13 @@ and `org-export-with-tags' instead."
248 :type 'string) 316 :type 'string)
249 317
250(defcustom org-export-latex-inline-image-extensions 318(defcustom org-export-latex-inline-image-extensions
251 '("pdf" "jpeg" "jpg" "png") 319 '("pdf" "jpeg" "jpg" "png" "ps" "eps")
252 "Extensions of image files that can be inlined into LaTeX. 320 "Extensions of image files that can be inlined into LaTeX.
253Note that this depends on the way the LaTeX file is processed. 321Note that the image extension *actually* allowed depend on the way the
254The default setting (pdf and jpg) assumes that pdflatex is doing the 322LaTeX file is processed. When used with pdflatex, pdf, jpg and png images
255processing. If you are using latex and dvips or something similar, 323are OK. When processing through dvi to Postscript, only ps and eps are
256only postscript files can be included." 324allowed. The default we use here encompasses both."
257 :group 'org-export-html 325 :group 'org-export-latex
258 :type '(repeat (string :tag "Extension"))) 326 :type '(repeat (string :tag "Extension")))
259 327
260(defcustom org-export-latex-coding-system nil 328(defcustom org-export-latex-coding-system nil
@@ -268,12 +336,37 @@ only postscript files can be included."
268 :group 'org-export-latex 336 :group 'org-export-latex
269 :group 'org-export) 337 :group 'org-export)
270 338
339(defcustom org-latex-to-pdf-process
340 '("pdflatex -interaction nonstopmode %s"
341 "pdflatex -interaction nonstopmode %s")
342 "Commands to process a LaTeX file to a PDF file.
343This is a list of strings, each of them will be given to the shell
344as a command. %s in the command will be replaced by the full file name, %b
345by the file base name (i.e. without extension).
346The reason why this is a list is that it usually takes several runs of
347pdflatex, maybe mixed with a call to bibtex. Org does not have a clever
348mechanism to detect whihc of these commands have to be run to get to a stable
349result, and it also does not do any error checking.
350
351Alternatively, this may be a Lisp function that does the processing, so you
352could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode.
353THis function should accept the file name as its single argument."
354 :group 'org-export-latex
355 :type '(choice (repeat :tag "Shell command sequence"
356 (string :tag "Shell command"))
357 (function)))
358
271(defcustom org-export-pdf-remove-logfiles t 359(defcustom org-export-pdf-remove-logfiles t
272 "Non-nil means, remove the logfiles produced by PDF production. 360 "Non-nil means, remove the logfiles produced by PDF production.
273These are the .aux, .log, .out, and .toc files." 361These are the .aux, .log, .out, and .toc files."
274 :group 'org-export-latex 362 :group 'org-export-pdf
275 :type 'boolean) 363 :type 'boolean)
276 364
365;;; Hooks
366
367(defvar org-export-latex-after-blockquotes-hook nil
368 "Hook run during LaTeX export, after blockquote, verse, center are done.")
369
277;;; Autoload functions: 370;;; Autoload functions:
278 371
279;;;###autoload 372;;;###autoload
@@ -293,7 +386,8 @@ emacs --batch
293No file is created. The prefix ARG is passed through to `org-export-as-latex'." 386No file is created. The prefix ARG is passed through to `org-export-as-latex'."
294 (interactive "P") 387 (interactive "P")
295 (org-export-as-latex arg nil nil "*Org LaTeX Export*") 388 (org-export-as-latex arg nil nil "*Org LaTeX Export*")
296 (switch-to-buffer-other-window "*Org LaTeX Export*")) 389 (when org-export-show-temporary-export-buffer
390 (switch-to-buffer-other-window "*Org LaTeX Export*")))
297 391
298;;;###autoload 392;;;###autoload
299(defun org-replace-region-by-latex (beg end) 393(defun org-replace-region-by-latex (beg end)
@@ -329,23 +423,24 @@ contents, and only produce the region of converted text, useful for
329cut-and-paste operations. 423cut-and-paste operations.
330If BUFFER is a buffer or a string, use/create that buffer as a target 424If BUFFER is a buffer or a string, use/create that buffer as a target
331of the converted LaTeX. If BUFFER is the symbol `string', return the 425of the converted LaTeX. If BUFFER is the symbol `string', return the
332produced LaTeX as a string and leave not buffer behind. For example, 426produced LaTeX as a string and leave no buffer behind. For example,
333a Lisp program could call this function in the following way: 427a Lisp program could call this function in the following way:
334 428
335 (setq latex (org-export-region-as-latex beg end t 'string)) 429 (setq latex (org-export-region-as-latex beg end t 'string))
336 430
337When called interactively, the output buffer is selected, and shown 431When called interactively, the output buffer is selected, and shown
338in a window. A non-interactive call will only retunr the buffer." 432in a window. A non-interactive call will only return the buffer."
339 (interactive "r\nP") 433 (interactive "r\nP")
340 (when (interactive-p) 434 (when (interactive-p)
341 (setq buffer "*Org LaTeX Export*")) 435 (setq buffer "*Org LaTeX Export*"))
342 (let ((transient-mark-mode t) (zmacs-regions t) 436 (let ((transient-mark-mode t) (zmacs-regions t)
343 rtn) 437 ext-plist rtn)
438 (setq ext-plist (plist-put ext-plist :ignore-subree-p t))
344 (goto-char end) 439 (goto-char end)
345 (set-mark (point)) ;; to activate the region 440 (set-mark (point)) ;; to activate the region
346 (goto-char beg) 441 (goto-char beg)
347 (setq rtn (org-export-as-latex 442 (setq rtn (org-export-as-latex
348 nil nil nil 443 nil nil ext-plist
349 buffer body-only)) 444 buffer body-only))
350 (if (fboundp 'deactivate-mark) (deactivate-mark)) 445 (if (fboundp 'deactivate-mark) (deactivate-mark))
351 (if (and (interactive-p) (bufferp rtn)) 446 (if (and (interactive-p) (bufferp rtn))
@@ -360,8 +455,9 @@ If there is an active region, export only the region. The prefix
360ARG specifies how many levels of the outline should become 455ARG specifies how many levels of the outline should become
361headlines. The default is 3. Lower levels will be exported 456headlines. The default is 3. Lower levels will be exported
362depending on `org-export-latex-low-levels'. The default is to 457depending on `org-export-latex-low-levels'. The default is to
363convert them as description lists. When HIDDEN is non-nil, don't 458convert them as description lists.
364display the LaTeX buffer. EXT-PLIST is a property list with 459HIDDEN is obsolete and does nothing.
460EXT-PLIST is a property list with
365external parameters overriding org-mode's default settings, but 461external parameters overriding org-mode's default settings, but
366still inferior to file-local settings. When TO-BUFFER is 462still inferior to file-local settings. When TO-BUFFER is
367non-nil, create a buffer with that name and export to that 463non-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."
382 (error "Need a file name to be able to export"))) 478 (error "Need a file name to be able to export")))
383 479
384 (message "Exporting to LaTeX...") 480 (message "Exporting to LaTeX...")
385 (remove-text-properties (point-min) (point-max) 481 (org-unmodified
386 '(:org-license-to-kill nil)) 482 (remove-text-properties (point-min) (point-max)
483 '(:org-license-to-kill nil)))
387 (org-update-radio-target-regexp) 484 (org-update-radio-target-regexp)
388 (org-export-latex-set-initial-vars ext-plist arg) 485 (org-export-latex-set-initial-vars ext-plist arg)
389 (let* ((wcf (current-window-configuration)) 486 (let* ((wcf (current-window-configuration))
@@ -392,14 +489,17 @@ when PUB-DIR is set, use this as the publishing directory."
392 (rbeg (and region-p (region-beginning))) 489 (rbeg (and region-p (region-beginning)))
393 (rend (and region-p (region-end))) 490 (rend (and region-p (region-end)))
394 (subtree-p 491 (subtree-p
395 (when region-p 492 (if (plist-get opt-plist :ignore-subree-p)
396 (save-excursion 493 nil
397 (goto-char rbeg) 494 (when region-p
398 (and (org-at-heading-p) 495 (save-excursion
399 (>= (org-end-of-subtree t t) rend))))) 496 (goto-char rbeg)
400 (opt-plist (if subtree-p 497 (and (org-at-heading-p)
401 (org-export-add-subtree-options opt-plist rbeg) 498 (>= (org-end-of-subtree t t) rend))))))
402 opt-plist)) 499 (opt-plist (setq org-export-opt-plist
500 (if subtree-p
501 (org-export-add-subtree-options opt-plist rbeg)
502 opt-plist)))
403 ;; Make sure the variable contains the updated values. 503 ;; Make sure the variable contains the updated values.
404 (org-export-latex-options-plist opt-plist) 504 (org-export-latex-options-plist opt-plist)
405 (title (or (and subtree-p (org-export-get-title-from-subtree)) 505 (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."
434 (region-p nil) 534 (region-p nil)
435 (t (plist-get opt-plist :skip-before-1st-heading)))) 535 (t (plist-get opt-plist :skip-before-1st-heading))))
436 (text (plist-get opt-plist :text)) 536 (text (plist-get opt-plist :text))
537 (org-export-preprocess-hook
538 (cons
539 `(lambda () (org-set-local 'org-complex-heading-regexp
540 ,org-export-latex-complex-heading-re))
541 org-export-preprocess-hook))
437 (first-lines (if skip "" (org-export-latex-first-lines 542 (first-lines (if skip "" (org-export-latex-first-lines
438 opt-plist rbeg))) 543 opt-plist
544 (if subtree-p
545 (save-excursion
546 (goto-char rbeg)
547 (point-at-bol 2))
548 rbeg)
549 (if region-p rend))))
439 (coding-system (and (boundp 'buffer-file-coding-system) 550 (coding-system (and (boundp 'buffer-file-coding-system)
440 buffer-file-coding-system)) 551 buffer-file-coding-system))
441 (coding-system-for-write (or org-export-latex-coding-system 552 (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."
464 575
465 (set-buffer buffer) 576 (set-buffer buffer)
466 (erase-buffer) 577 (erase-buffer)
578 (org-install-letbind)
467 579
468 (and (fboundp 'set-buffer-file-coding-system) 580 (and (fboundp 'set-buffer-file-coding-system)
469 (set-buffer-file-coding-system coding-system-for-write)) 581 (set-buffer-file-coding-system coding-system-for-write))
@@ -479,7 +591,7 @@ when PUB-DIR is set, use this as the publishing directory."
479 "\n\n")) 591 "\n\n"))
480 592
481 ;; insert lines before the first headline 593 ;; insert lines before the first headline
482 (unless (or skip (eq to-buffer 'string)) 594 (unless skip
483 (insert first-lines)) 595 (insert first-lines))
484 596
485 ;; export the content of headlines 597 ;; export the content of headlines
@@ -496,9 +608,21 @@ when PUB-DIR is set, use this as the publishing directory."
496 608
497 ;; finalization 609 ;; finalization
498 (unless body-only (insert "\n\\end{document}")) 610 (unless body-only (insert "\n\\end{document}"))
611
612 ;; Relocate the table of contents
613 (goto-char (point-min))
614 (when (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t)
615 (goto-char (point-min))
616 (while (re-search-forward "\\\\tableofcontents\\>[ \t]*\n?" nil t)
617 (replace-match ""))
618 (goto-char (point-min))
619 (and (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t)
620 (replace-match "\\tableofcontents" t t)))
621
499 (or to-buffer (save-buffer)) 622 (or to-buffer (save-buffer))
500 (goto-char (point-min)) 623 (goto-char (point-min))
501 (message "Exporting to LaTeX...done") 624 (or (org-export-push-to-kill-ring "LaTeX")
625 (message "Exporting to LaTeX...done"))
502 (prog1 626 (prog1
503 (if (eq to-buffer 'string) 627 (if (eq to-buffer 'string)
504 (prog1 (buffer-substring (point-min) (point-max)) 628 (prog1 (buffer-substring (point-min) (point-max))
@@ -517,13 +641,32 @@ when PUB-DIR is set, use this as the publishing directory."
517 to-buffer body-only pub-dir)) 641 to-buffer body-only pub-dir))
518 (file (buffer-file-name lbuf)) 642 (file (buffer-file-name lbuf))
519 (base (file-name-sans-extension (buffer-file-name lbuf))) 643 (base (file-name-sans-extension (buffer-file-name lbuf)))
520 (pdffile (concat base ".pdf"))) 644 (pdffile (concat base ".pdf"))
645 (cmds org-latex-to-pdf-process)
646 (outbuf (get-buffer-create "*Org PDF LaTeX Output*"))
647 (bibtex-p (with-current-buffer lbuf
648 (save-excursion
649 (goto-char (point-min))
650 (re-search-forward "\\\\bibliography{" nil t))))
651 cmd)
652 (with-current-buffer outbuf (erase-buffer))
521 (and (file-exists-p pdffile) (delete-file pdffile)) 653 (and (file-exists-p pdffile) (delete-file pdffile))
522 (message "Processing LaTeX file...") 654 (message "Processing LaTeX file...")
523 (shell-command (format "pdflatex -interaction nonstopmode %s" 655 (if (and cmds (symbolp cmds))
524 (shell-quote-argument file))) 656 (funcall cmds file)
525 (shell-command (format "pdflatex -interaction nonstopmode %s" 657 (while cmds
526 (shell-quote-argument file))) 658 (setq cmd (pop cmds))
659 (while (string-match "%b" cmd)
660 (setq cmd (replace-match
661 (save-match-data
662 (shell-quote-argument base))
663 t t cmd)))
664 (while (string-match "%s" cmd)
665 (setq cmd (replace-match
666 (save-match-data
667 (shell-quote-argument file))
668 t t cmd)))
669 (shell-command cmd outbuf outbuf)))
527 (message "Processing LaTeX file...done") 670 (message "Processing LaTeX file...done")
528 (if (not (file-exists-p pdffile)) 671 (if (not (file-exists-p pdffile))
529 (error "PDF file was not produced") 672 (error "PDF file was not produced")
@@ -663,13 +806,46 @@ If NUM, export sections as numerical sections."
663 ;; At a level under the hl option: we can drop this subsection 806 ;; At a level under the hl option: we can drop this subsection
664 ((> level org-export-latex-sectioning-depth) 807 ((> level org-export-latex-sectioning-depth)
665 (cond ((eq org-export-latex-low-levels 'description) 808 (cond ((eq org-export-latex-low-levels 'description)
666 (insert (format "\\begin{description}\n\n\\item[%s]%s\n\n" 809 (if (string-match "% ends low level$"
810 (buffer-substring (point-at-bol 0) (point)))
811 (delete-region (point-at-bol 0) (point))
812 (insert "\\begin{description}\n"))
813 (insert (format "\n\\item[%s]%s~\n\n"
667 heading 814 heading
668 (if label (format "\\label{%s}" label) ""))) 815 (if label (format "\\label{%s}" label) "")))
669 (insert (org-export-latex-content content)) 816 (insert (org-export-latex-content content))
670 (cond ((stringp subcontent) (insert subcontent)) 817 (cond ((stringp subcontent) (insert subcontent))
671 ((listp subcontent) (org-export-latex-sub subcontent))) 818 ((listp subcontent) (org-export-latex-sub subcontent)))
672 (insert "\\end{description}\n")) 819 (insert "\\end{description} % ends low level\n"))
820 ((memq org-export-latex-low-levels '(itemize enumerate))
821 (if (string-match "% ends low level$"
822 (buffer-substring (point-at-bol 0) (point)))
823 (delete-region (point-at-bol 0) (point))
824 (insert (format "\\begin{%s}\n"
825 (symbol-name org-export-latex-low-levels))))
826 (insert (format "\n\\item %s\\\\\n%s\n"
827 heading
828 (if label (format "\\label{%s}" label) "")))
829 (insert (org-export-latex-content content))
830 (cond ((stringp subcontent) (insert subcontent))
831 ((listp subcontent) (org-export-latex-sub subcontent)))
832 (insert (format "\\end{%s} %% ends low level\n"
833 (symbol-name org-export-latex-low-levels))))
834
835 ((listp org-export-latex-low-levels)
836 (if (string-match "% ends low level$"
837 (buffer-substring (point-at-bol 0) (point)))
838 (delete-region (point-at-bol 0) (point))
839 (insert (car org-export-latex-low-levels) "\n"))
840 (insert (format (nth 2 org-export-latex-low-levels)
841 heading
842 (if label (format "\\label{%s}" label) "")))
843 (insert (org-export-latex-content content))
844 (cond ((stringp subcontent) (insert subcontent))
845 ((listp subcontent) (org-export-latex-sub subcontent)))
846 (insert (nth 1 org-export-latex-low-levels)
847 " %% ends low level\n"))
848
673 ((stringp org-export-latex-low-levels) 849 ((stringp org-export-latex-low-levels)
674 (insert (format org-export-latex-low-levels heading) "\n") 850 (insert (format org-export-latex-low-levels heading) "\n")
675 (when label (insert (format "\\label{%s}\n" label))) 851 (when label (insert (format "\\label{%s}\n" label)))
@@ -683,6 +859,10 @@ If NUM, export sections as numerical sections."
683EXT-PLIST is an optional additional plist. 859EXT-PLIST is an optional additional plist.
684LEVEL indicates the default depth for export." 860LEVEL indicates the default depth for export."
685 (setq org-export-latex-todo-keywords-1 org-todo-keywords-1 861 (setq org-export-latex-todo-keywords-1 org-todo-keywords-1
862 org-export-latex-done-keywords org-done-keywords
863 org-export-latex-not-done-keywords org-not-done-keywords
864 org-export-latex-complex-heading-re org-complex-heading-regexp
865 org-export-latex-display-custom-times org-display-custom-times
686 org-export-latex-all-targets-re 866 org-export-latex-all-targets-re
687 (org-make-target-link-regexp (org-all-targets)) 867 (org-make-target-link-regexp (org-all-targets))
688 org-export-latex-options-plist 868 org-export-latex-options-plist
@@ -726,7 +906,7 @@ OPT-PLIST is the options plist for current buffer."
726 (if (plist-get opt-plist :time-stamp-file) 906 (if (plist-get opt-plist :time-stamp-file)
727 (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) 907 (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
728 ;; insert LaTeX custom header 908 ;; insert LaTeX custom header
729 org-export-latex-header 909 (org-export-apply-macros-in-string org-export-latex-header)
730 "\n" 910 "\n"
731 ;; insert information on LaTeX packages 911 ;; insert information on LaTeX packages
732 (when org-export-latex-packages-alist 912 (when org-export-latex-packages-alist
@@ -737,8 +917,9 @@ OPT-PLIST is the options plist for current buffer."
737 (car p) (cadr p)))) 917 (car p) (cadr p))))
738 org-export-latex-packages-alist "\n")) 918 org-export-latex-packages-alist "\n"))
739 ;; insert additional commands in the header 919 ;; insert additional commands in the header
740 (plist-get opt-plist :latex-header-extra) 920 (org-export-apply-macros-in-string
741 org-export-latex-append-header 921 (plist-get opt-plist :latex-header-extra))
922 (org-export-apply-macros-in-string org-export-latex-append-header)
742 ;; insert the title 923 ;; insert the title
743 (format 924 (format
744 "\n\n\\title{%s}\n" 925 "\n\n\\title{%s}\n"
@@ -748,7 +929,7 @@ OPT-PLIST is the options plist for current buffer."
748 ;; insert author info 929 ;; insert author info
749 (if (plist-get opt-plist :author-info) 930 (if (plist-get opt-plist :author-info)
750 (format "\\author{%s}\n" 931 (format "\\author{%s}\n"
751 (or author user-full-name)) 932 (org-export-latex-fontify-headline (or author user-full-name)));????????????????????
752 (format "%%\\author{%s}\n" 933 (format "%%\\author{%s}\n"
753 (or author user-full-name))) 934 (or author user-full-name)))
754 ;; insert the date 935 ;; insert the date
@@ -759,9 +940,10 @@ OPT-PLIST is the options plist for current buffer."
759 ;; beginning of the document 940 ;; beginning of the document
760 "\n\\begin{document}\n\n" 941 "\n\\begin{document}\n\n"
761 ;; insert the title command 942 ;; insert the title command
762 (if (string-match "%s" org-export-latex-title-command) 943 (when (string-match "\\S-" title)
763 (format org-export-latex-title-command title) 944 (if (string-match "%s" org-export-latex-title-command)
764 org-export-latex-title-command) 945 (format org-export-latex-title-command title)
946 org-export-latex-title-command))
765 "\n\n" 947 "\n\n"
766 ;; table of contents 948 ;; table of contents
767 (when (and org-export-with-toc 949 (when (and org-export-with-toc
@@ -772,16 +954,16 @@ OPT-PLIST is the options plist for current buffer."
772 (toc (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n" 954 (toc (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n"
773 (plist-get opt-plist :headline-levels)))))))) 955 (plist-get opt-plist :headline-levels))))))))
774 956
775(defun org-export-latex-first-lines (opt-plist &optional beg) 957(defun org-export-latex-first-lines (opt-plist &optional beg end)
776 "Export the first lines before first headline. 958 "Export the first lines before first headline.
777If BEG is non-nil, the is the beginning of he region." 959If BEG is non-nil, it is the beginning of the region.
960If END is non-nil, it is the end of the region."
778 (save-excursion 961 (save-excursion
779 (goto-char (or beg (point-min))) 962 (goto-char (or beg (point-min)))
780 (if (org-at-heading-p) (beginning-of-line 2))
781 (let* ((pt (point)) 963 (let* ((pt (point))
782 (end (if (re-search-forward "^\\*+ " nil t) 964 (end (if (re-search-forward "^\\*+ " end t)
783 (goto-char (match-beginning 0)) 965 (goto-char (match-beginning 0))
784 (goto-char (point-max))))) 966 (goto-char end))))
785 (prog1 967 (prog1
786 (org-export-latex-content 968 (org-export-latex-content
787 (org-export-preprocess-string 969 (org-export-preprocess-string
@@ -794,8 +976,14 @@ If BEG is non-nil, the is the beginning of he region."
794 :LaTeX-fragments nil 976 :LaTeX-fragments nil
795 :timestamps (plist-get opt-plist :timestamps) 977 :timestamps (plist-get opt-plist :timestamps)
796 :footnotes (plist-get opt-plist :footnotes))) 978 :footnotes (plist-get opt-plist :footnotes)))
797 (add-text-properties pt (max pt (1- end)) 979 (org-unmodified
798 '(:org-license-to-kill t)))))) 980 (add-text-properties pt (max pt (1- end))
981 '(:org-license-to-kill t)))))))
982
983(defvar org-export-latex-header-defs nil
984 "The header definitions that might be used in the LaTeX body.")
985(defvar org-export-latex-header-defs-re nil
986 "The header definitions that might be used in the LaTeX body.")
799 987
800(defun org-export-latex-content (content &optional exclude-list) 988(defun org-export-latex-content (content &optional exclude-list)
801 "Convert CONTENT string to LaTeX. 989 "Convert CONTENT string to LaTeX.
@@ -804,6 +992,8 @@ conversion types are: quotation-marks, emphasis, sub-superscript,
804links, keywords, lists, tables, fixed-width" 992links, keywords, lists, tables, fixed-width"
805 (with-temp-buffer 993 (with-temp-buffer
806 (insert content) 994 (insert content)
995 (unless (memq 'timestamps exclude-list)
996 (org-export-latex-time-stamps))
807 (unless (memq 'quotation-marks exclude-list) 997 (unless (memq 'quotation-marks exclude-list)
808 (org-export-latex-quotation-marks)) 998 (org-export-latex-quotation-marks))
809 (unless (memq 'emphasis exclude-list) 999 (unless (memq 'emphasis exclude-list)
@@ -846,12 +1036,21 @@ links, keywords, lists, tables, fixed-width"
846 "Maybe remove keywords depending on rules in REMOVE-LIST." 1036 "Maybe remove keywords depending on rules in REMOVE-LIST."
847 (goto-char (point-min)) 1037 (goto-char (point-min))
848 (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|")) 1038 (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|"))
849 (case-fold-search nil)) 1039 (case-fold-search nil)
1040 (todo-markup org-export-latex-todo-keyword-markup)
1041 fmt)
850 ;; convert TODO keywords 1042 ;; convert TODO keywords
851 (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t) 1043 (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t)
852 (if (plist-get remove-list :todo) 1044 (if (plist-get remove-list :todo)
853 (replace-match "") 1045 (replace-match "")
854 (replace-match (format "\\textbf{%s}" (match-string 1)) t t))) 1046 (setq fmt (cond
1047 ((stringp todo-markup) todo-markup)
1048 ((and (consp todo-markup) (stringp (car todo-markup)))
1049 (if (member (match-string 1) org-export-latex-done-keywords)
1050 (cdr todo-markup) (car todo-markup)))
1051 (t (cdr (or (assoc (match-string 1) todo-markup)
1052 (car todo-markup))))))
1053 (replace-match (format fmt (match-string 1)) t t)))
855 ;; convert priority string 1054 ;; convert priority string
856 (when (re-search-forward "\\[\\\\#.\\]" nil t) 1055 (when (re-search-forward "\\[\\\\#.\\]" nil t)
857 (if (plist-get remove-list :priority) 1056 (if (plist-get remove-list :priority)
@@ -885,6 +1084,18 @@ links, keywords, lists, tables, fixed-width"
885 (org-export-latex-links) 1084 (org-export-latex-links)
886 (org-trim (buffer-string)))) 1085 (org-trim (buffer-string))))
887 1086
1087(defun org-export-latex-time-stamps ()
1088 "Format time stamps."
1089 (goto-char (point-min))
1090 (let ((org-display-custom-times org-export-latex-display-custom-times))
1091 (while (re-search-forward org-ts-regexp-both nil t)
1092 (org-if-unprotected-at (1- (point))
1093 (replace-match
1094 (org-export-latex-protect-string
1095 (format org-export-latex-timestamp-markup
1096 (substring (org-translate-time (match-string 0)) 1 -1)))
1097 t t)))))
1098
888(defun org-export-latex-quotation-marks () 1099(defun org-export-latex-quotation-marks ()
889 "Export quotation marks depending on language conventions." 1100 "Export quotation marks depending on language conventions."
890 (let* ((lang (plist-get org-export-latex-options-plist :language)) 1101 (let* ((lang (plist-get org-export-latex-options-plist :language))
@@ -892,9 +1103,9 @@ links, keywords, lists, tables, fixed-width"
892 '(("\\(\\s-\\)\"" "«~") 1103 '(("\\(\\s-\\)\"" "«~")
893 ("\\(\\S-\\)\"" "~»") 1104 ("\\(\\S-\\)\"" "~»")
894 ("\\(\\s-\\)'" "`")) 1105 ("\\(\\s-\\)'" "`"))
895 '(("\\(\\s-\\)\"" "``") 1106 '(("\\(\\s-\\|(\\)\"" "``")
896 ("\\(\\S-\\)\"" "''") 1107 ("\\(\\S-\\)\"" "''")
897 ("\\(\\s-\\)'" "`"))))) 1108 ("\\(\\s-\\|(\\)'" "`")))))
898 (mapc (lambda(l) (goto-char (point-min)) 1109 (mapc (lambda(l) (goto-char (point-min))
899 (while (re-search-forward (car l) nil t) 1110 (while (re-search-forward (car l) nil t)
900 (let ((rpl (concat (match-string 1) (cadr l)))) 1111 (let ((rpl (concat (match-string 1) (cadr l))))
@@ -951,10 +1162,11 @@ See the `org-export-latex.el' code for a complete conversion table."
951 sub-superscript 1162 sub-superscript
952 (match-string 2) 1163 (match-string 2)
953 (match-string 1) 1164 (match-string 1)
954 (match-string 3))) "") t t))))))) 1165 (match-string 3))) "") t t)
1166 (backward-char 1)))))))
955 '(;"^\\([^\n$]*?\\|^\\)\\(\\\\?\\$\\)\\([^\n$]*\\)$" 1167 '(;"^\\([^\n$]*?\\|^\\)\\(\\\\?\\$\\)\\([^\n$]*\\)$"
956 "\\(\\(\\\\?\\$\\)\\)" 1168 "\\(\\(\\\\?\\$\\)\\)"
957 "\\([a-za-z0-9]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\([a-za-z0-9]+\\|[ \t\n]\\|[:punct:]\\|{[a-za-z0-9]+}\\|([a-za-z0-9]+)\\)" 1169 "\\([a-za-z0-9]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-za-z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-za-z0-9]+}\\|([a-za-z0-9]+)\\)"
958 "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|[a-zA-Z&#%{}\"]+\\)" 1170 "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|[a-zA-Z&#%{}\"]+\\)"
959 "\\(.\\|^\\)\\(&\\)" 1171 "\\(.\\|^\\)\\(&\\)"
960 "\\(.\\|^\\)\\(#\\)" 1172 "\\(.\\|^\\)\\(#\\)"
@@ -993,10 +1205,12 @@ Convert CHAR depending on STRING-BEFORE and STRING-AFTER."
993 (or (eq subsup t) 1205 (or (eq subsup t)
994 (and (equal subsup '{}) (eq (string-to-char string-after) ?\{))) 1206 (and (equal subsup '{}) (eq (string-to-char string-after) ?\{)))
995 (string-match "[({]?\\([^)}]+\\)[)}]?" string-after)) 1207 (string-match "[({]?\\([^)}]+\\)[)}]?" string-after))
996 (format "%s$%s{%s}$" string-before char 1208 (org-export-latex-protect-string
997 (if (> (match-end 1) (1+ (match-beginning 1))) 1209 (format "%s$%s{%s}$" string-before char
998 (concat "\\mathrm{" (match-string 1 string-after) "}") 1210 (if (and (> (match-end 1) (1+ (match-beginning 1)))
999 (match-string 1 string-after)))) 1211 (not (equal (substring string-after 0 2) "{\\")))
1212 (concat "\\mathrm{" (match-string 1 string-after) "}")
1213 (match-string 1 string-after)))))
1000 ((eq subsup t) (concat string-before "$" char string-after "$")) 1214 ((eq subsup t) (concat string-before "$" char string-after "$"))
1001 (t (org-export-latex-protect-string 1215 (t (org-export-latex-protect-string
1002 (concat string-before "\\" char "{}" string-after))))) 1216 (concat string-before "\\" char "{}" string-after)))))
@@ -1033,11 +1247,14 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1033(defun org-export-latex-keywords () 1247(defun org-export-latex-keywords ()
1034 "Convert special keywords to LaTeX." 1248 "Convert special keywords to LaTeX."
1035 (goto-char (point-min)) 1249 (goto-char (point-min))
1036 (let ((re (concat org-export-latex-special-keyword-regexp 1250 (while (re-search-forward org-export-latex-special-keyword-regexp nil t)
1037 ".*" ; including the time stamp.... 1251 (replace-match (format org-export-latex-timestamp-keyword-markup
1038 ))) 1252 (match-string 0)) t t)
1039 (while (re-search-forward re nil t) 1253 (save-excursion
1040 (replace-match (format "\\\\texttt{%s}" (match-string 0)) t)))) 1254 (beginning-of-line 1)
1255 (unless (looking-at ".*\\\\newline[ \t]*$")
1256 (end-of-line 1)
1257 (insert "\\newline")))))
1041 1258
1042(defun org-export-latex-fixed-width (opt) 1259(defun org-export-latex-fixed-width (opt)
1043 "When OPT is non-nil convert fixed-width sections to LaTeX." 1260 "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."
1089 (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr) 1306 (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr)
1090 (match-string 1 attr)) 1307 (match-string 1 attr))
1091 floatp (or caption label)) 1308 floatp (or caption label))
1092 (setq lines (split-string raw-table "\n" t)) 1309 (setq lines (org-split-string raw-table "\n"))
1093 (apply 'delete-region (list beg end)) 1310 (apply 'delete-region (list beg end))
1094 (when org-export-table-remove-special-lines 1311 (when org-export-table-remove-special-lines
1095 (setq lines (org-table-clean-before-export lines 'maybe-quoted))) 1312 (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."
1104 (lambda (x) 1321 (lambda (x)
1105 (setq gr (pop org-table-colgroup-info)) 1322 (setq gr (pop org-table-colgroup-info))
1106 (format "%s%%s%s" 1323 (format "%s%%s%s"
1107 (cond ((eq gr ':start) 1324 (cond ((eq gr :start)
1108 (prog1 (if colgropen "|" "") 1325 (prog1 (if colgropen "|" "|")
1109 (setq colgropen t))) 1326 (setq colgropen t)))
1110 ((eq gr ':startend) 1327 ((eq gr :startend)
1111 (prog1 (if colgropen "|" "|") 1328 (prog1 (if colgropen "|" "|")
1112 (setq colgropen nil))) 1329 (setq colgropen nil)))
1113 (t "")) 1330 (t ""))
@@ -1132,7 +1349,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1132 (mapcar 1349 (mapcar
1133 (lambda(elem) 1350 (lambda(elem)
1134 (or (and (string-match "[ \t]*|-+" elem) 'hline) 1351 (or (and (string-match "[ \t]*|-+" elem) 'hline)
1135 (split-string (org-trim elem) "|" t))) 1352 (org-split-string (org-trim elem) "|")))
1136 lines)) 1353 lines))
1137 (when insert 1354 (when insert
1138 (insert (org-export-latex-protect-string 1355 (insert (org-export-latex-protect-string
@@ -1146,7 +1363,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1146 (if label (concat "\\\label{" label "}") "") 1363 (if label (concat "\\\label{" label "}") "")
1147 (or caption ""))) 1364 (or caption "")))
1148 (if longtblp "\\\\\n" "\n") 1365 (if longtblp "\\\\\n" "\n")
1149 (if (not longtblp) "\\begin{center}\n") 1366 (if (and org-export-latex-tables-centered (not longtblp))
1367 "\\begin{center}\n")
1150 (if (not longtblp) (concat "\\begin{tabular}{" align "}\n")) 1368 (if (not longtblp) (concat "\\begin{tabular}{" align "}\n"))
1151 (orgtbl-to-latex 1369 (orgtbl-to-latex
1152 lines 1370 lines
@@ -1160,7 +1378,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1160\\endlastfoot" (length org-table-last-alignment)) 1378\\endlastfoot" (length org-table-last-alignment))
1161 nil))) 1379 nil)))
1162 (if (not longtblp) (concat "\n\\end{tabular}")) 1380 (if (not longtblp) (concat "\n\\end{tabular}"))
1163 (if longtblp "\n" "\n\\end{center}\n") 1381 (if longtblp "\n" (if org-export-latex-tables-centered
1382 "\n\\end{center}\n" "\n"))
1164 (if longtblp 1383 (if longtblp
1165 "\\end{longtable}" 1384 "\\end{longtable}"
1166 (if floatp "\\end{table}")))) 1385 (if floatp "\\end{table}"))))
@@ -1176,6 +1395,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1176 (beg (match-beginning 0)) 1395 (beg (match-beginning 0))
1177 (end (match-end 0)) 1396 (end (match-end 0))
1178 rpl) 1397 rpl)
1398 (unless emph
1399 (message "`org-export-latex-emphasis-alist' has no entry for formatting triggered by \"%s\""
1400 (match-string 3)))
1179 (unless (or (get-text-property (1- (point)) 'org-protected) 1401 (unless (or (get-text-property (1- (point)) 'org-protected)
1180 (save-excursion 1402 (save-excursion
1181 (goto-char (match-beginning 1)) 1403 (goto-char (match-beginning 1))
@@ -1184,15 +1406,46 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1184 (string-match 1406 (string-match
1185 "[|\n]" (buffer-substring beg end)))))) 1407 "[|\n]" (buffer-substring beg end))))))
1186 (setq rpl (concat (match-string 1) 1408 (setq rpl (concat (match-string 1)
1187 (format (org-export-latex-protect-char-in-string 1409 (org-export-latex-emph-format (cadr emph)
1188 '("\\" "{" "}") (cadr emph)) 1410 (match-string 4))
1189 (match-string 4))
1190 (match-string 5))) 1411 (match-string 5)))
1191 (if (caddr emph) 1412 (if (caddr emph)
1192 (setq rpl (org-export-latex-protect-string rpl))) 1413 (setq rpl (org-export-latex-protect-string rpl)))
1193 (replace-match rpl t t))) 1414 (replace-match rpl t t)))
1194 (backward-char))) 1415 (backward-char)))
1195 1416
1417(defvar org-export-latex-use-verb nil)
1418(defun org-export-latex-emph-format (format string)
1419 "Format an emphasis string and handle the \\verb special case."
1420 (when (equal format "\\verb")
1421 (save-match-data
1422 (if org-export-latex-use-verb
1423 (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
1424 (catch 'exit
1425 (loop for i from 0 to (1- (length ll)) do
1426 (if (not (string-match (regexp-quote (substring ll i (1+ i)))
1427 string))
1428 (progn
1429 (setq format (concat "\\verb" (substring ll i (1+ i))
1430 "%s" (substring ll i (1+ i))))
1431 (throw 'exit nil))))))
1432 (let ((start 0)
1433 (trans '(("\\" . "\\backslash")
1434 ("~" . "\\ensuremath{\\sim}")
1435 ("^" . "\\ensuremath{\\wedge}")))
1436 (rtn "") char)
1437 (while (string-match "[\\{}$%&_#~^]" string)
1438 (setq char (match-string 0 string))
1439 (if (> (match-beginning 0) 0)
1440 (setq rtn (concat rtn (substring string
1441 0 (match-beginning 0)))))
1442 (setq string (substring string (1+ (match-beginning 0))))
1443 (setq char (or (cdr (assoc char trans)) (concat "\\" char))
1444 rtn (concat rtn char)))
1445 (setq string (concat rtn string) format "\\texttt{%s}")))))
1446 (setq string (org-export-latex-protect-string
1447 (format format string))))
1448
1196(defun org-export-latex-links () 1449(defun org-export-latex-links ()
1197 ;; Make sure to use the LaTeX hyperref and graphicx package 1450 ;; Make sure to use the LaTeX hyperref and graphicx package
1198 ;; or send some warnings. 1451 ;; or send some warnings.
@@ -1212,7 +1465,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1212 "file"))) 1465 "file")))
1213 (coderefp (equal type "coderef")) 1466 (coderefp (equal type "coderef"))
1214 (caption (org-find-text-property-in-string 'org-caption raw-path)) 1467 (caption (org-find-text-property-in-string 'org-caption raw-path))
1215 (attr (org-find-text-property-in-string 'org-attributes raw-path)) 1468 (attr (or (org-find-text-property-in-string 'org-attributes raw-path)
1469 (plist-get org-export-latex-options-plist :latex-image-options)))
1216 (label (org-find-text-property-in-string 'org-label raw-path)) 1470 (label (org-find-text-property-in-string 'org-label raw-path))
1217 (floatp (or label caption)) 1471 (floatp (or label caption))
1218 imgp radiop 1472 imgp radiop
@@ -1231,7 +1485,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1231 (expand-file-name 1485 (expand-file-name
1232 raw-path) 1486 raw-path)
1233 org-export-latex-inline-image-extensions) 1487 org-export-latex-inline-image-extensions)
1234 (equal desc full-raw-path)) 1488 (or (get-text-property 0 'org-no-description
1489 raw-path)
1490 (equal desc full-raw-path)))
1235 (setq imgp t) 1491 (setq imgp t)
1236 (progn (when (string-match "\\(.+\\)::.+" raw-path) 1492 (progn (when (string-match "\\(.+\\)::.+" raw-path)
1237 (setq raw-path (match-string 1 raw-path))) 1493 (setq raw-path (match-string 1 raw-path)))
@@ -1247,7 +1503,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1247 (concat 1503 (concat
1248 (if floatp "\\begin{figure}[htb]\n") 1504 (if floatp "\\begin{figure}[htb]\n")
1249 (format "\\centerline{\\includegraphics[%s]{%s}}\n" 1505 (format "\\centerline{\\includegraphics[%s]{%s}}\n"
1250 (or attr org-export-latex-image-default-option) 1506 attr
1251 (if (file-name-absolute-p raw-path) 1507 (if (file-name-absolute-p raw-path)
1252 (expand-file-name raw-path) 1508 (expand-file-name raw-path)
1253 raw-path)) 1509 raw-path))
@@ -1264,14 +1520,20 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1264 (org-solidify-link-text raw-path) desc))) 1520 (org-solidify-link-text raw-path) desc)))
1265 ((not type) 1521 ((not type)
1266 (insert (format "\\hyperref[%s]{%s}" 1522 (insert (format "\\hyperref[%s]{%s}"
1267 (org-solidify-link-text raw-path) desc))) 1523 (org-remove-initial-hash
1524 (org-solidify-link-text raw-path)) desc)))
1268 (path (insert (format "\\href{%s}{%s}" path desc))) 1525 (path (insert (format "\\href{%s}{%s}" path desc)))
1269 (t (insert "\\texttt{" desc "}"))))))) 1526 (t (insert "\\texttt{" desc "}")))))))
1270 1527
1528(defun org-remove-initial-hash (s)
1529 (if (string-match "\\`#" s)
1530 (substring s 1)
1531 s))
1271(defvar org-latex-entities) ; defined below 1532(defvar org-latex-entities) ; defined below
1272(defvar org-latex-entities-regexp) ; defined below 1533(defvar org-latex-entities-regexp) ; defined below
1534(defvar org-latex-entities-exceptions) ; defined below
1273 1535
1274(defun org-export-latex-preprocess () 1536(defun org-export-latex-preprocess (parameters)
1275 "Clean stuff in the LaTeX export." 1537 "Clean stuff in the LaTeX export."
1276 ;; Preserve line breaks 1538 ;; Preserve line breaks
1277 (goto-char (point-min)) 1539 (goto-char (point-min))
@@ -1281,13 +1543,16 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1281 1543
1282 ;; Preserve latex environments 1544 ;; Preserve latex environments
1283 (goto-char (point-min)) 1545 (goto-char (point-min))
1284 (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\)}" nil t) 1546 (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t)
1285 (let* ((start (progn (beginning-of-line) (point))) 1547 (let* ((start (progn (beginning-of-line) (point)))
1286 (end (or (and (re-search-forward 1548 (end (and (re-search-forward
1287 (concat "^[ \t]*\\\\end{" (match-string 1) "}") nil t) 1549 (concat "^[ \t]*\\\\end{"
1288 (point-at-eol)) 1550 (regexp-quote (match-string 1))
1289 (point-max)))) 1551 "}") nil t)
1290 (add-text-properties start end '(org-protected t)))) 1552 (point-at-eol))))
1553 (if end
1554 (add-text-properties start end '(org-protected t))
1555 (goto-char (point-at-eol)))))
1291 1556
1292 ;; Preserve math snippets 1557 ;; Preserve math snippets
1293 1558
@@ -1316,18 +1581,39 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1316 ;; Convert blockquotes 1581 ;; Convert blockquotes
1317 (goto-char (point-min)) 1582 (goto-char (point-min))
1318 (while (search-forward "ORG-BLOCKQUOTE-START" nil t) 1583 (while (search-forward "ORG-BLOCKQUOTE-START" nil t)
1319 (replace-match "\\begin{quote}" t t)) 1584 (org-replace-match-keep-properties "\\begin{quote}" t t))
1320 (goto-char (point-min)) 1585 (goto-char (point-min))
1321 (while (search-forward "ORG-BLOCKQUOTE-END" nil t) 1586 (while (search-forward "ORG-BLOCKQUOTE-END" nil t)
1322 (replace-match "\\end{quote}" t t)) 1587 (org-replace-match-keep-properties "\\end{quote}" t t))
1323 1588
1324 ;; Convert verse 1589 ;; Convert verse
1325 (goto-char (point-min)) 1590 (goto-char (point-min))
1326 (while (search-forward "ORG-VERSE-START" nil t) 1591 (while (search-forward "ORG-VERSE-START" nil t)
1327 (replace-match "\\begin{verse}" t t)) 1592 (org-replace-match-keep-properties "\\begin{verse}" t t)
1593 (beginning-of-line 2)
1594 (while (and (not (looking-at "[ \t]*ORG-VERSE-END.*")) (not (eobp)))
1595 (when (looking-at "\\([ \t]+\\)\\([^ \t\n]\\)")
1596 (goto-char (match-end 1))
1597 (org-replace-match-keep-properties
1598 (org-export-latex-protect-string
1599 (concat "\\hspace*{1cm}" (match-string 2))) t t)
1600 (beginning-of-line 1))
1601 (unless (looking-at ".*?[^ \t\n].*?\\\\\\\\[ \t]*$")
1602 (end-of-line 1)
1603 (insert "\\\\"))
1604 (beginning-of-line 2))
1605 (and (looking-at "[ \t]*ORG-VERSE-END.*")
1606 (org-replace-match-keep-properties "\\end{verse}" t t)))
1607
1608 ;; Convert center
1609 (goto-char (point-min))
1610 (while (search-forward "ORG-CENTER-START" nil t)
1611 (org-replace-match-keep-properties "\\begin{center}" t t))
1328 (goto-char (point-min)) 1612 (goto-char (point-min))
1329 (while (search-forward "ORG-VERSE-END" nil t) 1613 (while (search-forward "ORG-CENTER-END" nil t)
1330 (replace-match "\\end{verse}" t t)) 1614 (org-replace-match-keep-properties "\\end{center}" t t))
1615
1616 (run-hooks 'org-export-latex-after-blockquotes-hook)
1331 1617
1332 ;; Convert horizontal rules 1618 ;; Convert horizontal rules
1333 (goto-char (point-min)) 1619 (goto-char (point-min))
@@ -1336,16 +1622,23 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1336 (replace-match (org-export-latex-protect-string "\\hrule") t t))) 1622 (replace-match (org-export-latex-protect-string "\\hrule") t t)))
1337 1623
1338 ;; Protect LaTeX commands like \command[...]{...} or \command{...} 1624 ;; Protect LaTeX commands like \command[...]{...} or \command{...}
1339 (goto-char (point-min)) 1625 (let ((re (concat "\\\\[a-zA-Z]+\\(?:"
1340 (while (re-search-forward "\\\\[a-zA-Z]+\\(?:\\[.*\\]\\)?{.*}" nil t) 1626 "\\[.*\\]"
1341 (add-text-properties (match-beginning 0) (match-end 0) 1627 "\\)?"
1342 '(org-protected t))) 1628 (org-create-multibrace-regexp "{" "}" 3))))
1629 (while (re-search-forward re nil t)
1630 (add-text-properties (match-beginning 0) (match-end 0)
1631 '(org-protected t))))
1343 1632
1344 ;; Protect LaTeX entities 1633 ;; Protect LaTeX entities
1345 (goto-char (point-min)) 1634 (goto-char (point-min))
1346 (while (re-search-forward org-latex-entities-regexp nil t) 1635 (let (a)
1347 (add-text-properties (match-beginning 0) (match-end 0) 1636 (while (re-search-forward org-latex-entities-regexp nil t)
1348 '(org-protected t))) 1637 (if (setq a (assoc (match-string 0) org-latex-entities-exceptions))
1638 (replace-match (org-add-props (nth 1 a) nil 'org-protected t)
1639 t t)
1640 (add-text-properties (match-beginning 0) (match-end 0)
1641 '(org-protected t)))))
1349 1642
1350 ;; Replace radio links 1643 ;; Replace radio links
1351 (goto-char (point-min)) 1644 (goto-char (point-min))
@@ -1525,6 +1818,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1525 "\\medskip" 1818 "\\medskip"
1526 "\\multicolumn" 1819 "\\multicolumn"
1527 "\\multiput" 1820 "\\multiput"
1821 ("\\nbsp" "~")
1528 "\\newcommand" 1822 "\\newcommand"
1529 "\\newcounter" 1823 "\\newcounter"
1530 "\\newenvironment" 1824 "\\newenvironment"
@@ -1596,9 +1890,14 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1596 "\\vspace") 1890 "\\vspace")
1597 "A list of LaTeX commands to be protected when performing conversion.") 1891 "A list of LaTeX commands to be protected when performing conversion.")
1598 1892
1893(defvar org-latex-entities-exceptions nil)
1894
1599(defconst org-latex-entities-regexp 1895(defconst org-latex-entities-regexp
1600 (let (names rest) 1896 (let (names rest)
1601 (dolist (x org-latex-entities) 1897 (dolist (x org-latex-entities)
1898 (when (consp x)
1899 (add-to-list 'org-latex-entities-exceptions x)
1900 (setq x (car x)))
1602 (if (string-match "[a-z][A-Z]$" x) 1901 (if (string-match "[a-z][A-Z]$" x)
1603 (push x names) 1902 (push x names)
1604 (push x rest))) 1903 (push x rest)))
@@ -1606,7 +1905,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
1606 "\\|\\(" (regexp-opt (nreverse rest)) "\\)"))) 1905 "\\|\\(" (regexp-opt (nreverse rest)) "\\)")))
1607 1906
1608(provide 'org-export-latex) 1907(provide 'org-export-latex)
1908(provide 'org-latex)
1609 1909
1610;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad 1910;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad
1611 1911
1612;;; org-export-latex.el ends here 1912;;; 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 @@
7;; Bastien Guerry <bzg AT altern DOT org> 7;; Bastien Guerry <bzg AT altern DOT org>
8;; Keywords: outlines, hypermedia, calendar, wp 8;; Keywords: outlines, hypermedia, calendar, wp
9;; Homepage: http://orgmode.org 9;; Homepage: http://orgmode.org
10;; Version: 6.21b 10;; Version: 6.29c
11;; 11;;
12;; This file is part of GNU Emacs. 12;; This file is part of GNU Emacs.
13;; 13;;
@@ -36,6 +36,8 @@
36 36
37(defvar org-blank-before-new-entry) 37(defvar org-blank-before-new-entry)
38(defvar org-M-RET-may-split-line) 38(defvar org-M-RET-may-split-line)
39(defvar org-complex-heading-regexp)
40(defvar org-odd-levels-only)
39 41
40(declare-function org-invisible-p "org" ()) 42(declare-function org-invisible-p "org" ())
41(declare-function org-on-heading-p "org" (&optional invisible-ok)) 43(declare-function org-on-heading-p "org" (&optional invisible-ok))
@@ -48,21 +50,57 @@
48(declare-function org-get-indentation "org" (&optional line)) 50(declare-function org-get-indentation "org" (&optional line))
49(declare-function org-timer-item "org-timer" (&optional arg)) 51(declare-function org-timer-item "org-timer" (&optional arg))
50(declare-function org-combine-plists "org" (&rest plists)) 52(declare-function org-combine-plists "org" (&rest plists))
53(declare-function org-entry-get "org" (pom property &optional inherit))
54(declare-function org-narrow-to-subtree "org" ())
55(declare-function org-show-subtree "org" ())
51 56
52(defgroup org-plain-lists nil 57(defgroup org-plain-lists nil
53 "Options concerning plain lists in Org-mode." 58 "Options concerning plain lists in Org-mode."
54 :tag "Org Plain lists" 59 :tag "Org Plain lists"
55 :group 'org-structure) 60 :group 'org-structure)
56 61
57(defcustom org-cycle-include-plain-lists nil 62(defcustom org-cycle-include-plain-lists t
58 "Non-nil means, include plain lists into visibility cycling. 63 "When t, make TAB cycle visibility on plain list items.
59This means that during cycling, plain list items will *temporarily* be 64
60interpreted as outline headlines with a level given by 1000+i where i is the 65Cycling plain lists works only when the cursor is on a plain list
61indentation of the bullet. In all other operations, plain list items are 66item. When the cursor is on an outline heading, plain lists are
62not seen as headlines. For example, you cannot assign a TODO keyword to 67treated as text. This is the most stable way of handling this,
63such an item." 68which is why it is the default.
69
70When this is the symbol `integrate', then during cycling, plain
71list items will *temporarily* be interpreted as outline headlines
72with a level given by 1000+i where i is the indentation of the
73bullet. This setting can lead to strange effects when switching
74visibility to `children', because the first \"child\" in a
75subtree decides what children should be listed. If that first
76\"child\" is a plain list item with an implied large level
77number, all true children and grand children of the outline
78heading will be exposed in a children' view."
64 :group 'org-plain-lists 79 :group 'org-plain-lists
65 :type 'boolean) 80 :type '(choice
81 (const :tag "Never" nil)
82 (const :tag "With cursor in plain list (recommended)" t)
83 (const :tag "As children of outline headings" integrate)))
84
85(defcustom org-list-demote-modify-bullet nil
86 "Default bullet type installed when demoting an item.
87This is an association list, for each bullet type, this alist will point
88to the bulled that should be used when this item is demoted."
89 :group 'org-plain-lists
90 :type '(repeat
91 (cons
92 (choice :tag "If the current bullet is "
93 (const "-")
94 (const "+")
95 (const "*")
96 (const "1.")
97 (const "1)"))
98 (choice :tag "demotion will change it to"
99 (const "-")
100 (const "+")
101 (const "*")
102 (const "1.")
103 (const "1)")))))
66 104
67(defcustom org-plain-list-ordered-item-terminator t 105(defcustom org-plain-list-ordered-item-terminator t
68 "The character that makes a line with leading number an ordered list item. 106 "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."
103 141
104(defcustom org-provide-checkbox-statistics t 142(defcustom org-provide-checkbox-statistics t
105 "Non-nil means, update checkbox statistics after insert and toggle. 143 "Non-nil means, update checkbox statistics after insert and toggle.
106When this is set, checkbox statistics is updated each time you either insert 144When this is set, checkbox statistics is updated each time you
107a new checkbox with \\[org-insert-todo-heading] or toggle a checkbox 145either insert a new checkbox with \\[org-insert-todo-heading] or
108with \\[org-ctrl-c-ctrl-c\\]." 146toggle a checkbox with \\[org-ctrl-c-ctrl-c]."
147 :group 'org-plain-lists
148 :type 'boolean)
149
150(defcustom org-hierarchical-checkbox-statistics t
151 "Non-nil means, checkbox statistics counts only the state of direct children.
152When nil, all boxes below the cookie are counted."
109 :group 'org-plain-lists 153 :group 'org-plain-lists
110 :type 'boolean) 154 :type 'boolean)
111 155
@@ -117,7 +161,7 @@ When the indentation would be larger than this, it will become
117 :type 'integer) 161 :type 'integer)
118 162
119(defvar org-list-beginning-re 163(defvar org-list-beginning-re
120 "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +\\(.*\\)$") 164 "^\\([ \t]*\\)\\([-+]\\|[0-9]+[.)]\\) +\\(.*\\)$")
121 165
122(defcustom org-list-radio-list-templates 166(defcustom org-list-radio-list-templates
123 '((latex-mode "% BEGIN RECEIVE ORGLST %n 167 '((latex-mode "% BEGIN RECEIVE ORGLST %n
@@ -159,7 +203,7 @@ list, obtained by prompting the user."
159 (cond 203 (cond
160 ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") 204 ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
161 ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") 205 ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
162 ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+))\\)\\|[ \t]+\\*\\)\\( \\|$\\)") 206 ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
163 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) 207 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
164 208
165(defun org-at-item-bullet-p () 209(defun org-at-item-bullet-p ()
@@ -208,7 +252,9 @@ Return t when things worked, nil when we are not in an item."
208 descp)))) 252 descp))))
209 (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") 253 (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")
210 (match-end 0))) 254 (match-end 0)))
211 (blank-a (cdr (assq 'plain-list-item org-blank-before-new-entry))) 255 (blank-a (if org-empty-line-terminates-plain-lists
256 nil
257 (cdr (assq 'plain-list-item org-blank-before-new-entry))))
212 (blank (if (eq blank-a 'auto) empty-line-p blank-a)) 258 (blank (if (eq blank-a 'auto) empty-line-p blank-a))
213 pos) 259 pos)
214 (if descp (setq checkbox nil)) 260 (if descp (setq checkbox nil))
@@ -251,6 +297,7 @@ Return t when things worked, nil when we are not in an item."
251(defun org-toggle-checkbox (&optional toggle-presence) 297(defun org-toggle-checkbox (&optional toggle-presence)
252 "Toggle the checkbox in the current line. 298 "Toggle the checkbox in the current line.
253With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. 299With prefix arg TOGGLE-PRESENCE, add or remove checkboxes.
300With double prefix, set checkbox to [-].
254When there is an active region, toggle status or presence of the checkbox 301When there is an active region, toggle status or presence of the checkbox
255in the first line, and make every item in the region have the same 302in the first line, and make every item in the region have the same
256status or presence, respectively. 303status or presence, respectively.
@@ -258,24 +305,27 @@ If the cursor is in a headline, apply this to all checkbox items in the
258text below the heading." 305text below the heading."
259 (interactive "P") 306 (interactive "P")
260 (catch 'exit 307 (catch 'exit
261 (let (beg end status first-present first-status) 308 (let (beg end status first-present first-status blocked)
262 (cond 309 (cond
263 ((org-region-active-p) 310 ((org-region-active-p)
264 (setq beg (region-beginning) end (region-end))) 311 (setq beg (region-beginning) end (region-end)))
265 ((org-on-heading-p) 312 ((org-on-heading-p)
266 (setq beg (point) end (save-excursion (outline-next-heading) (point)))) 313 (setq beg (point) end (save-excursion (outline-next-heading) (point))))
267 ((org-at-item-checkbox-p) 314 ((org-at-item-checkbox-p)
268 (let ((pos (point))) 315 (save-excursion
269 (if toggle-presence 316 (if (equal toggle-presence '(4))
270 (progn 317 (progn
271 (replace-match "") 318 (replace-match "")
272 (goto-char (match-beginning 0)) 319 (goto-char (match-beginning 0))
273 (just-one-space)) 320 (just-one-space))
321 (when (setq blocked (org-checkbox-blocked-p))
322 (error "Checkbox blocked because of unchecked box in line %d"
323 blocked))
274 (replace-match 324 (replace-match
275 (cond ((member (match-string 0) '("[ ]" "[-]")) "[X]") 325 (cond ((equal toggle-presence '(16)) "[-]")
326 ((member (match-string 0) '("[ ]" "[-]")) "[X]")
276 (t "[ ]")) 327 (t "[ ]"))
277 t t)) 328 t t)))
278 (goto-char pos))
279 (throw 'exit t)) 329 (throw 'exit t))
280 ((org-at-item-p) 330 ((org-at-item-p)
281 ;; add a checkbox 331 ;; add a checkbox
@@ -312,10 +362,53 @@ text below the heading."
312 (beginning-of-line 2))))) 362 (beginning-of-line 2)))))
313 (org-update-checkbox-count-maybe)) 363 (org-update-checkbox-count-maybe))
314 364
365(defun org-reset-checkbox-state-subtree ()
366 "Reset all checkboxes in an entry subtree."
367 (interactive "*")
368 (save-restriction
369 (save-excursion
370 (org-narrow-to-subtree)
371 (org-show-subtree)
372 (goto-char (point-min))
373 (let ((end (point-max)))
374 (while (< (point) end)
375 (when (org-at-item-checkbox-p)
376 (replace-match "[ ]" t t))
377 (beginning-of-line 2))))
378 (org-update-checkbox-count-maybe)))
379
380(defun org-checkbox-blocked-p ()
381 "Is the current checkbox blocked from for being checked now?
382A checkbox is blocked if all of the following conditions are fulfilled:
383
3841. The checkbox is not checked already.
3852. The current entry has the ORDERED property set.
3863. There is an unchecked checkbox in this entry before the current line."
387 (catch 'exit
388 (save-match-data
389 (save-excursion
390 (unless (org-at-item-checkbox-p) (throw 'exit nil))
391 (when (equal (match-string 0) "[X]")
392 ;; the box is already checked!
393 (throw 'exit nil))
394 (let ((end (point-at-bol)))
395 (condition-case nil (org-back-to-heading t)
396 (error (throw 'exit nil)))
397 (unless (org-entry-get nil "ORDERED") (throw 'exit nil))
398 (if (re-search-forward "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t)
399 (org-current-line)
400 nil))))))
401
402(defvar org-checkbox-statistics-hook nil
403 "Hook that is run whenever Org thinks checkbox statistics should be updated.
404This hook runs even if `org-provide-checkbox-statistics' is nil, to it can
405be used to implement alternative ways of collecting statistics information.")
406
315(defun org-update-checkbox-count-maybe () 407(defun org-update-checkbox-count-maybe ()
316 "Update checkbox statistics unless turned off by user." 408 "Update checkbox statistics unless turned off by user."
317 (when org-provide-checkbox-statistics 409 (when org-provide-checkbox-statistics
318 (org-update-checkbox-count))) 410 (org-update-checkbox-count))
411 (run-hooks 'org-checkbox-statistics-hook))
319 412
320(defun org-update-checkbox-count (&optional all) 413(defun org-update-checkbox-count (&optional all)
321 "Update the checkbox statistics in the current section. 414 "Update the checkbox statistics in the current section.
@@ -335,6 +428,10 @@ the whole buffer."
335 (re-find (concat re "\\|" re-box)) 428 (re-find (concat re "\\|" re-box))
336 beg-cookie end-cookie is-percent c-on c-off lim 429 beg-cookie end-cookie is-percent c-on c-off lim
337 eline curr-ind next-ind continue-from startsearch 430 eline curr-ind next-ind continue-from startsearch
431 (recursive
432 (or (not org-hierarchical-checkbox-statistics)
433 (string-match "\\<recursive\\>"
434 (or (org-entry-get nil "COOKIE_DATA") ""))))
338 (cstat 0) 435 (cstat 0)
339 ) 436 )
340 (when all 437 (when all
@@ -342,8 +439,15 @@ the whole buffer."
342 (outline-next-heading) 439 (outline-next-heading)
343 (setq beg (point) end (point-max))) 440 (setq beg (point) end (point-max)))
344 (goto-char end) 441 (goto-char end)
345 ;; find each statistic cookie 442 ;; find each statistics cookie
346 (while (re-search-backward re-find beg t) 443 (while (and (re-search-backward re-find beg t)
444 (not (save-match-data
445 (and (org-on-heading-p)
446 (string-match "\\<todo\\>"
447 (downcase
448 (or (org-entry-get
449 nil "COOKIE_DATA")
450 "")))))))
347 (setq beg-cookie (match-beginning 1) 451 (setq beg-cookie (match-beginning 1)
348 end-cookie (match-end 1) 452 end-cookie (match-end 1)
349 cstat (+ cstat (if end-cookie 1 0)) 453 cstat (+ cstat (if end-cookie 1 0))
@@ -365,17 +469,21 @@ the whole buffer."
365 (org-beginning-of-item) 469 (org-beginning-of-item)
366 (setq curr-ind (org-get-indentation)) 470 (setq curr-ind (org-get-indentation))
367 (setq next-ind curr-ind) 471 (setq next-ind curr-ind)
368 (while (and (bolp) (org-at-item-p) (= curr-ind next-ind)) 472 (while (and (bolp) (org-at-item-p)
473 (if recursive
474 (<= curr-ind next-ind)
475 (= curr-ind next-ind)))
369 (save-excursion (end-of-line) (setq eline (point))) 476 (save-excursion (end-of-line) (setq eline (point)))
370 (if (re-search-forward re-box eline t) 477 (if (re-search-forward re-box eline t)
371 (if (member (match-string 2) '("[ ]" "[-]")) 478 (if (member (match-string 2) '("[ ]" "[-]"))
372 (setq c-off (1+ c-off)) 479 (setq c-off (1+ c-off))
373 (setq c-on (1+ c-on)) 480 (setq c-on (1+ c-on))))
374 ) 481 (if (not recursive)
375 ) 482 (org-end-of-item)
376 (org-end-of-item) 483 (end-of-line)
377 (setq next-ind (org-get-indentation)) 484 (when (re-search-forward org-list-beginning-re lim t)
378 ))) 485 (beginning-of-line)))
486 (setq next-ind (org-get-indentation)))))
379 (goto-char continue-from) 487 (goto-char continue-from)
380 ;; update cookie 488 ;; update cookie
381 (when end-cookie 489 (when end-cookie
@@ -408,11 +516,13 @@ the whole buffer."
408The face will be `org-done' when all relevant boxes are checked. Otherwise 516The face will be `org-done' when all relevant boxes are checked. Otherwise
409it will be `org-todo'." 517it will be `org-todo'."
410 (if (match-end 1) 518 (if (match-end 1)
411 (if (equal (match-string 1) "100%") 'org-done 'org-todo) 519 (if (equal (match-string 1) "100%")
520 'org-checkbox-statistics-done
521 'org-checkbox-statistics-todo)
412 (if (and (> (match-end 2) (match-beginning 2)) 522 (if (and (> (match-end 2) (match-beginning 2))
413 (equal (match-string 2) (match-string 3))) 523 (equal (match-string 2) (match-string 3)))
414 'org-done 524 'org-checkbox-statistics-done
415 'org-todo))) 525 'org-checkbox-statistics-todo)))
416 526
417(defun org-beginning-of-item () 527(defun org-beginning-of-item ()
418 "Go to the beginning of the current hand-formatted item. 528 "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."
513 (error "On first item"))))) 623 (error "On first item")))))
514 624
515(defun org-first-list-item-p () 625(defun org-first-list-item-p ()
516 "Is this heading the item in a plain list?" 626 "Is this heading the first item in a plain list?"
517 (unless (org-at-item-p) 627 (unless (org-at-item-p)
518 (error "Not at a plain list item")) 628 (error "Not at a plain list item"))
519 (org-beginning-of-item) 629 (save-excursion
520 (= (point) (save-excursion (org-beginning-of-item-list)))) 630 (org-beginning-of-item)
631 (= (point) (save-excursion (org-beginning-of-item-list)))))
521 632
522(defun org-move-item-down () 633(defun org-move-item-down ()
523 "Move the plain list item at point down, i.e. swap with following item. 634 "Move the plain list item at point down, i.e. swap with following item.
@@ -705,7 +816,7 @@ with something like \"1.\" or \"2)\"."
705 (org-beginning-of-item-list) 816 (org-beginning-of-item-list)
706 (setq bobp (bobp)) 817 (setq bobp (bobp))
707 (looking-at "[ \t]*[0-9]+\\([.)]\\)") 818 (looking-at "[ \t]*[0-9]+\\([.)]\\)")
708 (setq fmt (concat "%d" (match-string 1))) 819 (setq fmt (concat "%d" (or (match-string 1) ".")))
709 (beginning-of-line 0) 820 (beginning-of-line 0)
710 ;; walk forward and replace these numbers 821 ;; walk forward and replace these numbers
711 (catch 'exit 822 (catch 'exit
@@ -726,7 +837,7 @@ with something like \"1.\" or \"2)\"."
726 (goto-line line) 837 (goto-line line)
727 (org-move-to-column col))) 838 (org-move-to-column col)))
728 839
729(defun org-fix-bullet-type () 840(defun org-fix-bullet-type (&optional force-bullet)
730 "Make sure all items in this list have the same bullet as the first item. 841 "Make sure all items in this list have the same bullet as the first item.
731Also, fix the indentation." 842Also, fix the indentation."
732 (interactive) 843 (interactive)
@@ -740,7 +851,7 @@ Also, fix the indentation."
740 (beginning-of-line 1) 851 (beginning-of-line 1)
741 ;; find out what the bullet type is 852 ;; find out what the bullet type is
742 (looking-at "[ \t]*\\(\\S-+\\)") 853 (looking-at "[ \t]*\\(\\S-+\\)")
743 (setq bullet (concat (match-string 1) " ")) 854 (setq bullet (concat (or force-bullet (match-string 1)) " "))
744 (if (and org-list-two-spaces-after-bullet-regexp 855 (if (and org-list-two-spaces-after-bullet-regexp
745 (string-match org-list-two-spaces-after-bullet-regexp bullet)) 856 (string-match org-list-two-spaces-after-bullet-regexp bullet))
746 (setq bullet (concat bullet " "))) 857 (setq bullet (concat bullet " ")))
@@ -759,7 +870,7 @@ Also, fix the indentation."
759 (skip-chars-forward " \t") 870 (skip-chars-forward " \t")
760 (looking-at "\\S-+ *") 871 (looking-at "\\S-+ *")
761 (setq oldbullet (match-string 0)) 872 (setq oldbullet (match-string 0))
762 (replace-match bullet) 873 (unless (equal bullet oldbullet) (replace-match bullet))
763 (org-shift-item-indentation (- (length bullet) (length oldbullet)))))) 874 (org-shift-item-indentation (- (length bullet) (length oldbullet))))))
764 (goto-line line) 875 (goto-line line)
765 (org-move-to-column col) 876 (org-move-to-column col)
@@ -807,7 +918,6 @@ I.e. to the first item in this list."
807 (when (org-at-item-p) (setq pos (point-at-bol))))))) 918 (when (org-at-item-p) (setq pos (point-at-bol)))))))
808 (goto-char pos))) 919 (goto-char pos)))
809 920
810
811(defun org-end-of-item-list () 921(defun org-end-of-item-list ()
812 "Go to the end of the current item list. 922 "Go to the end of the current item list.
813I.e. to the text after the last item." 923I.e. to the text after the last item."
@@ -822,7 +932,9 @@ I.e. to the text after the last item."
822 (catch 'next 932 (catch 'next
823 (beginning-of-line 2) 933 (beginning-of-line 2)
824 (if (looking-at "[ \t]*$") 934 (if (looking-at "[ \t]*$")
825 (throw (if (eobp) 'exit 'next) t)) 935 (if (eobp)
936 (progn (setq pos (point)) (throw 'exit t))
937 (throw 'next t)))
826 (skip-chars-forward " \t") (setq ind1 (current-column)) 938 (skip-chars-forward " \t") (setq ind1 (current-column))
827 (if (or (< ind1 ind) 939 (if (or (< ind1 ind)
828 (and (= ind1 ind) 940 (and (= ind1 ind)
@@ -845,22 +957,25 @@ I.e. to the text after the last item."
845(defun org-indent-item (arg) 957(defun org-indent-item (arg)
846 "Indent a local list item." 958 "Indent a local list item."
847 (interactive "p") 959 (interactive "p")
960 (and (org-region-active-p) (org-cursor-to-region-beginning))
848 (unless (org-at-item-p) 961 (unless (org-at-item-p)
849 (error "Not on an item")) 962 (error "Not on an item"))
850 (save-excursion 963 (let (beg end ind ind1 ind-bul delta ind-down ind-up firstp)
851 (let (beg end ind ind1 tmp delta ind-down ind-up) 964 (setq firstp (org-first-list-item-p))
965 (save-excursion
966 (setq end (and (org-region-active-p) (region-end)))
852 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) 967 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
853 (setq beg org-last-indent-begin-marker 968 (setq beg org-last-indent-begin-marker
854 end org-last-indent-end-marker) 969 end org-last-indent-end-marker)
855 (org-beginning-of-item) 970 (org-beginning-of-item)
856 (setq beg (move-marker org-last-indent-begin-marker (point))) 971 (setq beg (move-marker org-last-indent-begin-marker (point)))
857 (org-end-of-item) 972 (org-end-of-item)
858 (setq end (move-marker org-last-indent-end-marker (point)))) 973 (setq end (move-marker org-last-indent-end-marker (or end (point)))))
859 (goto-char beg) 974 (goto-char beg)
860 (setq tmp (org-item-indent-positions) 975 (setq ind-bul (org-item-indent-positions)
861 ind (car tmp) 976 ind (caar ind-bul)
862 ind-down (nth 2 tmp) 977 ind-down (car (nth 2 ind-bul))
863 ind-up (nth 1 tmp) 978 ind-up (car (nth 1 ind-bul))
864 delta (if (> arg 0) 979 delta (if (> arg 0)
865 (if ind-down (- ind-down ind) 2) 980 (if ind-down (- ind-down ind) 2)
866 (if ind-up (- ind-up ind) -2))) 981 (if ind-up (- ind-up ind) -2)))
@@ -870,13 +985,16 @@ I.e. to the text after the last item."
870 (skip-chars-forward " \t") (setq ind1 (current-column)) 985 (skip-chars-forward " \t") (setq ind1 (current-column))
871 (delete-region (point-at-bol) (point)) 986 (delete-region (point-at-bol) (point))
872 (or (eolp) (org-indent-to-column (+ ind1 delta))) 987 (or (eolp) (org-indent-to-column (+ ind1 delta)))
873 (beginning-of-line 2)))) 988 (beginning-of-line 2)))
874 (org-fix-bullet-type) 989 (org-fix-bullet-type
875 (org-maybe-renumber-ordered-list-safe) 990 (and (> arg 0)
876 (save-excursion 991 (not firstp)
877 (beginning-of-line 0) 992 (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet))))
878 (condition-case nil (org-beginning-of-item) (error nil)) 993 (org-maybe-renumber-ordered-list-safe)
879 (org-maybe-renumber-ordered-list-safe))) 994 (save-excursion
995 (beginning-of-line 0)
996 (condition-case nil (org-beginning-of-item) (error nil))
997 (org-maybe-renumber-ordered-list-safe))))
880 998
881(defun org-item-indent-positions () 999(defun org-item-indent-positions ()
882 "Return indentation for plain list items. 1000 "Return indentation for plain list items.
@@ -885,13 +1003,15 @@ parent indentation and the indentation a child should have.
885Assumes cursor in item line." 1003Assumes cursor in item line."
886 (let* ((bolpos (point-at-bol)) 1004 (let* ((bolpos (point-at-bol))
887 (ind (org-get-indentation)) 1005 (ind (org-get-indentation))
888 ind-down ind-up pos) 1006 (bullet (org-get-bullet))
1007 ind-down ind-up bullet-up bullet-down pos)
889 (save-excursion 1008 (save-excursion
890 (org-beginning-of-item-list) 1009 (org-beginning-of-item-list)
891 (skip-chars-backward "\n\r \t") 1010 (skip-chars-backward "\n\r \t")
892 (when (org-in-item-p) 1011 (when (org-in-item-p)
893 (org-beginning-of-item) 1012 (org-beginning-of-item)
894 (setq ind-up (org-get-indentation)))) 1013 (setq ind-up (org-get-indentation))
1014 (setq bullet-up (org-get-bullet))))
895 (setq pos (point)) 1015 (setq pos (point))
896 (save-excursion 1016 (save-excursion
897 (cond 1017 (cond
@@ -899,14 +1019,30 @@ Assumes cursor in item line."
899 (error nil)) 1019 (error nil))
900 (or (forward-char 1) t) 1020 (or (forward-char 1) t)
901 (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t)) 1021 (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t))
902 (setq ind-down (org-get-indentation))) 1022 (setq ind-down (org-get-indentation)
1023 bullet-down (org-get-bullet)))
903 ((and (goto-char pos) 1024 ((and (goto-char pos)
904 (org-at-item-p)) 1025 (org-at-item-p))
905 (goto-char (match-end 0)) 1026 (goto-char (match-end 0))
906 (skip-chars-forward " \t") 1027 (skip-chars-forward " \t")
907 (setq ind-down (current-column))))) 1028 (setq ind-down (current-column)
908 (list ind ind-up ind-down))) 1029 bullet-down (org-get-bullet)))))
909 1030 (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down))
1031 (setq bullet-down (concat "1" (match-string 1 bullet-down))))
1032 (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up))
1033 (setq bullet-up (concat "1" (match-string 1 bullet-up))))
1034 (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet))
1035 (setq bullet (concat "1" (match-string 1 bullet))))
1036 (list (cons ind bullet)
1037 (cons ind-up bullet-up)
1038 (cons ind-down bullet-down))))
1039
1040(defun org-get-bullet ()
1041 (save-excursion
1042 (goto-char (point-at-bol))
1043 (and (looking-at
1044 "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)")
1045 (or (match-string 2) (match-string 4)))))
910 1046
911;;; Send and receive lists 1047;;; Send and receive lists
912 1048
@@ -968,16 +1104,54 @@ cdr is the indentation string."
968 (progn (goto-char (point-min)) (point)) 1104 (progn (goto-char (point-min)) (point))
969 (cons (match-beginning 0) (match-string 1))))) 1105 (cons (match-beginning 0) (match-string 1)))))
970 1106
1107(defun org-list-goto-true-beginning ()
1108 "Go to the beginning of the list at point."
1109 (beginning-of-line 1)
1110 (while (looking-at org-list-beginning-re)
1111 (beginning-of-line 0))
1112 (progn
1113 (re-search-forward org-list-beginning-re nil t)
1114 (goto-char (match-beginning 0))))
1115
1116(defun org-list-make-subtree ()
1117 "Convert the plain list at point into a subtree."
1118 (interactive)
1119 (org-list-goto-true-beginning)
1120 (let ((list (org-list-parse-list t)) nstars)
1121 (save-excursion
1122 (if (condition-case nil
1123 (org-back-to-heading)
1124 (error nil))
1125 (progn (re-search-forward org-complex-heading-regexp nil t)
1126 (setq nstars (length (match-string 1))))
1127 (setq nstars 0)))
1128 (org-list-make-subtrees list (1+ nstars))))
1129
1130(defun org-list-make-subtrees (list level)
1131 "Convert LIST into subtrees starting at LEVEL."
1132 (if (symbolp (car list))
1133 (org-list-make-subtrees (cdr list) level)
1134 (mapcar (lambda (item)
1135 (if (stringp item)
1136 (insert (make-string
1137 (if org-odd-levels-only
1138 (1- (* 2 level)) level) ?*) " " item "\n")
1139 (org-list-make-subtrees item (1+ level))))
1140 list)))
1141
971(defun org-list-end (indent) 1142(defun org-list-end (indent)
972 "Return the position of the end of the list. 1143 "Return the position of the end of the list.
973INDENT is the indentation of the list." 1144INDENT is the indentation of the list, as a string."
974 (save-excursion 1145 (save-excursion
975 (catch 'exit 1146 (catch 'exit
976 (while (or (looking-at org-list-beginning-re) 1147 (while (or (looking-at org-list-beginning-re)
977 (looking-at (concat "^" indent "[ \t]+\\|^$"))) 1148 (looking-at (concat "^" indent "[ \t]+\\|^$"))
1149 (> (or (get-text-property (point) 'original-indentation) -1)
1150 (length indent)))
978 (if (eq (point) (point-max)) 1151 (if (eq (point) (point-max))
979 (throw 'exit (point-max))) 1152 (throw 'exit (point-max)))
980 (forward-line 1))) (point))) 1153 (forward-line 1)))
1154 (point)))
981 1155
982(defun org-list-insert-radio-list () 1156(defun org-list-insert-radio-list ()
983 "Insert a radio list template appropriate for this major mode." 1157 "Insert a radio list template appropriate for this major mode."
@@ -1002,7 +1176,7 @@ this list."
1002 (catch 'exit 1176 (catch 'exit
1003 (unless (org-at-item-p) (error "Not at a list")) 1177 (unless (org-at-item-p) (error "Not at a list"))
1004 (save-excursion 1178 (save-excursion
1005 (goto-char (car (org-list-item-beginning))) 1179 (org-list-goto-true-beginning)
1006 (beginning-of-line 0) 1180 (beginning-of-line 0)
1007 (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") 1181 (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
1008 (if maybe 1182 (if maybe
@@ -1150,7 +1324,7 @@ with overruling parameters for `org-list-to-generic'."
1150LIST is as returnd by `org-list-parse-list'. PARAMS is a property list 1324LIST is as returnd by `org-list-parse-list'. PARAMS is a property list
1151with overruling parameters for `org-list-to-generic'." 1325with overruling parameters for `org-list-to-generic'."
1152 (org-list-to-generic 1326 (org-list-to-generic
1153 list 1327 list
1154 (org-combine-plists 1328 (org-combine-plists
1155 '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize" 1329 '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
1156 :ustart "@enumerate" :uend "@end enumerate" 1330 :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 @@
1;;; org-mac-message.el --- Support for links to Apple Mail messages from within Org-mode 1;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
2 2
3;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. 3;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
4 4
5;; Author: John Wiegley <johnw@gnu.org> 5;; Author: John Wiegley <johnw@gnu.org>
6;; Version: 6.21b 6;; Christopher Suckling <suckling at gmail dot com>
7
8;; Version: 6.29c
7;; Keywords: outlines, hypermedia, calendar, wp 9;; Keywords: outlines, hypermedia, calendar, wp
8 10
9;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
@@ -22,14 +24,39 @@
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 25
24;;; Commentary: 26;;; Commentary:
25;; This file implements links to Apple Mail messages from within Org-mode. 27;; This file implements links to Apple Mail.app messages from within Org-mode.
26;; Org-mode does not load this module by default - if you would actually like 28;; Org-mode does not load this module by default - if you would actually like
27;; this to happen then configure the variable `org-modules'. 29;; this to happen then configure the variable `org-modules'.
28 30
31;; If you would like to create links to all flagged messages in an
32;; Apple Mail.app account, please customize the variable
33;; `org-mac-mail-account' and then call one of the following functions:
34
35;; (org-mac-message-insert-selected) copies a formatted list of links to
36;; the kill ring.
37
38;; (org-mac-message-insert-selected) inserts at point links to any
39;; messages selected in Mail.app.
40
41;; (org-mac-message-insert-flagged) searches within an org-mode buffer
42;; for a specific heading, creating it if it doesn't exist. Any
43;; message:// links within the first level of the heading are deleted
44;; and replaced with links to flagged messages.
45
29;;; Code: 46;;; Code:
30 47
31(require 'org) 48(require 'org)
32 49
50(defgroup org-mac-flagged-mail nil
51 "Options concerning linking to flagged Mail.app messages"
52 :tag "Org Mail.app"
53 :group 'org-link)
54
55(defcustom org-mac-mail-account "customize"
56 "The Mail.app account in which to search for flagged messages"
57 :group 'org-mac-flagged-mail
58 :type 'string)
59
33(org-add-link-type "message" 'org-mac-message-open) 60(org-add-link-type "message" 'org-mac-message-open)
34 61
35;; In mac.c, removed in Emacs 23. 62;; In mac.c, removed in Emacs 23.
@@ -53,29 +80,138 @@ This will use the command `open' with the message URL."
53 (start-process (concat "open message:" message-id) nil 80 (start-process (concat "open message:" message-id) nil
54 "open" (concat "message://<" (substring message-id 2) ">"))) 81 "open" (concat "message://<" (substring message-id 2) ">")))
55 82
56(defun org-mac-message-insert-link () 83(defun as-get-selected-mail ()
57 "Insert a link to the messages currently selected in Apple Mail. 84 "AppleScript to create links to selected messages in Mail.app"
85 (do-applescript
86 (concat
87 "tell application \"Mail\"\n"
88 "set theLinkList to {}\n"
89 "set theSelection to selection\n"
90 "repeat with theMessage in theSelection\n"
91 "set theID to message id of theMessage\n"
92 "set theSubject to subject of theMessage\n"
93 "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
94 "copy theLink to end of theLinkList\n"
95 "end repeat\n"
96 "return theLinkList as string\n"
97 "end tell")))
98
99(defun as-get-flagged-mail ()
100 "AppleScript to create links to flagged messages in Mail.app"
101 (do-applescript
102 (concat
103 ;; Is Growl installed?
104 "tell application \"System Events\"\n"
105 "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
106 "if (count of growlHelpers) > 0 then\n"
107 "set growlHelperApp to item 1 of growlHelpers\n"
108 "else\n"
109 "set growlHelperApp to \"\"\n"
110 "end if\n"
111 "end tell\n"
112
113 ;; Get links
114 "tell application \"Mail\"\n"
115 "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
116 "set theLinkList to {}\n"
117 "repeat with aMailbox in theMailboxes\n"
118 "set theSelection to (every message in aMailbox whose flagged status = true)\n"
119 "repeat with theMessage in theSelection\n"
120 "set theID to message id of theMessage\n"
121 "set theSubject to subject of theMessage\n"
122 "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
123 "copy theLink to end of theLinkList\n"
124
125 ;; Report progress through Growl
126 ;; This "double tell" idiom is described in detail at
127 ;; http://macscripter.net/viewtopic.php?id=24570 The
128 ;; script compiler needs static knowledge of the
129 ;; growlHelperApp. Hmm, since we're compiling
130 ;; on-the-fly here, this is likely to be way less
131 ;; portable than I'd hoped. It'll work when the name
132 ;; is still "GrowlHelperApp", though.
133 "if growlHelperApp is not \"\" then\n"
134 "tell application \"GrowlHelperApp\"\n"
135 "tell application growlHelperApp\n"
136 "set the allNotificationsList to {\"FlaggedMail\"}\n"
137 "set the enabledNotificationsList to allNotificationsList\n"
138 "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
139 "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
140 "end tell\n"
141 "end tell\n"
142 "end if\n"
143 "end repeat\n"
144 "end repeat\n"
145 "return theLinkList as string\n"
146 "end tell")))
147
148(defun org-mac-message-get-links (&optional select-or-flag)
149 "Create links to the messages currently selected or flagged in Mail.app.
150This will use AppleScript to get the message-id and the subject of the
151messages in Mail.app and make a link out of it.
152When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
153the default). When SELECT-OR-FLAG is \"f\", get the flagged messages.
154The Org-syntax text will be pushed to the kill ring, and also returned."
155 (interactive "sLink to (s)elected or (f)lagged messages: ")
156 (setq select-or-flag (or select-or-flag "s"))
157 (message "AppleScript: searching mailboxes...")
158 (let* ((as-link-list
159 (if (string= select-or-flag "s")
160 (as-get-selected-mail)
161 (if (string= select-or-flag "f")
162 (as-get-flagged-mail)
163 (error "Please select \"s\" or \"f\""))))
164 (link-list
165 (mapcar
166 (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
167 (split-string as-link-list "[\r\n]+")))
168 split-link URL description orglink orglink-insert rtn orglink-list)
169 (while link-list
170 (setq split-link (split-string (pop link-list) "::split::"))
171 (setq URL (car split-link))
172 (setq description (cadr split-link))
173 (when (not (string= URL ""))
174 (setq orglink (org-make-link-string URL description))
175 (push orglink orglink-list)))
176 (setq rtn (mapconcat 'identity orglink-list "\n"))
177 (kill-new rtn)
178 rtn))
179
180(defun org-mac-message-insert-selected ()
181 "Insert a link to the messages currently selected in Mail.app.
58This will use applescript to get the message-id and the subject of the 182This will use applescript to get the message-id and the subject of the
59active mail in AppleMail and make a link out of it." 183active mail in Mail.app and make a link out of it."
60 (interactive) 184 (interactive)
61 (insert (org-mac-message-get-link))) 185 (insert (org-mac-message-get-links "s")))
62 186
63(defun org-mac-message-get-link () 187;; The following line is for backward compatibility
64 "Insert a link to the messages currently selected in Apple Mail. 188(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected)
65This will use applescript to get the message-id and the subject of the 189
66active mail in AppleMail and make a link out of it." 190(defun org-mac-message-insert-flagged (org-buffer org-heading)
67 (let ((subject (do-applescript "tell application \"Mail\" 191 "Asks for an org buffer and a heading within it, and replace message links.
68 set theMessages to selection 192If heading exists, delete all message:// links within heading's first
69 subject of beginning of theMessages 193level. If heading doesn't exist, create it at point-max. Insert
70end tell")) 194list of message:// links to flagged mail after heading."
71 (message-id (do-applescript "tell application \"Mail\" 195 (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
72 set theMessages to selection 196 (save-excursion
73 message id of beginning of theMessages 197 (set-buffer org-buffer)
74end tell"))) 198 (goto-char (point-min))
75 (org-make-link-string 199 (let ((isearch-forward t)
76 (concat "message://" 200 (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
77 (substring message-id 1 (1- (length message-id)))) 201 (if (org-goto-local-search-headings org-heading nil t)
78 (substring subject 1 (1- (length subject)))))) 202 (if (not (eobp))
203 (progn
204 (save-excursion
205 (while (re-search-forward
206 message-re (save-excursion (outline-next-heading)) t)
207 (delete-region (match-beginning 0) (match-end 0)))
208 (insert "\n" (org-mac-message-get-links "f")))
209 (flush-lines "^$" (point) (outline-next-heading)))
210 (insert "\n" (org-mac-message-get-links "f")))
211 (goto-char (point-max))
212 (insert "\n")
213 (org-insert-heading)
214 (insert org-heading "\n" (org-mac-message-get-links "f"))))))
79 215
80(provide 'org-mac-message) 216(provide 'org-mac-message)
81 217
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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -33,14 +33,24 @@
33 33
34;;; Code: 34;;; Code:
35 35
36(eval-and-compile
37 (unless (fboundp 'declare-function)
38 (defmacro declare-function (fn file &optional arglist fileonly))))
39
40(declare-function org-add-props "org-compat" (string plist &rest props))
41
36(defmacro org-bound-and-true-p (var) 42(defmacro org-bound-and-true-p (var)
37 "Return the value of symbol VAR if it is bound, else nil." 43 "Return the value of symbol VAR if it is bound, else nil."
38 `(and (boundp (quote ,var)) ,var)) 44 `(and (boundp (quote ,var)) ,var))
39 45
40(defmacro org-unmodified (&rest body) 46(defmacro org-unmodified (&rest body)
41 "Execute body without changing `buffer-modified-p'." 47 "Execute body without changing `buffer-modified-p'.
48Also, do not record undo information."
42 `(set-buffer-modified-p 49 `(set-buffer-modified-p
43 (prog1 (buffer-modified-p) ,@body))) 50 (prog1 (buffer-modified-p)
51 (let ((buffer-undo-list t)
52 before-change-functions after-change-functions)
53 ,@body))))
44 54
45(defmacro org-re (s) 55(defmacro org-re (s)
46 "Replace posix classes in regular expression." 56 "Replace posix classes in regular expression."
@@ -73,10 +83,6 @@
73 ,@body) 83 ,@body)
74 (if pc-mode (partial-completion-mode 1))))) 84 (if pc-mode (partial-completion-mode 1)))))
75 85
76(eval-and-compile
77 (unless (fboundp 'declare-function)
78 (defmacro declare-function (fn file &optional arglist fileonly))))
79
80(defmacro org-maybe-intangible (props) 86(defmacro org-maybe-intangible (props)
81 "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22. 87 "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22.
82In emacs 21, invisible text is not avoided by the command loop, so the 88In 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."
110 `(unless (get-text-property (1- (point)) 'org-protected) 116 `(unless (get-text-property (1- (point)) 'org-protected)
111 ,@body)) 117 ,@body))
112 118
119(defmacro org-if-unprotected-at (pos &rest body)
120 "Execute BODY if there is no `org-protected' text property at point-1."
121 `(unless (get-text-property ,pos 'org-protected)
122 ,@body))
123
113(defmacro org-with-remote-undo (_buffer &rest _body) 124(defmacro org-with-remote-undo (_buffer &rest _body)
114 "Execute BODY while recording undo information in two buffers." 125 "Execute BODY while recording undo information in two buffers."
115 `(let ((_cline (org-current-line)) 126 `(let ((_cline (org-current-line))
@@ -160,6 +171,18 @@ We use a macro so that the test can happen at compilation time."
160 ((assoc key option) (cdr (assoc key option))) 171 ((assoc key option) (cdr (assoc key option)))
161 (t (cdr (assq 'default option))))) 172 (t (cdr (assq 'default option)))))
162 173
174(defsubst org-check-external-command (cmd &optional use no-error)
175 "Check if external progam CMD for USE exists, error if not.
176When the program does exist, return it's path.
177When it does not exist and NO-ERROR is set, return nil.
178Otherwise, throw an error. The optional argument USE can describe what this
179program is needed for, so that the error message can be more informative."
180 (or (executable-find cmd)
181 (if no-error
182 nil
183 (error "Can't find `%s'%s" cmd
184 (if use (format " (%s)" use) "")))))
185
163(defsubst org-inhibit-invisibility () 186(defsubst org-inhibit-invisibility ()
164 "Modified `buffer-invisibility-spec' for Emacs 21. 187 "Modified `buffer-invisibility-spec' for Emacs 21.
165Some ops with invisible text do not work correctly on Emacs 21. For these 188Some 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."
168 191
169(defsubst org-set-local (var value) 192(defsubst org-set-local (var value)
170 "Make VAR local in current buffer and set it to VALUE." 193 "Make VAR local in current buffer and set it to VALUE."
171 (set (make-variable-buffer-local var) value)) 194 (set (make-local-variable var) value))
172 195
173(defsubst org-mode-p () 196(defsubst org-mode-p ()
174 "Check if the current buffer is in Org-mode." 197 "Check if the current buffer is in Org-mode."
@@ -228,6 +251,31 @@ This is in contrast to merely setting it to 0."
228 (setq plist (cddr plist))) 251 (setq plist (cddr plist)))
229 p)) 252 p))
230 253
254
255(defun org-replace-match-keep-properties (newtext &optional fixedcase
256 literal string)
257 "Like `replace-match', but add the text properties found original text."
258 (setq newtext (org-add-props newtext (text-properties-at
259 (match-beginning 0) string)))
260 (replace-match newtext fixedcase literal string))
261
262(defmacro org-with-limited-levels (&rest body)
263 "Execute BODY with limited number of outline levels."
264 `(let* ((outline-regexp (org-get-limited-outline-regexp)))
265 ,@body))
266
267(defvar org-odd-levels-only) ; defined in org.el
268(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el
269(defun org-get-limited-outline-regexp ()
270 "Return outline-regexp with limited number of levels.
271The number of levels is controlled by "
272 (if (or (not (org-mode-p)) (not (featurep 'org-inlinetask)))
273
274 outline-regexp
275 (let* ((limit-level (1- org-inlinetask-min-level))
276 (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
277 (format "\\*\\{1,%d\\} " nstars))))
278
231(provide 'org-macs) 279(provide 'org-macs)
232 280
233;; arch-tag: 7e6a73ce-aac9-4fc0-9b30-ce6f89dc6668 281;; 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 @@
5;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> 5;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org 7;; Homepage: http://orgmode.org
8;; Version: 6.21b 8;; Version: 6.29c
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
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 @@
6;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> 6;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
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 @@
4;; 4;;
5;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> 5;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
6;; Maintainer: Carsten Dominik <carsten at orgmode dot org> 6;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
7;; Version: 6.21b 7;; Version: 6.29c
8;; 8;;
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
10;; 10;;
@@ -422,7 +422,17 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
422 (loop for priority from ?A to org-lowest-priority 422 (loop for priority from ?A to org-lowest-priority
423 collect (char-to-string priority))) 423 collect (char-to-string priority)))
424 424
425(defun org-mouse-todo-menu (state)
426 "Create the menu with TODO keywords."
427 (append
428 (let ((kwds org-todo-keywords-1))
429 (org-mouse-keyword-menu
430 kwds
431 `(lambda (kwd) (org-todo kwd))
432 (lambda (kwd) (equal state kwd))))))
433
425(defun org-mouse-tag-menu () ;todo 434(defun org-mouse-tag-menu () ;todo
435 "Create the tags menu"
426 (append 436 (append
427 (let ((tags (org-get-tags))) 437 (let ((tags (org-get-tags)))
428 (org-mouse-keyword-menu 438 (org-mouse-keyword-menu
@@ -441,7 +451,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
441 ["Set Tags ..." (org-set-tags) t]))) 451 ["Set Tags ..." (org-set-tags) t])))
442 452
443 453
444
445(defun org-mouse-set-tags (tags) 454(defun org-mouse-set-tags (tags)
446 (save-excursion 455 (save-excursion
447 ;; remove existing tags first 456 ;; remove existing tags first
@@ -621,9 +630,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
621 (set-match-data ',match) 630 (set-match-data ',match)
622 (apply ',function rest))))) 631 (apply ',function rest)))))
623 632
624(defun org-mouse-todo-keywords ()
625 (if (boundp 'org-todo-keywords-1) org-todo-keywords-1 org-todo-keywords))
626
627(defun org-mouse-match-todo-keyword () 633(defun org-mouse-match-todo-keyword ()
628 (save-excursion 634 (save-excursion
629 (org-back-to-heading) 635 (org-back-to-heading)
@@ -691,10 +697,10 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
691 (org-mouse-remove-match-and-spaces))))] 697 (org-mouse-remove-match-and-spaces))))]
692 ))) 698 )))
693 ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") 699 ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
694 (member (match-string 0) (org-mouse-todo-keywords))) 700 (member (match-string 0) org-todo-keywords-1))
695 (popup-menu 701 (popup-menu
696 `(nil 702 `(nil
697 ,@(org-mouse-keyword-replace-menu (org-mouse-todo-keywords)) 703 ,@(org-mouse-todo-menu (match-string 0))
698 "--" 704 "--"
699 ["Check TODOs" org-show-todo-tree t] 705 ["Check TODOs" org-show-todo-tree t]
700 ["List all TODO keywords" org-todo-list t] 706 ["List all TODO keywords" org-todo-list t]
@@ -718,7 +724,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
718 ["Open" org-open-at-point t] 724 ["Open" org-open-at-point t]
719 ["Open in Emacs" (org-open-at-point t) t] 725 ["Open in Emacs" (org-open-at-point t) t]
720 "--" 726 "--"
721 ["Copy link" (kill-new (match-string 0))] 727 ["Copy link" (org-kill-new (match-string 0))]
722 ["Cut link" 728 ["Cut link"
723 (progn 729 (progn
724 (kill-region (match-beginning 0) (match-end 0)) 730 (kill-region (match-beginning 0) (match-end 0))
@@ -832,9 +838,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
832 "--" 838 "--"
833 ,@(org-mouse-tag-menu)) 839 ,@(org-mouse-tag-menu))
834 ("TODO Status" 840 ("TODO Status"
835 ,@(progn (org-mouse-match-todo-keyword) 841 ,@(org-mouse-todo-menu (org-get-todo-state)))
836 (org-mouse-keyword-replace-menu (org-mouse-todo-keywords)
837 1)))
838 ["Show Tags" 842 ["Show Tags"
839 (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) 843 (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
840 :visible (not org-mouse-direct)] 844 :visible (not org-mouse-direct)]
@@ -1132,8 +1136,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
1132 (if (featurep 'xemacs) [button3] [mouse-3]) 1136 (if (featurep 'xemacs) [button3] [mouse-3])
1133 'org-mouse-show-context-menu) 1137 'org-mouse-show-context-menu)
1134 (define-key org-agenda-keymap [down-mouse-3] 'org-mouse-move-tree-start) 1138 (define-key org-agenda-keymap [down-mouse-3] 'org-mouse-move-tree-start)
1135 (define-key org-agenda-keymap [C-mouse-4] 'org-agenda-earlier) 1139 (define-key org-agenda-keymap (if (featurep 'xemacs) [(control mouse-4)] [C-mouse-4]) 'org-agenda-earlier)
1136 (define-key org-agenda-keymap [C-mouse-5] 'org-agenda-later) 1140 (define-key org-agenda-keymap (if (featurep 'xemacs) [(control mouse-5)] [C-mouse-5]) 'org-agenda-later)
1137 (define-key org-agenda-keymap [drag-mouse-3] 1141 (define-key org-agenda-keymap [drag-mouse-3]
1138 '(lambda (event) (interactive "e") 1142 '(lambda (event) (interactive "e")
1139 (case (org-mouse-get-gesture event) 1143 (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 @@
5;; Author: Eric Schulte <schulte dot eric at gmail dot com> 5;; Author: Eric Schulte <schulte dot eric at gmail dot com>
6;; Keywords: tables, plotting 6;; Keywords: tables, plotting
7;; Homepage: http://orgmode.org 7;; Homepage: http://orgmode.org
8;; Version: 6.21b 8;; Version: 6.29c
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -64,6 +64,7 @@ Returns the resulting property list."
64 ("file" . :file) 64 ("file" . :file)
65 ("labels" . :labels) 65 ("labels" . :labels)
66 ("map" . :map) 66 ("map" . :map)
67 ("timeind" . :timeind)
67 ("timefmt" . :timefmt))) 68 ("timefmt" . :timefmt)))
68 (multiples '("set" "line")) 69 (multiples '("set" "line"))
69 (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)") 70 (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
@@ -181,9 +182,11 @@ and dependant variables."
181 (setf back-edge "") (setf front-edge ""))))) 182 (setf back-edge "") (setf front-edge "")))))
182 row-vals)) 183 row-vals))
183 184
184(defun org-plot/gnuplot-script (data-file num-cols params) 185(defun org-plot/gnuplot-script (data-file num-cols params &optional preface)
185 "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS. 186 "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS.
186NUM-COLS controls the number of columns plotted in a 2-d plot." 187NUM-COLS controls the number of columns plotted in a 2-d plot.
188Optional argument PREFACE returns only option parameters in a
189manner suitable for prepending to a user-specified script."
187 (let* ((type (plist-get params :plot-type)) 190 (let* ((type (plist-get params :plot-type))
188 (with (if (equal type 'grid) 191 (with (if (equal type 'grid)
189 'pm3d 192 'pm3d
@@ -238,7 +241,8 @@ NUM-COLS controls the number of columns plotted in a 2-d plot."
238 (add-to-script (concat "set timefmt \"" 241 (add-to-script (concat "set timefmt \""
239 (or timefmt ;; timefmt passed to gnuplot 242 (or timefmt ;; timefmt passed to gnuplot
240 "%Y-%m-%d-%H:%M:%S") "\""))) 243 "%Y-%m-%d-%H:%M:%S") "\"")))
241 (case type ;; plot command 244 (unless preface
245 (case type ;; plot command
242 ('2d (dotimes (col num-cols) 246 ('2d (dotimes (col num-cols)
243 (unless (and (equal type '2d) 247 (unless (and (equal type '2d)
244 (or (and ind (equal (+ 1 col) ind)) 248 (or (and ind (equal (+ 1 col) ind))
@@ -259,8 +263,8 @@ NUM-COLS controls the number of columns plotted in a 2-d plot."
259 ('grid 263 ('grid
260 (setq plot-lines (list (format "'%s' with %s title ''" 264 (setq plot-lines (list (format "'%s' with %s title ''"
261 data-file with))))) 265 data-file with)))))
262 (add-to-script 266 (add-to-script
263 (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n "))) 267 (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n "))))
264 script))) 268 script)))
265 269
266;;----------------------------------------------------------------------------- 270;;-----------------------------------------------------------------------------
@@ -328,10 +332,13 @@ line directly before or after the table."
328 ;; write script 332 ;; write script
329 (with-temp-buffer 333 (with-temp-buffer
330 (if (plist-get params :script) ;; user script 334 (if (plist-get params :script) ;; user script
331 (progn (insert-file-contents (plist-get params :script)) 335 (progn (insert
332 (goto-char (point-min)) 336 (org-plot/gnuplot-script data-file num-cols params t))
333 (while (re-search-forward "$datafile" nil t) 337 (insert "\n")
334 (replace-match data-file nil nil))) 338 (insert-file-contents (plist-get params :script))
339 (goto-char (point-min))
340 (while (re-search-forward "$datafile" nil t)
341 (replace-match data-file nil nil)))
335 (insert 342 (insert
336 (org-plot/gnuplot-script data-file num-cols params))) 343 (org-plot/gnuplot-script data-file num-cols params)))
337 ;; graph table 344 ;; graph table
@@ -339,7 +346,7 @@ line directly before or after the table."
339 (gnuplot-send-buffer-to-gnuplot)) 346 (gnuplot-send-buffer-to-gnuplot))
340 ;; cleanup 347 ;; cleanup
341 (bury-buffer (get-buffer "*gnuplot*")) 348 (bury-buffer (get-buffer "*gnuplot*"))
342 (delete-file data-file)))) 349 (run-with-idle-timer 0.1 nil (lambda () (delete-file data-file))))))
343 350
344(provide 'org-plot) 351(provide 'org-plot)
345 352
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 @@
1;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions.
2;;
3;; Copyright (c) 2008, 2009
4;; Free Software Foundation, Inc.
5;;
6;; Author: Bastien Guerry <bzg AT altern DOT org>
7;; Author: Daniel M German <dmg AT uvic DOT org>
8;; Author: Sebastian Rose <sebastian_rose AT gmx DOT de>
9;; Author: Ross Patterson <me AT rpatterson DOT net>
10;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de>
11;; Keywords: org, emacsclient, wp
12;; Version: 6.29c
13
14;; This file is part of GNU Emacs.
15;;
16;; GNU Emacs is free software: you can redistribute it and/or modify
17;; it under the terms of the GNU General Public License as published by
18;; the Free Software Foundation, either version 3 of the License, or
19;; (at your option) any later version.
20
21;; GNU Emacs is distributed in the hope that it will be useful,
22;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24;; GNU General Public License for more details.
25
26;; You should have received a copy of the GNU General Public License
27;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28
29;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30;;; Commentary:
31;;
32;; Intercept calls from emacsclient to trigger custom actions.
33;;
34;; This is done by advising `server-visit-files' to scann the list of filenames
35;; for `org-protocol-the-protocol' and sub-procols defined in
36;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'.
37;;
38;; Any application that supports calling external programs with an URL
39;; as argument may be used with this functionality.
40;;
41;;
42;; Usage:
43;; ------
44;;
45;; 1.) Add this to your init file (.emacs probably):
46;;
47;; (add-to-list 'load-path "/path/to/org-protocol/")
48;; (require 'org-protocol)
49;;
50;; 3.) Ensure emacs-server is up and running.
51;; 4.) Try this from the command line (adjust the URL as needed):
52;;
53;; $ emacsclient \
54;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title
55;;
56;; 5.) Optionally add custom sub-protocols and handlers:
57;;
58;; (setq org-protocol-protocol-alist
59;; '(("my-protocol"
60;; :protocol "my-protocol"
61;; :function my-protocol-handler-fuction)))
62;;
63;; A "sub-protocol" will be found in URLs like this:
64;;
65;; org-protocol://sub-protocol://data
66;;
67;; If it works, you can now setup other applications for using this feature.
68;;
69;;
70;; As of March 2009 Firefox users follow the steps documented on
71;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here:
72;; http://www.opera.com/support/kb/view/535/
73;;
74;;
75;; Documentation
76;; -------------
77;;
78;; org-protocol.el comes with and installs handlers to open sources of published
79;; online content, store and insert the browser's URLs and cite online content
80;; by clicking on a bookmark in Firefox, Opera and probably other browsers and
81;; applications:
82;;
83;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps
84;; URLs to local filenames defined in `org-protocol-project-alist'.
85;;
86;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and
87;; pushes the browsers URL to the `kill-ring' for yanking. This handler is
88;; triggered through the sub-protocol \"store-link\".
89;;
90;; * Call `org-protocol-remember' by using the sub-protocol \"remember\". If
91;; Org-mode is loaded, emacs will popup a remember buffer and fill the
92;; template with the data provided. I.e. the browser's URL is inserted as an
93;; Org-link of which the page title will be the description part. If text
94;; was select in the browser, that text will be the body of the entry.
95;;
96;; You may use the same bookmark URL for all those standard handlers and just
97;; adjust the sub-protocol used:
98;;
99;; location.href='org-protocol://sub-protocol://'+
100;; encodeURIComponent(location.href)+'/'+
101;; encodeURIComponent(document.title)+'/'+
102;; encodeURIComponent(window.getSelection())
103;;
104;; The handler for the sub-protocol \"remember\" detects an optional template
105;; char that, if present, triggers the use of a special template.
106;; Example:
107;;
108;; location.href='org-protocol://sub-protocol://x/'+ ...
109;;
110;; use template ?x.
111;;
112;; Note, that using double shlashes is optional from org-protocol.el's point of
113;; view because emacsclient sqashes the slashes to one.
114;;
115;;
116;; provides: 'org-protocol
117;;
118;;; Code:
119
120(require 'org)
121(eval-when-compile
122 (require 'cl))
123
124(declare-function org-publish-initialize-files-alist "org-publish"
125 (&optional refresh))
126(declare-function org-publish-get-project-from-filename "org-publish"
127 (filename &optional up))
128(declare-function server-edit "server" ())
129
130
131(defgroup org-protocol nil
132 "Intercept calls from emacsclient to trigger custom actions.
133
134This is done by advising `server-visit-files' to scann the list of filenames
135for `org-protocol-the-protocol' and sub-procols defined in
136`org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'."
137 :version "22.1"
138 :group 'convenience
139 :group 'org)
140
141
142;;; Variables:
143
144(defconst org-protocol-protocol-alist-default
145 '(("org-remember" :protocol "remember" :function org-protocol-remember :kill-client t)
146 ("org-store-link" :protocol "store-link" :function org-protocol-store-link)
147 ("org-open-source" :protocol "open-source" :function org-protocol-open-source))
148 "Default protocols to use.
149See `org-protocol-protocol-alist' for a description of this variable.")
150
151
152(defconst org-protocol-the-protocol "org-protocol"
153 "This is the protocol to detect if org-protocol.el is loaded.
154`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold the
155sub-protocols that trigger the required action. You will have to define just one
156protocol handler OS-wide (MS-Windows) or per application (Linux). That protocol
157handler should call emacsclient.")
158
159
160;;; User variables:
161
162(defcustom org-protocol-reverse-list-of-files t
163 "* The filenames passed on the commandline are passed to the emacs-server in
164reversed order. Set to `t' (default) to re-reverse the list, i.e. use the
165sequence on the command line. If nil, the sequence of the filenames is
166unchanged."
167 :group 'org-protocol
168 :type 'boolean)
169
170
171(defcustom org-protocol-project-alist nil
172 "* Map URLs to local filenames for `org-protocol-open-source' (open-source).
173
174Each element of this list must be of the form:
175
176 (module-name :property value property: value ...)
177
178where module-name is an arbitrary name. All the values are strings.
179
180Possible properties are:
181
182 :online-suffix - the suffix to strip from the published URLs
183 :working-suffix - the replacement for online-suffix
184 :base-url - the base URL, e.g. http://www.example.com/project/
185 Last slash required.
186 :working-directory - the local working directory. This is, what base-url will
187 be replaced with.
188
189Example:
190
191 (setq org-protocol-project-alist
192 '((\"http://orgmode.org/worg/\"
193 :online-suffix \".php\"
194 :working-suffix \".org\"
195 :base-url \"http://orgmode.org/worg/\"
196 :working-directory \"/home/user/org/Worg/\")
197 (\"http://localhost/org-notes/\"
198 :online-suffix \".html\"
199 :working-suffix \".org\"
200 :base-url \"http://localhost/org/\"
201 :working-directory \"/home/user/org/\")))
202
203Consider using the interactive functions `org-protocol-create' and
204`org-protocol-create-for-org' to help you filling this variable with valid contents."
205 :group 'org-protocol
206 :type 'alist)
207
208
209(defcustom org-protocol-protocol-alist nil
210 "* Register custom handlers for org-protocol.
211
212Each element of this list must be of the form:
213
214 (module-name :protocol protocol :function func :kill-client nil)
215
216protocol - protocol to detect in a filename without trailing colon and slashes.
217 See rfc1738 section 2.1 for more on this.
218 If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol'
219 will search filenames for \"org-protocol:/my-protocol:/\"
220 and trigger your action for every match. `org-protocol' is defined in
221 `org-protocol-the-protocol'. Double and tripple slashes are compressed
222 to one by emacsclient.
223
224function - function that handles requests with protocol and takes exactly one
225 argument: the filename with all protocols stripped. If the function
226 returns nil, emacsclient and -server do nothing. Any non-nil return
227 value is considered a valid filename and thus passed to the server.
228
229 `org-protocol.el provides some support for handling those filenames,
230 if you stay with the conventions used for the standard handlers in
231 `org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
232
233kill-client - If t, kill the client immediately, once the sub-protocol is
234 detected. This is neccessary for actions that can be interupted by
235 `C-g' to avoid dangeling emacsclients. Note, that all other command
236 line arguments but the this one will be discarded, greedy handlers
237 still receive the whole list of arguments though.
238
239Here is an example:
240
241 (setq org-protocol-protocol-alist
242 '((\"my-protocol\"
243 :protocol \"my-protocol\"
244 :function my-protocol-handler-fuction)
245 (\"your-protocol\"
246 :protocol \"your-protocol\"
247 :function your-protocol-handler-fuction)))"
248 :group 'org-protocol
249 :type '(alist))
250
251(defcustom org-protocol-default-template-key "w"
252 "The default org-remember-templates key to use."
253 :group 'org-protocol
254 :type 'string)
255
256
257;;; Helper functions:
258
259(defun org-protocol-sanitize-uri (uri)
260 "emacsclient compresses double and tripple slashes.
261Slashes are sanitized to double slashes here."
262 (when (string-match "^\\([a-z]+\\):/" uri)
263 (let* ((splitparts (split-string uri "/+")))
264 (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
265 uri)
266
267
268(defun org-protocol-split-data(data &optional unhexify separator)
269 "Split, what a org-protocol handler function gets as only argument.
270data is that one argument. Data is splitted at each occurrence of separator
271 (regexp). If no separator is specified or separator is nil, assume \"/+\".
272The results of that splitting are return as a list. If unhexify is non-nil,
273hex-decode each split part. If unhexify is a function, use that function to
274decode each split part."
275 (let* ((sep (or separator "/+"))
276 (split-parts (split-string data sep)))
277 (if unhexify
278 (if (fboundp unhexify)
279 (mapcar unhexify split-parts)
280 (mapcar 'org-protocol-unhex-string split-parts))
281 split-parts)))
282
283(defun org-protocol-unhex-string(str)
284 "Unhex hexified unicode strings as returned from the JavaScript function
285encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'."
286 (setq str (or str ""))
287 (let ((tmp "")
288 (case-fold-search t))
289 (while (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str)
290 (let* ((start (match-beginning 0))
291 (end (match-end 0))
292 (hex (match-string 0 str))
293 (replacement (org-protocol-unhex-compound hex)))
294 (setq tmp (concat tmp (substring str 0 start) replacement))
295 (setq str (substring str end))))
296 (setq tmp (concat tmp str))
297 tmp))
298
299
300(defun org-protocol-unhex-compound (hex)
301 "Unhexify unicode hex-chars. E.g. `%C3%B6' is the german Umlaut `ü'."
302 (let* ((bytes (remove "" (split-string hex "%")))
303 (ret "")
304 (eat 0)
305 (sum 0))
306 (while bytes
307 (let* ((b (pop bytes))
308 (a (elt b 0))
309 (b (elt b 1))
310 (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0)))
311 (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0)))
312 (val (+ (lsh c1 4) c2))
313 (shift
314 (if (= 0 eat) ;; new byte
315 (if (>= val 252) 6
316 (if (>= val 248) 5
317 (if (>= val 240) 4
318 (if (>= val 224) 3
319 (if (>= val 192) 2 0)))))
320 6))
321 (xor
322 (if (= 0 eat) ;; new byte
323 (if (>= val 252) 252
324 (if (>= val 248) 248
325 (if (>= val 240) 240
326 (if (>= val 224) 224
327 (if (>= val 192) 192 0)))))
328 128)))
329 (if (>= val 192) (setq eat shift))
330 (setq val (logxor val xor))
331 (setq sum (+ (lsh sum shift) val))
332 (if (> eat 0) (setq eat (- eat 1)))
333 (when (= 0 eat)
334 (setq ret (concat ret (char-to-string sum)))
335 (setq sum 0))
336 )) ;; end (while bytes
337 ret ))
338
339(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
340 "Greedy handlers might recieve a list like this from emacsclient:
341 '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
342where \"/dir/\" is the absolute path to emacsclients working directory. This
343function transforms it into a flat list utilizing `org-protocol-flatten' and
344transforms the elements of that list as follows:
345
346If strip-path is non-nil, remove the \"/dir/\" prefix from all members of
347param-list.
348
349If replacement is string, replace the \"/dir/\" prefix with it.
350
351The first parameter, the one that contains the protocols, is always changed.
352Everything up to the end of the protocols is stripped.
353
354Note, that this function will always behave as if
355`org-protocol-reverse-list-of-files' was set to t and the returned list will
356reflect that. I.e. emacsclients first parameter will be the first one in the
357returned list."
358(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
359 param-list
360 (reverse param-list))))
361 (trigger (car l))
362 (len 0)
363 dir
364 ret)
365 (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger)
366 (setq dir (match-string 1 trigger))
367 (setq len (length dir))
368 (setcar l (concat dir (match-string 3 trigger))))
369 (if strip-path
370 (progn
371 (dolist (e l ret)
372 (setq ret
373 (append ret
374 (list
375 (if (stringp e)
376 (if (stringp replacement)
377 (setq e (concat replacement (substring e len)))
378 (setq e (substring e len)))
379 e)))))
380 ret)
381 l)))
382
383
384(defun org-protocol-flatten (l)
385 "Greedy handlers might recieve a list like this from emacsclient:
386 '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
387where \"/dir/\" is the absolute path to emacsclients working directory. This
388function transforms it into a flat list."
389 (if (null l) ()
390 (if (listp l)
391 (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
392 (list l))))
393
394;;; Standard protocol handlers:
395
396(defun org-protocol-store-link (fname)
397 "Process an org-protocol://store-link:// style url
398and store a browser URL as an org link. Also pushes the links URL to the
399`kill-ring'.
400
401The location for a browser's bookmark has to look like this:
402
403 javascript:location.href='org-protocol://store-link://'+ \\
404 encodeURIComponent(location.href)
405 encodeURIComponent(document.title)+'/'+ \\
406
407Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
408could contain slashes and the location definitely will.
409
410The sub-protocol used to reach this function is set in
411`org-protocol-protocol-alist'."
412 (let* ((splitparts (org-protocol-split-data fname t))
413 (uri (org-protocol-sanitize-uri (car splitparts)))
414 (title (cadr splitparts))
415 orglink)
416 (if (boundp 'org-stored-links)
417 (setq org-stored-links (cons (list uri title) org-stored-links)))
418 (kill-new uri)
419 (message "`%s' to insert new org-link, `%s' to insert `%s'"
420 (substitute-command-keys"\\[org-insert-link]")
421 (substitute-command-keys"\\[yank]")
422 uri))
423 nil)
424
425
426(defun org-protocol-remember (info)
427 "Process an org-protocol://remember:// style url.
428
429The sub-protocol used to reach this function is set in
430`org-protocol-protocol-alist'.
431
432This function detects an URL, title and optinal text, separated by '/'
433The location for a browser's bookmark has to look like this:
434
435 javascript:location.href='org-protocol://remember://'+ \\
436 encodeURIComponent(location.href)+'/' \\
437 encodeURIComponent(document.title)+'/'+ \\
438 encodeURIComponent(window.getSelection())
439
440By default, it uses the character `org-protocol-default-template-key',
441which should be associated with a template in `org-remember-templates'.
442But you may prepend the encoded URL with a character and a slash like so:
443
444 javascript:location.href='org-protocol://org-store-link://b/'+ ...
445
446Now template ?b will be used."
447
448 (if (and (boundp 'org-stored-links)
449 (fboundp 'org-remember))
450 (let* ((parts (org-protocol-split-data info t))
451 (template (or (and (= 1 (length (car parts))) (pop parts))
452 org-protocol-default-template-key))
453 (url (org-protocol-sanitize-uri (car parts)))
454 (type (if (string-match "^\\([a-z]+\\):" url)
455 (match-string 1 url)))
456 (title (cadr parts))
457 (region (caddr parts))
458 (orglink (org-make-link-string url title))
459 remember-annotation-functions)
460 (setq org-stored-links
461 (cons (list url title) org-stored-links))
462 (kill-new orglink)
463 (org-store-link-props :type type
464 :link url
465 :description title
466 :initial region)
467 (raise-frame)
468 (org-remember nil (string-to-char template)))
469
470 (message "Org-mode not loaded."))
471 nil)
472
473
474(defun org-protocol-open-source (fname)
475 "Process an org-protocol://open-source:// style url.
476
477Change a filename by mapping URLs to local filenames as set
478in `org-protocol-project-alist'.
479
480The location for a browser's bookmark should look like this:
481
482 javascript:location.href='org-protocol://open-source://'+ \\
483 encodeURIComponent(location.href)"
484
485 ;; As we enter this function for a match on our protocol, the return value
486 ;; defaults to nil.
487 (let ((result nil)
488 (f (org-protocol-unhex-string fname)))
489 (catch 'result
490 (dolist (prolist org-protocol-project-alist)
491 (let* ((base-url (plist-get (cdr prolist) :base-url))
492 (wsearch (regexp-quote base-url)))
493
494 (when (string-match wsearch f)
495 (let* ((wdir (plist-get (cdr prolist) :working-directory))
496 (strip-suffix (plist-get (cdr prolist) :online-suffix))
497 (add-suffix (plist-get (cdr prolist) :working-suffix))
498 (start-pos (+ (string-match wsearch f) (length base-url)))
499 (end-pos (string-match
500 (concat (regexp-quote strip-suffix) "\\([?#].*\\)?$") f))
501 (the-file (concat wdir (substring f start-pos end-pos) add-suffix)))
502 (if (file-readable-p the-file)
503 (throw 'result the-file))
504 (if (file-exists-p the-file)
505 (message "%s: permission denied!" the-file)
506 (message "%s: no such file or directory." the-file))))))
507 result)))
508
509
510;;; Core functions:
511
512(defun org-protocol-check-filename-for-protocol (fname restoffiles client)
513 "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname.
514Sub-protocols are registered in `org-protocol-protocol-alist' and
515`org-protocol-protocol-alist-default'.
516This is, how the matching is done:
517
518 (string-match \"protocol:/+sub-protocol:/+\" ...)
519
520protocol and sub-protocol are regexp-quoted.
521
522If a matching protcol is found, the protcol is stripped from fname and the
523result is passed to the protocols function as the only parameter. If the
524function returns nil, the filename is removed from the list of filenames
525passed from emacsclient to the server.
526If the function returns a non nil value, that value is passed to the server
527as filename."
528 (let ((sub-protocols (append org-protocol-protocol-alist org-protocol-protocol-alist-default)))
529 (catch 'fname
530 (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+")))
531 (when (string-match the-protocol fname)
532 (dolist (prolist sub-protocols)
533 (let ((proto (concat the-protocol (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+")))
534 (when (string-match proto fname)
535 (let* ((func (plist-get (cdr prolist) :function))
536 (greedy (plist-get (cdr prolist) :greedy))
537 (splitted (split-string fname proto))
538 (result (if greedy restoffiles (cadr splitted))))
539 (when (plist-get (cdr prolist) :kill-client)
540 (message "Greedy org-protocol handler. Killing client.")
541 (server-edit))
542 (when (fboundp func)
543 (unless greedy
544 (throw 'fname (funcall func result)))
545 (funcall func result)
546 (throw 'fname t))))))))
547 ;; (message "fname: %s" fname)
548 fname)))
549
550
551(defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
552 "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'."
553 (let ((flist (if org-protocol-reverse-list-of-files
554 (reverse (ad-get-arg 0))
555 (ad-get-arg 0)))
556 (client (ad-get-arg 1)))
557 (catch 'greedy
558 (dolist (var flist)
559 (let ((fname (expand-file-name (car var)))) ;; `\' to `/' on windows. FIXME: could this be done any better?
560 (setq fname (org-protocol-check-filename-for-protocol fname (member var flist) client))
561 (if (eq fname t) ;; greedy? We need the `t' return value.
562 (progn
563 (ad-set-arg 0 nil)
564 (throw 'greedy t))
565 (if (stringp fname) ;; probably filename
566 (setcar var fname)
567 (ad-set-arg 0 (delq var (ad-get-arg 0))))))
568 ))))
569
570;;; Org specific functions:
571
572(defun org-protocol-create-for-org ()
573 "Create a org-protocol project for the current file's Org-mode project.
574This works, if the file visited is part of a publishing project in
575`org-publish-project-alist'. This functions calls `org-protocol-create' to do
576most of the work."
577 (interactive)
578 (require 'org-publish)
579 (org-publish-initialize-files-alist)
580 (let ((all (or (org-publish-get-project-from-filename buffer-file-name))))
581 (if all (org-protocol-create (cdr all))
582 (message "Not in an org-project. Did mean %s?"
583 (substitute-command-keys"\\[org-protocol-create]")))))
584
585
586(defun org-protocol-create(&optional project-plist)
587 "Create a new org-protocol project interactively.
588An org-protocol project is an entry in `org-protocol-project-alist'
589which is used by `org-protocol-open-source'.
590Optionally use project-plist to initialize the defaults for this worglet. If
591project-plist is the CDR of an element in `org-publish-project-alist', reuse
592:base-directory, :html-extension and :base-extension."
593 (interactive)
594 (let ((working-dir (expand-file-name(or (plist-get project-plist :base-directory) default-directory)))
595 (base-url "http://orgmode.org/worg/")
596 (strip-suffix (or (plist-get project-plist :html-extension) ".html"))
597 (working-suffix (if (plist-get project-plist :base-extension)
598 (concat "." (plist-get project-plist :base-extension))
599 ".org"))
600
601 (worglet-buffer nil)
602
603 (insert-default-directory t)
604 (minibuffer-allow-text-properties nil))
605
606 (setq base-url (read-string "Base URL of published content: " base-url nil base-url t))
607 (if (not (string-match "\\/$" base-url))
608 (setq base-url (concat base-url "/")))
609
610 (setq working-dir
611 (expand-file-name
612 (read-directory-name "Local working directory: " working-dir working-dir t)))
613 (if (not (string-match "\\/$" working-dir))
614 (setq working-dir (concat working-dir "/")))
615
616 (setq strip-suffix
617 (read-string
618 (concat "Extension to strip from published URLs ("strip-suffix"): ")
619 strip-suffix nil strip-suffix t))
620
621 (setq working-suffix
622 (read-string
623 (concat "Extension of editable files ("working-suffix"): ")
624 working-suffix nil working-suffix t))
625
626 (when (yes-or-no-p "Save the new worglet to your init file? ")
627 (setq org-protocol-project-alist
628 (cons `(,base-url . (:base-url ,base-url
629 :working-directory ,working-dir
630 :online-suffix ,strip-suffix
631 :working-suffix ,working-suffix))
632 org-protocol-project-alist))
633 (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist))))
634
635(provide 'org-protocol)
636;;; 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 @@
2;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc. 2;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
3 3
4;; Author: David O'Toole <dto@gnu.org> 4;; Author: David O'Toole <dto@gnu.org>
5;; Maintainer: Bastien Guerry <bzg AT altern DOT org> 5;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
6;; Keywords: hypermedia, outlines, wp 6;; Keywords: hypermedia, outlines, wp
7;; Version: 6.21b 7;; Version: 6.29c
8 8
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
10;; 10;;
@@ -28,120 +28,14 @@
28;; 28;;
29;; org-publish.el can do the following: 29;; org-publish.el can do the following:
30;; 30;;
31;; + Publish all one's org-files to HTML or LaTeX 31;; + Publish all one's org-files to HTML or PDF
32;; + Upload HTML, images, attachments and other files to a web server 32;; + Upload HTML, images, attachments and other files to a web server
33;; + Exclude selected private pages from publishing 33;; + Exclude selected private pages from publishing
34;; + Publish a clickable index of pages 34;; + Publish a clickable index of pages
35;; + Manage local timestamps for publishing only changed files 35;; + Manage local timestamps for publishing only changed files
36;; + Accept plugin functions to extend range of publishable content 36;; + Accept plugin functions to extend range of publishable content
37;; 37;;
38;; Special thanks to the org-mode maintainer Carsten Dominik for his 38;; Documentation for publishing is in the manual.
39;; ideas, enthusiasm, and cooperation.
40
41;;; Installation:
42
43;; Put org-publish.el in your load path, byte-compile it, and then add
44;; the following lines to your emacs initialization file:
45
46;; (autoload 'org-publish "org-publish" nil t)
47;; (autoload 'org-publish "org-publish-all" nil t)
48;; (autoload 'org-publish "org-publish-current-file" nil t)
49;; (autoload 'org-publish "org-publish-current-project" nil t)
50
51;; NOTE: When org-publish.el is included with org.el, those forms are
52;; already in the file org-install.el, and hence don't need to be put
53;; in your emacs initialization file in this case.
54
55;;; Usage:
56;;
57;; The program's main configuration variable is
58;; `org-publish-project-alist'. See below for example configurations
59;; with commentary.
60
61;; The main interactive functions are:
62;;
63;; M-x org-publish
64;; M-x org-publish-all
65;; M-x org-publish-current-file
66;; M-x org-publish-current-project
67
68;;;; Simple example configuration:
69
70;; (setq org-publish-project-alist
71;; (list
72;; '("org" . (:base-directory "~/org/"
73;; :base-extension "org"
74;; :publishing-directory "~/public_html"
75;; :with-section-numbers nil
76;; :table-of-contents nil
77;; :recursive t
78;; :style "<link rel="stylesheet" href=\"../other/mystyle.css\" type=\"text/css\">")))
79
80;;;; More complex example configuration:
81
82;; Imagine your *.org files are kept in ~/org, your images in
83;; ~/images, and stylesheets in ~/other. Now imagine you want to
84;; publish the files through an ssh connection to a remote host, via
85;; Tramp-mode. To maintain relative links from *.org files to /images
86;; and /other, we should replicate the same directory structure in
87;; your web server account's designated html root (in this case,
88;; assumed to be ~/html)
89
90;; Once you've done created the proper directories, you can adapt the
91;; following example configuration to your specific paths, run M-x
92;; org-publish-all, and it should publish the files to the correct
93;; directories on the web server, transforming the *.org files into
94;; HTML, and leaving other files alone.
95
96;; (setq org-publish-project-alist
97;; (list
98;; '("orgfiles" :base-directory "~/org/"
99;; :base-extension "org"
100;; :publishing-directory "/ssh:user@host:~/html/notebook/"
101;; :publishing-function org-publish-org-to-html
102;; :exclude "PrivatePage.org" ;; regexp
103;; :headline-levels 3
104;; :with-section-numbers nil
105;; :table-of-contents nil
106;; :style "<link rel="stylesheet" href=\"../other/mystyle.css\" type=\"text/css\">"
107;; :auto-preamble t
108;; :auto-postamble nil)
109;; ("images" :base-directory "~/images/"
110;; :base-extension "jpg\\|gif\\|png"
111;; :publishing-directory "/ssh:user@host:~/html/images/"
112;; :publishing-function org-publish-attachment)
113;; ("other" :base-directory "~/other/"
114;; :base-extension "css"
115;; :publishing-directory "/ssh:user@host:~/html/other/"
116;; :publishing-function org-publish-attachment)
117;; ("website" :components ("orgfiles" "images" "other"))))
118
119;; For more information, see the documentation for the variable
120;; `org-publish-project-alist'.
121
122;; Of course, you don't have to publish to remote directories from
123;; within emacs. You can always just publish to local folders, and
124;; then use the synchronization/upload tool of your choice.
125
126;;; List of user-visible changes since version 1.27
127
128;; 1.78: Allow list-valued :publishing-function
129;; 1.77: Added :preparation-function, this allows you to use GNU Make etc.
130;; 1.65: Remove old "composite projects". They're redundant.
131;; 1.64: Allow meta-projects with :components
132;; 1.57: Timestamps flag is now called "org-publish-use-timestamps-flag"
133;; 1.52: Properly set default for :index-filename
134;; 1.48: Composite projects allowed.
135;; :include keyword allowed.
136;; 1.43: Index no longer includes itself in the index.
137;; 1.42: Fix "function definition is void" error
138;; when :publishing-function not set in org-publish-current-file.
139;; 1.41: Fixed bug where index isn't published on first try.
140;; 1.37: Added interactive function "org-publish". Prompts for particular
141;; project name to publish.
142;; 1.34: Added force-publish option to all interactive functions.
143;; 1.32: Fixed "index.org has changed on disk" error during index publishing.
144;; 1.30: Fixed startup error caused by (require 'em-unix)
145 39
146;;; Code: 40;;; Code:
147 41
@@ -256,7 +150,7 @@ index of files or summary page for a given project.
256 :auto-index Whether to publish an index during 150 :auto-index Whether to publish an index during
257 `org-publish-current-project' or `org-publish-all'. 151 `org-publish-current-project' or `org-publish-all'.
258 :index-filename Filename for output of index. Defaults 152 :index-filename Filename for output of index. Defaults
259 to 'index.org' (which becomes 'index.html'). 153 to 'sitemap.org' (which becomes 'sitemap.html').
260 :index-title Title of index page. Defaults to name of file. 154 :index-title Title of index page. Defaults to name of file.
261 :index-function Plugin function to use for generation of index. 155 :index-function Plugin function to use for generation of index.
262 Defaults to `org-publish-org-index', which 156 Defaults to `org-publish-org-index', which
@@ -282,30 +176,41 @@ When nil, do no timestamp checking and always publish all files."
282 :group 'org-publish 176 :group 'org-publish
283 :type 'directory) 177 :type 'directory)
284 178
179(defcustom org-publish-list-skipped-files t
180 "Non-nil means, show message about files *not* published."
181 :group 'org-publish
182 :type 'boolean)
183
285(defcustom org-publish-before-export-hook nil 184(defcustom org-publish-before-export-hook nil
286 "Hook run before export on the Org file. 185 "Hook run before export on the Org file.
287If the functions in this hook modify the original Org buffer, the 186The hook may modify the file in arbitrary ways before publishing happens.
288modified buffer will be used for export, but the buffer will be 187The orgiginal version of the buffer will be restored after publishing."
289restored and saved back to its initial state after export."
290 :group 'org-publish 188 :group 'org-publish
291 :type 'hook) 189 :type 'hook)
292 190
293(defcustom org-publish-after-export-hook nil 191(defcustom org-publish-after-export-hook nil
294 "Hook run after export on the exported buffer. 192 "Hook run after export on the exported buffer.
295If functions in this hook modify the buffer, it will be saved." 193Any changes made by this hook will be saved."
296 :group 'org-publish 194 :group 'org-publish
297 :type 'hook) 195 :type 'hook)
298 196
299;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 197;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
300;;; Timestamp-related functions 198;;; Timestamp-related functions
301 199
302(defun org-publish-timestamp-filename (filename) 200(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
303 "Return path to timestamp file for filename FILENAME." 201 "Return path to timestamp file for filename FILENAME."
202 (setq filename (concat filename "::" (or pub-dir "") "::"
203 (format "%s" (or pub-func ""))))
304 (concat (file-name-as-directory org-publish-timestamp-directory) 204 (concat (file-name-as-directory org-publish-timestamp-directory)
305 "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) 205 "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
306 206
307(defun org-publish-needed-p (filename) 207(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir)
308 "Return `t' if FILENAME should be published." 208 "Return `t' if FILENAME should be published in PUB-DIR using PUB-FUNC.
209TRUE-PUB-DIR is there the file will truely end up. Currently we are not using
210this - maybe it can eventually be used to check if the file is present at
211the target location, and how old it is. Right ow we cannot do this, because
212we do not know under what file name the file will be stored - the publishing
213function can still decide about that independently."
309 (let ((rtn 214 (let ((rtn
310 (if org-publish-use-timestamps-flag 215 (if org-publish-use-timestamps-flag
311 (if (file-exists-p org-publish-timestamp-directory) 216 (if (file-exists-p org-publish-timestamp-directory)
@@ -315,20 +220,23 @@ If functions in this hook modify the buffer, it will be saved."
315 org-publish-timestamp-directory) 220 org-publish-timestamp-directory)
316 ;; there is a timestamp, check if FILENAME is newer 221 ;; there is a timestamp, check if FILENAME is newer
317 (file-newer-than-file-p 222 (file-newer-than-file-p
318 filename (org-publish-timestamp-filename filename))) 223 filename (org-publish-timestamp-filename
224 filename pub-dir pub-func)))
319 (make-directory org-publish-timestamp-directory) 225 (make-directory org-publish-timestamp-directory)
320 t) 226 t)
321 ;; don't use timestamps, always return t 227 ;; don't use timestamps, always return t
322 t))) 228 t)))
323 (if rtn 229 (if rtn
324 (message "Publishing file %s" filename) 230 (message "Publishing file %s using `%s'" filename pub-func)
325 (message "Skipping unmodified file %s" filename)) 231 (when org-publish-list-skipped-files
232 (message "Skipping unmodified file %s" filename)))
326 rtn)) 233 rtn))
327 234
328(defun org-publish-update-timestamp (filename) 235(defun org-publish-update-timestamp (filename &optional pub-dir pub-func)
329 "Update publishing timestamp for file FILENAME. 236 "Update publishing timestamp for file FILENAME.
330If there is no timestamp, create one." 237If there is no timestamp, create one."
331 (let ((timestamp-file (org-publish-timestamp-filename filename)) 238 (let ((timestamp-file (org-publish-timestamp-filename
239 filename pub-dir pub-func))
332 newly-created-timestamp) 240 newly-created-timestamp)
333 (if (not (file-exists-p timestamp-file)) 241 (if (not (file-exists-p timestamp-file))
334 ;; create timestamp file if needed 242 ;; create timestamp file if needed
@@ -340,7 +248,16 @@ If there is no timestamp, create one."
340 (if (and (fboundp 'set-file-times) 248 (if (and (fboundp 'set-file-times)
341 (not newly-created-timestamp)) 249 (not newly-created-timestamp))
342 (set-file-times timestamp-file) 250 (set-file-times timestamp-file)
343 (call-process "touch" nil 0 nil timestamp-file)))) 251 (call-process "touch" nil 0 nil (expand-file-name timestamp-file)))))
252
253(defun org-publish-remove-all-timestamps ()
254 "Remove all files in the timstamp directory."
255 (let ((dir org-publish-timestamp-directory)
256 files)
257 (when (and (file-exists-p dir)
258 (file-directory-p dir))
259 (mapc 'delete-file (directory-files dir 'full "[^.]\\'")))))
260
344 261
345;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 262;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
346;;; Mapping files to project names 263;;; Mapping files to project names
@@ -454,7 +371,9 @@ matching filenames."
454 (include-list (plist-get project-plist :include)) 371 (include-list (plist-get project-plist :include))
455 (recurse (plist-get project-plist :recursive)) 372 (recurse (plist-get project-plist :recursive))
456 (extension (or (plist-get project-plist :base-extension) "org")) 373 (extension (or (plist-get project-plist :base-extension) "org"))
457 (match (concat "^[^\\.].*\\.\\(" extension "\\)$"))) 374 (match (if (eq extension 'any)
375 "^[^\\.]"
376 (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
458 (setq org-publish-temp-files nil) 377 (setq org-publish-temp-files nil)
459 (org-publish-get-base-files-1 base-dir recurse match 378 (org-publish-get-base-files-1 base-dir recurse match
460 ;; FIXME distinguish exclude regexp 379 ;; FIXME distinguish exclude regexp
@@ -467,13 +386,14 @@ matching filenames."
467 include-list) 386 include-list)
468 org-publish-temp-files)) 387 org-publish-temp-files))
469 388
470(defun org-publish-get-project-from-filename (filename) 389(defun org-publish-get-project-from-filename (filename &optional up)
471 "Return the project FILENAME belongs." 390 "Return the project FILENAME belongs."
472 (let* ((project-name (cdr (assoc (expand-file-name filename) 391 (let* ((project-name (cdr (assoc (expand-file-name filename)
473 org-publish-files-alist)))) 392 org-publish-files-alist))))
474 (dolist (prj org-publish-project-alist) 393 (when up
475 (if (member project-name (plist-get (cdr prj) :components)) 394 (dolist (prj org-publish-project-alist)
476 (setq project-name (car prj)))) 395 (if (member project-name (plist-get (cdr prj) :components))
396 (setq project-name (car prj)))))
477 (assoc project-name org-publish-project-alist))) 397 (assoc project-name org-publish-project-alist)))
478 398
479;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 399;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -534,54 +454,67 @@ See `org-publish-org-to' to the list of arguments."
534See `org-publish-org-to' to the list of arguments." 454See `org-publish-org-to' to the list of arguments."
535 (org-publish-org-to "html" plist filename pub-dir)) 455 (org-publish-org-to "html" plist filename pub-dir))
536 456
457(defun org-publish-org-to-org (plist filename pub-dir)
458 "Publish an org file to HTML.
459See `org-publish-org-to' to the list of arguments."
460 (org-publish-org-to "org" plist filename pub-dir))
461
537(defun org-publish-attachment (plist filename pub-dir) 462(defun org-publish-attachment (plist filename pub-dir)
538 "Publish a file with no transformation of any kind. 463 "Publish a file with no transformation of any kind.
539See `org-publish-org-to' to the list of arguments." 464See `org-publish-org-to' to the list of arguments."
540 ;; make sure eshell/cp code is loaded 465 ;; make sure eshell/cp code is loaded
541 (unless (file-directory-p pub-dir) 466 (unless (file-directory-p pub-dir)
542 (make-directory pub-dir t)) 467 (make-directory pub-dir t))
543 (copy-file filename pub-dir t)) 468 (or (equal (expand-file-name (file-name-directory filename))
469 (file-name-as-directory (expand-file-name pub-dir)))
470 (copy-file filename
471 (expand-file-name (file-name-nondirectory filename) pub-dir)
472 t)))
544 473
545;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 474;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
546;;; Publishing files, sets of files, and indices 475;;; Publishing files, sets of files, and indices
547 476
548(defun org-publish-file (filename &optional project) 477(defun org-publish-file (filename &optional project)
549 "Publish file FILENAME from PROJECT." 478 "Publish file FILENAME from PROJECT."
550 (when (org-publish-needed-p filename) 479 (let* ((project
551 (let* ((project 480 (or project
552 (or project 481 (or (org-publish-get-project-from-filename filename)
553 (or (org-publish-get-project-from-filename filename) 482 (if (y-or-n-p
554 (if (y-or-n-p 483 (format "%s is not in a project. Re-read the list of projects files? "
555 (format "%s is not in a project. Re-read the list of projects files? " 484 (abbreviate-file-name filename)))
556 (abbreviate-file-name filename))) 485 ;; If requested, re-initialize the list of projects files
557 ;; If requested, re-initialize the list of projects files 486 (progn (org-publish-initialize-files-alist t)
558 (progn (org-publish-initialize-files-alist t) 487 (or (org-publish-get-project-from-filename filename)
559 (or (org-publish-get-project-from-filename filename) 488 (error "File %s not part of any known project"
560 (error "File %s not part of any known project" 489 (abbreviate-file-name filename))))
561 (abbreviate-file-name filename)))) 490 (error "Can't publish file outside of a project")))))
562 (error "Can't publish file outside of a project"))))) 491 (project-plist (cdr project))
563 (project-plist (cdr project)) 492 (ftname (file-truename filename))
564 (ftname (file-truename filename)) 493 (publishing-function
565 (publishing-function 494 (or (plist-get project-plist :publishing-function)
566 (or (plist-get project-plist :publishing-function) 495 'org-publish-org-to-html))
567 'org-publish-org-to-html)) 496 (base-dir (file-name-as-directory
568 (base-dir (file-name-as-directory 497 (file-truename (plist-get project-plist :base-directory))))
569 (file-truename (plist-get project-plist :base-directory)))) 498 (pub-dir (file-name-as-directory
570 (pub-dir (file-name-as-directory 499 (file-truename (plist-get project-plist :publishing-directory))))
571 (file-truename (plist-get project-plist :publishing-directory)))) 500 tmp-pub-dir)
572 tmp-pub-dir) 501 (setq tmp-pub-dir
573 (setq tmp-pub-dir 502 (file-name-directory
574 (file-name-directory 503 (concat pub-dir
575 (concat pub-dir 504 (and (string-match (regexp-quote base-dir) ftname)
576 (and (string-match (regexp-quote base-dir) ftname) 505 (substring ftname (match-end 0))))))
577 (substring ftname (match-end 0)))))) 506 (if (listp publishing-function)
578 (if (listp publishing-function) 507 ;; allow chain of publishing functions
579 ;; allow chain of publishing functions 508 (mapc (lambda (f)
580 (mapc (lambda (f) 509 (when (org-publish-needed-p filename pub-dir f tmp-pub-dir)
581 (funcall f project-plist filename tmp-pub-dir)) 510 (funcall f project-plist filename tmp-pub-dir)
582 publishing-function) 511 (org-publish-update-timestamp filename pub-dir f)))
583 (funcall publishing-function project-plist filename tmp-pub-dir))) 512 publishing-function)
584 (org-publish-update-timestamp filename))) 513 (when (org-publish-needed-p filename pub-dir publishing-function
514 tmp-pub-dir)
515 (funcall publishing-function project-plist filename tmp-pub-dir)
516 (org-publish-update-timestamp
517 filename pub-dir publishing-function)))))
585 518
586(defun org-publish-projects (projects) 519(defun org-publish-projects (projects)
587 "Publish all files belonging to the PROJECTS alist. 520 "Publish all files belonging to the PROJECTS alist.
@@ -593,7 +526,7 @@ If :auto-index is set, publish the index too."
593 (exclude-regexp (plist-get project-plist :exclude)) 526 (exclude-regexp (plist-get project-plist :exclude))
594 (index-p (plist-get project-plist :auto-index)) 527 (index-p (plist-get project-plist :auto-index))
595 (index-filename (or (plist-get project-plist :index-filename) 528 (index-filename (or (plist-get project-plist :index-filename)
596 "index.org")) 529 "sitemap.org"))
597 (index-function (or (plist-get project-plist :index-function) 530 (index-function (or (plist-get project-plist :index-function)
598 'org-publish-org-index)) 531 'org-publish-org-index))
599 (preparation-function (plist-get project-plist :preparation-function)) 532 (preparation-function (plist-get project-plist :preparation-function))
@@ -609,7 +542,7 @@ If :auto-index is set, publish the index too."
609(defun org-publish-org-index (project &optional index-filename) 542(defun org-publish-org-index (project &optional index-filename)
610 "Create an index of pages in set defined by PROJECT. 543 "Create an index of pages in set defined by PROJECT.
611Optionally set the filename of the index with INDEX-FILENAME. 544Optionally set the filename of the index with INDEX-FILENAME.
612Default for INDEX-FILENAME is 'index.org'." 545Default for INDEX-FILENAME is 'sitemap.org'."
613 (let* ((project-plist (cdr project)) 546 (let* ((project-plist (cdr project))
614 (dir (file-name-as-directory 547 (dir (file-name-as-directory
615 (plist-get project-plist :base-directory))) 548 (plist-get project-plist :base-directory)))
@@ -617,7 +550,7 @@ Default for INDEX-FILENAME is 'index.org'."
617 (indent-str (make-string 2 ?\ )) 550 (indent-str (make-string 2 ?\ ))
618 (exclude-regexp (plist-get project-plist :exclude)) 551 (exclude-regexp (plist-get project-plist :exclude))
619 (files (nreverse (org-publish-get-base-files project exclude-regexp))) 552 (files (nreverse (org-publish-get-base-files project exclude-regexp)))
620 (index-filename (concat dir (or index-filename "index.org"))) 553 (index-filename (concat dir (or index-filename "sitemap.org")))
621 (index-title (or (plist-get project-plist :index-title) 554 (index-title (or (plist-get project-plist :index-title)
622 (concat "Index for project " (car project)))) 555 (concat "Index for project " (car project))))
623 (index-style (or (plist-get project-plist :index-style) 556 (index-style (or (plist-get project-plist :index-style)
@@ -697,24 +630,27 @@ Default for INDEX-FILENAME is 'index.org'."
697;;;###autoload 630;;;###autoload
698(defun org-publish (project &optional force) 631(defun org-publish (project &optional force)
699 "Publish PROJECT." 632 "Publish PROJECT."
700 (interactive "P") 633 (interactive
634 (list
635 (assoc (org-ido-completing-read
636 "Publish project: "
637 org-publish-project-alist nil t)
638 org-publish-project-alist)
639 current-prefix-arg))
701 (setq org-publish-initial-buffer (current-buffer)) 640 (setq org-publish-initial-buffer (current-buffer))
702 (save-window-excursion 641 (save-window-excursion
703 (let* ((force current-prefix-arg) 642 (let* ((org-publish-use-timestamps-flag
704 (org-publish-use-timestamps-flag
705 (if force nil org-publish-use-timestamps-flag))) 643 (if force nil org-publish-use-timestamps-flag)))
706 (org-publish-projects 644 (org-publish-projects (list project)))))
707 (list (or project
708 (assoc (org-ido-completing-read
709 "Publish project: "
710 org-publish-project-alist nil t)
711 org-publish-project-alist)))))))
712 645
713;;;###autoload 646;;;###autoload
714(defun org-publish-all (&optional force) 647(defun org-publish-all (&optional force)
715 "Publish all projects. 648 "Publish all projects.
716With prefix argument, force publish all files." 649With prefix argument, remove all files in the timestamp
650directory and force publishing all files."
717 (interactive "P") 651 (interactive "P")
652 (when force
653 (org-publish-remove-all-timestamps))
718 (org-publish-initialize-files-alist) 654 (org-publish-initialize-files-alist)
719 (save-window-excursion 655 (save-window-excursion
720 (let ((org-publish-use-timestamps-flag 656 (let ((org-publish-use-timestamps-flag
@@ -740,7 +676,7 @@ the project."
740 (interactive "P") 676 (interactive "P")
741 (org-publish-initialize-files-alist) 677 (org-publish-initialize-files-alist)
742 (save-window-excursion 678 (save-window-excursion
743 (let ((project (org-publish-get-project-from-filename (buffer-file-name))) 679 (let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up))
744 (org-publish-use-timestamps-flag 680 (org-publish-use-timestamps-flag
745 (if force nil org-publish-use-timestamps-flag))) 681 (if force nil org-publish-use-timestamps-flag)))
746 (if (not project) 682 (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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -186,9 +186,10 @@ calendar | %:type %:date"
186 (const :tag "Use `org-default-notes-file'" nil)) 186 (const :tag "Use `org-default-notes-file'" nil))
187 (choice :tag "Destin. headline" 187 (choice :tag "Destin. headline"
188 (string :tag "Specify") 188 (string :tag "Specify")
189 (function :tag "Function")
189 (const :tag "Use `org-remember-default-headline'" nil) 190 (const :tag "Use `org-remember-default-headline'" nil)
190 (const :tag "Level 1 at beginning of file" top) 191 (const :tag "At beginning of file" top)
191 (const :tag "Level 1 at end of file" bottom)) 192 (const :tag "At end of file" bottom))
192 (choice :tag "Context" 193 (choice :tag "Context"
193 (const :tag "Use in all contexts" nil) 194 (const :tag "Use in all contexts" nil)
194 (const :tag "Use in all contexts" t) 195 (const :tag "Use in all contexts" t)
@@ -196,6 +197,11 @@ calendar | %:type %:date"
196 (symbol :tag "Major mode")) 197 (symbol :tag "Major mode"))
197 (function :tag "Perform a check against function"))))) 198 (function :tag "Perform a check against function")))))
198 199
200(defcustom org-remember-delete-empty-lines-at-end t
201 "Non-nil means clean up final empty lines in remember buffer."
202 :group 'org-remember
203 :type 'boolean)
204
199(defcustom org-remember-before-finalize-hook nil 205(defcustom org-remember-before-finalize-hook nil
200 "Hook that is run right before a remember process is finalized. 206 "Hook that is run right before a remember process is finalized.
201The remember buffer is still current when this hook runs." 207The 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. "
228 (const :tag "Always" t) 234 (const :tag "Always" t)
229 (const :tag "Query user" query))) 235 (const :tag "Query user" query)))
230 236
237(defcustom org-remember-backup-directory nil
238 "Directory where to store all remember buffers, for backup purposes.
239After a remember buffer has been stored successfully, the backup file
240will be removed. However, if you forget to finish the remember process,
241the file will remain there.
242See also `org-remember-auto-remove-backup-files'."
243 :group 'org-remember
244 :type '(choice
245 (const :tag "No backups" nil)
246 (directory :tag "Directory")))
247
248(defcustom org-remember-auto-remove-backup-files t
249 "Non-nil means, remove remember backup files after successfully storage.
250When remember is finished successfully, with storing the note at the
251desired target, remove the backup files related to this remember process
252and show a message about remaining backup files, from previous, unfinished
253remember sessions.
254Backup files will only be made at all, when `org-remember-backup-directory'
255is set."
256 :group 'org-remember
257 :type 'boolean)
231 258
232(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' 259(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
233(defvar initial) ; from remember.el, dynamically scoped in `remember-mode' 260(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
297 (append (list (nth 1 x) (car x)) (cddr x)) 324 (append (list (nth 1 x) (car x)) (cddr x))
298 (append (list (car x) "") (cdr x)))) 325 (append (list (car x) "") (cdr x))))
299 (delq nil pre-selected-templates2))) 326 (delq nil pre-selected-templates2)))
327 msg
300 (char (or use-char 328 (char (or use-char
301 (cond 329 (cond
302 ((= (length templates) 1) 330 ((= (length templates) 1)
@@ -307,22 +335,32 @@ RET at beg-of-buf -> Append to file as level 2 headline
307 (string-to-char org-force-remember-template-char) 335 (string-to-char org-force-remember-template-char)
308 org-force-remember-template-char)) 336 org-force-remember-template-char))
309 (t 337 (t
310 (message "Select template: %s" 338 (setq msg (format
311 (mapconcat 339 "Select template: %s"
312 (lambda (x) 340 (mapconcat
313 (cond 341 (lambda (x)
314 ((not (string-match "\\S-" (nth 1 x))) 342 (cond
315 (format "[%c]" (car x))) 343 ((not (string-match "\\S-" (nth 1 x)))
316 ((equal (downcase (car x)) 344 (format "[%c]" (car x)))
317 (downcase (aref (nth 1 x) 0))) 345 ((equal (downcase (car x))
318 (format "[%c]%s" (car x) 346 (downcase (aref (nth 1 x) 0)))
319 (substring (nth 1 x) 1))) 347 (format "[%c]%s" (car x)
320 (t (format "[%c]%s" (car x) (nth 1 x))))) 348 (substring (nth 1 x) 1)))
321 templates " ")) 349 (t (format "[%c]%s" (car x) (nth 1 x)))))
322 (let ((inhibit-quit t) (char0 (read-char-exclusive))) 350 templates " ")))
351 (let ((inhibit-quit t) char0)
352 (while (not char0)
353 (message msg)
354 (setq char0 (read-char-exclusive))
355 (when (and (not (assoc char0 templates))
356 (not (equal char0 ?\C-g)))
357 (message "No such template \"%c\"" char0)
358 (ding) (sit-for 1)
359 (setq char0 nil)))
323 (when (equal char0 ?\C-g) 360 (when (equal char0 ?\C-g)
324 (jump-to-register remember-register) 361 (jump-to-register remember-register)
325 (kill-buffer remember-buffer)) 362 (kill-buffer remember-buffer)
363 (error "Abort"))
326 char0)))))) 364 char0))))))
327 (cddr (assoc char templates))))) 365 (cddr (assoc char templates)))))
328 366
@@ -365,11 +403,16 @@ to be run from that hook to function properly."
365 (v-T (format-time-string (cdr org-time-stamp-formats) ct)) 403 (v-T (format-time-string (cdr org-time-stamp-formats) ct))
366 (v-u (concat "[" (substring v-t 1 -1) "]")) 404 (v-u (concat "[" (substring v-t 1 -1) "]"))
367 (v-U (concat "[" (substring v-T 1 -1) "]")) 405 (v-U (concat "[" (substring v-T 1 -1) "]"))
368 ;; `initial' and `annotation' are bound in `remember' 406 ;; `initial' and `annotation' are bound in `remember'.
369 (v-i (if (boundp 'initial) initial)) 407 ;; But if the property list has them, we prefer those values
370 (v-a (if (and (boundp 'annotation) annotation) 408 (v-i (or (plist-get org-store-link-plist :initial)
371 (if (equal annotation "[[]]") "" annotation) 409 (and (boundp 'initial) initial)
372 "")) 410 ""))
411 (v-a (or (plist-get org-store-link-plist :annotation)
412 (and (boundp 'annotation) annotation)
413 ""))
414 ;; Is the link empty? Then we do not want it...
415 (v-a (if (equal v-a "[[]]") "" v-a))
373 (clipboards (remove nil (list v-i 416 (clipboards (remove nil (list v-i
374 (org-get-x-clipboard 'PRIMARY) 417 (org-get-x-clipboard 'PRIMARY)
375 (org-get-x-clipboard 'CLIPBOARD) 418 (org-get-x-clipboard 'CLIPBOARD)
@@ -394,13 +437,16 @@ to be run from that hook to function properly."
394 437
395 (when (functionp file) 438 (when (functionp file)
396 (setq file (funcall file))) 439 (setq file (funcall file)))
440 (when (functionp headline)
441 (setq headline (funcall headline)))
397 (when (and file (not (file-name-absolute-p file))) 442 (when (and file (not (file-name-absolute-p file)))
398 (setq file (expand-file-name file org-directory))) 443 (setq file (expand-file-name file org-directory)))
399 444
400
401 (setq org-store-link-plist 445 (setq org-store-link-plist
402 (append (list :annotation v-a :initial v-i) 446 (plist-put org-store-link-plist :annotation v-a)
403 org-store-link-plist)) 447 org-store-link-plist
448 (plist-put org-store-link-plist :initial v-i))
449
404 (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1)) 450 (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1))
405 (erase-buffer) 451 (erase-buffer)
406 (insert (substitute-command-keys 452 (insert (substitute-command-keys
@@ -551,7 +597,7 @@ to be run from that hook to function properly."
551 nil nil (list org-end-time-was-given))) 597 nil nil (list org-end-time-was-given)))
552 (t 598 (t
553 (let (org-completion-use-ido) 599 (let (org-completion-use-ido)
554 (insert (org-completing-read 600 (insert (org-completing-read-no-ido
555 (concat (if prompt prompt "Enter string") 601 (concat (if prompt prompt "Enter string")
556 (if default (concat " [" default "]")) 602 (if default (concat " [" default "]"))
557 ": ") 603 ": ")
@@ -566,6 +612,17 @@ to be run from that hook to function properly."
566 (re-search-forward "%&" nil t)) 612 (re-search-forward "%&" nil t))
567 (replace-match "") 613 (replace-match "")
568 (org-set-local 'org-jump-to-target-location t)) 614 (org-set-local 'org-jump-to-target-location t))
615 (when org-remember-backup-directory
616 (unless (file-directory-p org-remember-backup-directory)
617 (make-directory org-remember-backup-directory))
618 (org-set-local 'auto-save-file-name-transforms nil)
619 (setq buffer-file-name
620 (expand-file-name
621 (format-time-string "remember-%Y-%m-%d-%H-%M-%S")
622 org-remember-backup-directory))
623 (save-buffer)
624 (org-set-local 'auto-save-visited-file-name t)
625 (auto-save-mode 1))
569 (when (save-excursion 626 (when (save-excursion
570 (goto-char (point-min)) 627 (goto-char (point-min))
571 (re-search-forward "%!" nil t)) 628 (re-search-forward "%!" nil t))
@@ -612,8 +669,7 @@ from that hook."
612 (y-or-n-p "The clock is running in this buffer. Clock out now? ")))) 669 (y-or-n-p "The clock is running in this buffer. Clock out now? "))))
613 (let (org-log-note-clock-out) (org-clock-out)))) 670 (let (org-log-note-clock-out) (org-clock-out))))
614 (when buffer-file-name 671 (when buffer-file-name
615 (save-buffer) 672 (do-auto-save))
616 (setq buffer-file-name nil))
617 (remember-finalize)) 673 (remember-finalize))
618 674
619(defun org-remember-kill () 675(defun org-remember-kill ()
@@ -695,6 +751,8 @@ The user is queried for the template."
695 (goto-char (match-beginning 0)) 751 (goto-char (match-beginning 0))
696 (error "Target headline not found: %s" heading)))) 752 (error "Target headline not found: %s" heading))))
697 753
754;; FIXME (bzg): let's clean up of final empty lines happen only once
755;; (see the org-remember-delete-empty-lines-at-end option below)
698;;;###autoload 756;;;###autoload
699(defun org-remember-handler () 757(defun org-remember-handler ()
700 "Store stuff from remember.el into an org file. 758 "Store stuff from remember.el into an org file.
@@ -738,14 +796,33 @@ See also the variable `org-reverse-note-order'."
738 (goto-char (point-min)) 796 (goto-char (point-min))
739 (while (looking-at "^[ \t]*\n\\|^##.*\n") 797 (while (looking-at "^[ \t]*\n\\|^##.*\n")
740 (replace-match "")) 798 (replace-match ""))
741 (goto-char (point-max)) 799 (when org-remember-delete-empty-lines-at-end
742 (beginning-of-line 1) 800 (goto-char (point-max))
743 (while (looking-at "[ \t]*$\\|##.*") 801 (beginning-of-line 1)
744 (delete-region (1- (point)) (point-max)) 802 (while (and (looking-at "[ \t]*$\\|##.*") (> (point) 1))
745 (beginning-of-line 1)) 803 (delete-region (1- (point)) (point-max))
804 (beginning-of-line 1)))
746 (catch 'quit 805 (catch 'quit
747 (if org-note-abort (throw 'quit nil)) 806 (if org-note-abort (throw 'quit t))
748 (let* ((visitp (org-bound-and-true-p org-jump-to-target-location)) 807 (let* ((visitp (org-bound-and-true-p org-jump-to-target-location))
808 (backup-file
809 (and buffer-file-name
810 (equal (file-name-directory buffer-file-name)
811 (file-name-as-directory
812 (expand-file-name org-remember-backup-directory)))
813 (string-match "^remember-[0-9]\\{4\\}"
814 (file-name-nondirectory buffer-file-name))
815 buffer-file-name))
816
817 (dummy
818 (unless (string-match "\\S-" (buffer-string))
819 (message "Nothing to remember")
820 (and backup-file
821 (ignore-errors
822 (delete-file backup-file)
823 (delete-file (concat backup-file "~"))))
824 (set-buffer-modified-p nil)
825 (throw 'quit t)))
749 (previousp (and (member current-prefix-arg '((16) 0)) 826 (previousp (and (member current-prefix-arg '((16) 0))
750 org-remember-previous-location)) 827 org-remember-previous-location))
751 (clockp (equal current-prefix-arg 2)) 828 (clockp (equal current-prefix-arg 2))
@@ -763,7 +840,7 @@ See also the variable `org-reverse-note-order'."
763 (org-startup-folded nil) 840 (org-startup-folded nil)
764 (org-startup-align-all-tables nil) 841 (org-startup-align-all-tables nil)
765 (org-goto-start-pos 1) 842 (org-goto-start-pos 1)
766 spos exitcmd level reversed txt) 843 spos exitcmd level reversed txt text-before-node-creation)
767 (when (equal current-prefix-arg '(4)) 844 (when (equal current-prefix-arg '(4))
768 (setq visitp t)) 845 (setq visitp t))
769 (when previousp 846 (when previousp
@@ -779,27 +856,32 @@ See also the variable `org-reverse-note-order'."
779 (setq current-prefix-arg nil) 856 (setq current-prefix-arg nil)
780 ;; Modify text so that it becomes a nice subtree which can be inserted 857 ;; Modify text so that it becomes a nice subtree which can be inserted
781 ;; into an org tree. 858 ;; into an org tree.
782 (goto-char (point-min)) 859 (when org-remember-delete-empty-lines-at-end
783 (if (re-search-forward "[ \t\n]+\\'" nil t) 860 (goto-char (point-min))
784 ;; remove empty lines at end 861 (if (re-search-forward "[ \t\n]+\\'" nil t)
785 (replace-match "")) 862 ;; remove empty lines at end
863 (replace-match "")))
786 (goto-char (point-min)) 864 (goto-char (point-min))
787 (unless (looking-at org-outline-regexp) 865 (unless (looking-at org-outline-regexp)
788 ;; add a headline 866 ;; add a headline
867 (setq text-before-node-creation (buffer-string))
789 (insert (concat "* " (current-time-string) 868 (insert (concat "* " (current-time-string)
790 " (" (remember-buffer-desc) ")\n")) 869 " (" (remember-buffer-desc) ")\n"))
791 (backward-char 1) 870 (backward-char 1)
792 (when org-adapt-indentation 871 (when org-adapt-indentation
793 (while (re-search-forward "^" nil t) 872 (while (re-search-forward "^" nil t)
794 (insert " ")))) 873 (insert " "))))
795 (goto-char (point-min)) 874 ;; Delete final empty lines
796 (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t) 875 (when org-remember-delete-empty-lines-at-end
797 (replace-match "\n\n") 876 (goto-char (point-min))
798 (if (re-search-forward "[ \t\n]*\\'") 877 (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t)
799 (replace-match "\n"))) 878 (replace-match "\n\n")
879 (if (re-search-forward "[ \t\n]*\\'")
880 (replace-match "\n"))))
800 (goto-char (point-min)) 881 (goto-char (point-min))
801 (setq txt (buffer-string)) 882 (setq txt (buffer-string))
802 (org-save-markers-in-region (point-min) (point-max)) 883 (org-save-markers-in-region (point-min) (point-max))
884 (set-buffer-modified-p nil)
803 (when (and (eq org-remember-interactive-interface 'refile) 885 (when (and (eq org-remember-interactive-interface 'refile)
804 (not fastp)) 886 (not fastp))
805 (org-refile nil (or visiting (find-file-noselect file))) 887 (org-refile nil (or visiting (find-file-noselect file)))
@@ -811,20 +893,26 @@ See also the variable `org-reverse-note-order'."
811 (throw 'quit t)) 893 (throw 'quit t))
812 ;; Find the file 894 ;; Find the file
813 (with-current-buffer (or visiting (find-file-noselect file)) 895 (with-current-buffer (or visiting (find-file-noselect file))
814 (unless (org-mode-p) 896 (unless (or (org-mode-p) (member heading '(top bottom)))
815 (error "Target files for remember notes must be in Org-mode")) 897 (error "Target files for notes must be in Org-mode if not filing to top/bottom"))
816 (save-excursion 898 (save-excursion
817 (save-restriction 899 (save-restriction
818 (widen) 900 (widen)
819 (and (goto-char (point-min))
820 (not (re-search-forward "^\\* " nil t))
821 (insert "\n* " (or (and (stringp heading) heading)
822 "Notes") "\n"))
823 (setq reversed (org-notes-order-reversed-p)) 901 (setq reversed (org-notes-order-reversed-p))
824 902
825 ;; Find the default location 903 ;; Find the default location
826 (when heading 904 (when heading
827 (cond 905 (cond
906 ((not (org-mode-p))
907 (if (eq heading 'top)
908 (goto-char (point-min))
909 (goto-char (point-max))
910 (or (bolp) (newline)))
911 (insert text-before-node-creation)
912 (when remember-save-after-remembering
913 (save-buffer)
914 (if (not visiting) (kill-buffer (current-buffer))))
915 (throw 'quit t))
828 ((eq heading 'top) 916 ((eq heading 'top)
829 (goto-char (point-min)) 917 (goto-char (point-min))
830 (or (looking-at org-outline-regexp) 918 (or (looking-at org-outline-regexp)
@@ -951,7 +1039,21 @@ See also the variable `org-reverse-note-order'."
951 (if (and (not visiting) 1039 (if (and (not visiting)
952 (not (equal (marker-buffer org-clock-marker) 1040 (not (equal (marker-buffer org-clock-marker)
953 (current-buffer)))) 1041 (current-buffer))))
954 (kill-buffer (current-buffer))))))))) 1042 (kill-buffer (current-buffer))))
1043 (when org-remember-auto-remove-backup-files
1044 (when backup-file
1045 (ignore-errors
1046 (delete-file backup-file)
1047 (delete-file (concat backup-file "~"))))
1048 (when org-remember-backup-directory
1049 (let ((n (length
1050 (directory-files
1051 org-remember-backup-directory nil
1052 "^remember-.*[0-9]$"))))
1053 (when (> n 0)
1054 (message
1055 "%d backup files (unfinished remember calls) in %s"
1056 n org-remember-backup-directory))))))))))
955 1057
956 t) ;; return t to indicate that we took care of this note. 1058 t) ;; return t to indicate that we took care of this note.
957 1059
@@ -995,3 +1097,4 @@ See also the variable `org-reverse-note-order'."
995;; arch-tag: 497f30d0-4bc3-4097-8622-2d27ac5f2698 1097;; arch-tag: 497f30d0-4bc3-4097-8622-2d27ac5f2698
996 1098
997;;; org-remember.el ends here 1099;;; org-remember.el ends here
1100
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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -36,11 +36,8 @@
36 36
37;; Declare external functions and variables 37;; Declare external functions and variables
38(declare-function rmail-show-message "rmail" (&optional n no-summary)) 38(declare-function rmail-show-message "rmail" (&optional n no-summary))
39(declare-function rmail-get-header "rmail" (name &optional msgnum))
40(declare-function rmail-what-message "rmail" ()) 39(declare-function rmail-what-message "rmail" ())
41(defvar rmail-current-message) 40(defvar rmail-current-message)
42(defvar rmail-buffer)
43(defvar rmail-view-buffer)
44 41
45;; Install the link type 42;; Install the link type
46(org-add-link-type "rmail" 'org-rmail-open) 43(org-add-link-type "rmail" 'org-rmail-open)
@@ -49,35 +46,29 @@
49;; Implementation 46;; Implementation
50(defun org-rmail-store-link () 47(defun org-rmail-store-link ()
51 "Store a link to an Rmail folder or message." 48 "Store a link to an Rmail folder or message."
52 (when (memq major-mode '(rmail-mode rmail-summary-mode)) 49 (when (or (eq major-mode 'rmail-mode)
53 (let (message-id from to subject desc link) 50 (eq major-mode 'rmail-summary-mode))
54 (if (fboundp 'rmail-get-header) ; Emacs 23 51 (save-window-excursion
55 (setq message-id (rmail-get-header "message-id") 52 (save-restriction
56 from (rmail-get-header "from") 53 (when (eq major-mode 'rmail-summary-mode)
57 to (rmail-get-header "to") 54 (rmail-show-message rmail-current-message))
58 subject (rmail-get-header "subject")) 55 (when (fboundp 'rmail-narrow-to-non-pruned-header)
59 (save-window-excursion ; Emacs 22 56 (rmail-narrow-to-non-pruned-header))
60 (save-restriction 57 (let* ((folder buffer-file-name)
61 (when (eq major-mode 'rmail-summary-mode) 58 (message-id (mail-fetch-field "message-id"))
62 (rmail-show-message rmail-current-message)) 59 (from (mail-fetch-field "from"))
63 (with-no-warnings ; don't warn when compiling Emacs 23 60 (to (mail-fetch-field "to"))
64 (rmail-narrow-to-non-pruned-header)) 61 (subject (mail-fetch-field "subject"))
65 (setq message-id (mail-fetch-field "message-id") 62 desc link)
66 from (mail-fetch-field "from") 63 (org-store-link-props
67 to (mail-fetch-field "to") 64 :type "rmail" :from from :to to
68 subject (mail-fetch-field "subject")) 65 :subject subject :message-id message-id)
69 (rmail-show-message rmail-current-message)))) 66 (setq message-id (org-remove-angle-brackets message-id))
70 (org-store-link-props 67 (setq desc (org-email-link-description))
71 :type "rmail" :from from :to to 68 (setq link (org-make-link "rmail:" folder "#" message-id))
72 :subject subject :message-id message-id) 69 (org-add-link-props :link link :description desc)
73 (setq message-id (org-remove-angle-brackets message-id)) 70 (rmail-show-message rmail-current-message)
74 (setq desc (org-email-link-description)) 71 link)))))
75 (setq link (org-make-link "rmail:"
76 (with-current-buffer rmail-buffer
77 buffer-file-name)
78 "#" message-id))
79 (org-add-link-props :link link :description desc)
80 link)))
81 72
82(defun org-rmail-open (path) 73(defun org-rmail-open (path)
83 "Follow an Rmail message link to the specified PATH." 74 "Follow an Rmail message link to the specified PATH."
@@ -92,27 +83,19 @@
92 "Follow an Rmail link to FOLDER and ARTICLE." 83 "Follow an Rmail link to FOLDER and ARTICLE."
93 (require 'rmail) 84 (require 'rmail)
94 (setq article (org-add-angle-brackets article)) 85 (setq article (org-add-angle-brackets article))
95 (let (message-number buff) 86 (let (message-number)
96 (save-excursion 87 (save-excursion
97 (save-window-excursion 88 (save-window-excursion
98 (rmail (if (string= folder "RMAIL") rmail-file-name folder)) 89 (rmail (if (string= folder "RMAIL") rmail-file-name folder))
99 (setq buff (current-buffer) 90 (setq message-number
100 message-number 91 (save-restriction
101 (with-current-buffer 92 (widen)
102 (if (and (fboundp 'rmail-buffers-swapped-p) 93 (goto-char (point-max))
103 (rmail-buffers-swapped-p)) 94 (if (re-search-backward
104 rmail-view-buffer 95 (concat "^Message-ID:\\s-+" (regexp-quote
105 (current-buffer)) 96 (or article "")))
106 (save-restriction 97 nil t)
107 (widen) 98 (rmail-what-message))))))
108 (goto-char (point-max))
109 (if (re-search-backward
110 (concat "^Message-ID:\\s-+" (regexp-quote
111 (or article "")))
112 nil t)
113 ;; This is an rmail "debugging" function. :(
114 (with-current-buffer buff
115 (rmail-what-message))))))))
116 (if message-number 99 (if message-number
117 (progn 100 (progn
118 (rmail (if (string= folder "RMAIL") rmail-file-name folder)) 101 (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 @@
1;;; org-src.el --- Source code examples in Org
2;;
3;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
4;; Free Software Foundation, Inc.
5;;
6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Bastien Guerry <bzg AT altern DOT org>
8;; Keywords: outlines, hypermedia, calendar, wp
9;; Homepage: http://orgmode.org
10;; Version: 6.29c
11;;
12;; This file is part of GNU Emacs.
13;;
14;; GNU Emacs is free software: you can redistribute it and/or modify
15;; it under the terms of the GNU General Public License as published by
16;; the Free Software Foundation, either version 3 of the License, or
17;; (at your option) any later version.
18
19;; GNU Emacs is distributed in the hope that it will be useful,
20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22;; GNU General Public License for more details.
23
24;; You should have received a copy of the GNU General Public License
25;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27;;
28;;; Commentary:
29
30;; This file contains the code dealing with source code examples in Org-mode.
31
32;;; Code:
33
34(require 'org-macs)
35(require 'org-compat)
36
37(declare-function org-do-remove-indentation "org" (&optional n))
38(declare-function org-get-indentation "org" (&optional line))
39
40(defcustom org-edit-src-region-extra nil
41 "Additional regexps to identify regions for editing with `org-edit-src-code'.
42For examples see the function `org-edit-src-find-region-and-lang'.
43The regular expression identifying the begin marker should end with a newline,
44and the regexp marking the end line should start with a newline, to make sure
45there are kept outside the narrowed region."
46 :group 'org-edit-structure
47 :type '(repeat
48 (list
49 (regexp :tag "begin regexp")
50 (regexp :tag "end regexp")
51 (choice :tag "language"
52 (string :tag "specify")
53 (integer :tag "from match group")
54 (const :tag "from `lang' element")
55 (const :tag "from `style' element")))))
56
57(defcustom org-coderef-label-format "(ref:%s)"
58 "The default coderef format.
59This format string will be used to search for coderef labels in literal
60examples (EXAMPLE and SRC blocks). The format can be overwritten in
61an individual literal example with the -f option, like
62
63#+BEGIN_SRC pascal +n -r -l \"((%s))\"
64...
65#+END_SRC
66
67If you want to use this for HTML export, make sure that the format does
68not introduce special font-locking, and avoid the HTML special
69characters `<', `>', and `&'. The reason for this restriction is that
70the labels are searched for only after htmlize has done its job."
71 :group 'org-edit-structure ; FIXME this is not in the right group
72 :type 'string)
73
74(defcustom org-edit-fixed-width-region-mode 'artist-mode
75 "The mode that should be used to edit fixed-width regions.
76These are the regions where each line starts with a colon."
77 :group 'org-edit-structure
78 :type '(choice
79 (const artist-mode)
80 (const picture-mode)
81 (const fundamental-mode)
82 (function :tag "Other (specify)")))
83
84(defcustom org-edit-src-content-indentation 2
85 "Indentation for the content is a source code block.
86This should be the number of spaces added to the indentation of the #+begin
87line in order to compute the indentation of the block content after
88editing it with \\[org-edit-src-code]."
89 :group 'org-edit-structure
90 :type 'integer)
91
92(defcustom org-edit-src-persistent-message t
93 "Non-nil means show persistent exit help message while editing src examples.
94The message is shown in the header-line, which will be created in the
95first line of the window showing the editing buffer.
96When nil, the message will only be shown intermittently in the echo area."
97 :group 'org-edit-structure
98 :type 'boolean)
99
100
101(defvar org-src-mode-hook nil
102 "Hook run after Org switched a source code snippet to its Emacs mode.
103This hook will run
104
105- when editing a source code snippet with \"C-c '\".
106- When formatting a source code snippet for export with htmlize.
107
108You may want to use this hook for example to turn off `outline-minor-mode'
109or similar things which you want to have when editing a source code file,
110but which mess up the display of a snippet in Org exported files.")
111
112;;; Editing source examples
113
114(defvar org-src-mode-map (make-sparse-keymap))
115(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
116(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save)
117(defvar org-edit-src-force-single-line nil)
118(defvar org-edit-src-from-org-mode nil)
119(defvar org-edit-src-picture nil)
120(defvar org-edit-src-beg-marker nil)
121(defvar org-edit-src-end-marker nil)
122(defvar org-edit-src-overlay nil)
123(defvar org-edit-src-nindent nil)
124
125(define-minor-mode org-src-mode
126 "Minor mode for language major mode buffers generated by org.
127This minor mode is turned on in two situations:
128- when editing a source code snippet with \"C-c '\".
129- When formatting a source code snippet for export with htmlize.
130There is a mode hook, and keybindings for `org-edit-src-exit' and
131`org-edit-src-save'")
132
133(defun org-edit-src-code ()
134 "Edit the source code example at point.
135The example is copied to a separate buffer, and that buffer is switched
136to the correct language mode. When done, exit with \\[org-edit-src-exit].
137This will remove the original code in the Org buffer, and replace it with
138the edited version."
139 (interactive)
140 (let ((line (org-current-line))
141 (case-fold-search t)
142 (msg (substitute-command-keys
143 "Edit, then exit with C-c ' (C-c and single quote)"))
144 (info (org-edit-src-find-region-and-lang))
145 (org-mode-p (eq major-mode 'org-mode))
146 (beg (make-marker))
147 (end (make-marker))
148 nindent ovl lang lang-f single lfmt code begline buffer)
149 (if (not info)
150 nil
151 (setq beg (move-marker beg (nth 0 info))
152 end (move-marker end (nth 1 info))
153 code (buffer-substring-no-properties beg end)
154 lang (nth 2 info)
155 single (nth 3 info)
156 lfmt (nth 4 info)
157 nindent (nth 5 info)
158 lang-f (intern (concat lang "-mode"))
159 begline (save-excursion (goto-char beg) (org-current-line)))
160 (unless (functionp lang-f)
161 (error "No such language mode: %s" lang-f))
162 (goto-line line)
163 (if (and (setq buffer (org-edit-src-find-buffer beg end))
164 (y-or-n-p "Return to existing edit buffer? [n] will revert changes: "))
165 (switch-to-buffer buffer)
166 (when buffer
167 (with-current-buffer buffer
168 (if (boundp 'org-edit-src-overlay)
169 (org-delete-overlay org-edit-src-overlay)))
170 (kill-buffer buffer))
171 (setq buffer (generate-new-buffer "*Org Edit Src Example*"))
172 (setq ovl (org-make-overlay beg end))
173 (org-overlay-put ovl 'face 'secondary-selection)
174 (org-overlay-put ovl 'edit-buffer buffer)
175 (org-overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
176 (org-overlay-put ovl 'face 'secondary-selection)
177 (org-overlay-put ovl
178 'keymap
179 (let ((map (make-sparse-keymap)))
180 (define-key map [mouse-1] 'org-edit-src-continue)
181 map))
182 (org-overlay-put ovl :read-only "Leave me alone")
183 (switch-to-buffer buffer)
184 (insert code)
185 (remove-text-properties (point-min) (point-max)
186 '(display nil invisible nil intangible nil))
187 (org-do-remove-indentation)
188 (let ((org-inhibit-startup t))
189 (funcall lang-f)
190 (org-src-mode))
191 (set (make-local-variable 'org-edit-src-force-single-line) single)
192 (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
193 (when lfmt
194 (set (make-local-variable 'org-coderef-label-format) lfmt))
195 (when org-mode-p
196 (goto-char (point-min))
197 (while (re-search-forward "^," nil t)
198 (replace-match "")))
199 (goto-line (1+ (- line begline)))
200 (org-set-local 'org-edit-src-beg-marker beg)
201 (org-set-local 'org-edit-src-end-marker end)
202 (org-set-local 'org-edit-src-overlay ovl)
203 (org-set-local 'org-edit-src-nindent nindent)
204 (and org-edit-src-persistent-message
205 (org-set-local 'header-line-format msg)))
206 (message "%s" msg)
207 t)))
208
209(defun org-edit-src-continue (e)
210 (interactive "e")
211 (mouse-set-point e)
212 (let ((buf (get-char-property (point) 'edit-buffer)))
213 (if buf (switch-to-buffer buf)
214 (error "Something is wrong here"))))
215
216(defun org-edit-src-find-buffer (beg end)
217 "Find a source editing buffer that is already editing the region BEG to END."
218 (catch 'exit
219 (mapc
220 (lambda (b)
221 (with-current-buffer b
222 (if (and (string-match "\\`*Org Edit " (buffer-name))
223 (local-variable-p 'org-edit-src-beg-marker (current-buffer))
224 (local-variable-p 'org-edit-src-end-marker (current-buffer))
225 (equal beg org-edit-src-beg-marker)
226 (equal end org-edit-src-end-marker))
227 (throw 'exit (current-buffer)))))
228 (buffer-list))
229 nil))
230
231(defun org-edit-fixed-width-region ()
232 "Edit the fixed-width ascii drawing at point.
233This must be a region where each line starts with a colon followed by
234a space character.
235An new buffer is created and the fixed-width region is copied into it,
236and the buffer is switched into `artist-mode' for editing. When done,
237exit with \\[org-edit-src-exit]. The edited text will then replace
238the fragment in the Org-mode buffer."
239 (interactive)
240 (let ((line (org-current-line))
241 (case-fold-search t)
242 (msg (substitute-command-keys
243 "Edit, then exit with C-c ' (C-c and single quote)"))
244 (org-mode-p (eq major-mode 'org-mode))
245 (beg (make-marker))
246 (end (make-marker))
247 nindent ovl beg1 end1 code begline buffer)
248 (beginning-of-line 1)
249 (if (looking-at "[ \t]*[^:\n \t]")
250 nil
251 (if (looking-at "[ \t]*\\(\n\\|\\'\\)")
252 (setq beg1 (point) end1 beg1)
253 (save-excursion
254 (if (re-search-backward "^[ \t]*[^: \t]" nil 'move)
255 (setq beg1 (point-at-bol 2))
256 (setq beg1 (point))))
257 (save-excursion
258 (if (re-search-forward "^[ \t]*[^: \t]" nil 'move)
259 (setq end1 (1- (match-beginning 0)))
260 (setq end1 (point))))
261 (goto-line line))
262 (setq beg (move-marker beg beg1)
263 end (move-marker end end1)
264 code (buffer-substring-no-properties beg end)
265 begline (save-excursion (goto-char beg) (org-current-line)))
266 (if (and (setq buffer (org-edit-src-find-buffer beg end))
267 (y-or-n-p "Return to existing edit buffer? [n] will revert changes: "))
268 (switch-to-buffer buffer)
269 (when buffer
270 (with-current-buffer buffer
271 (if (boundp 'org-edit-src-overlay)
272 (org-delete-overlay org-edit-src-overlay)))
273 (kill-buffer buffer))
274 (setq buffer (generate-new-buffer "*Org Edit Src Example*"))
275 (setq ovl (org-make-overlay beg end))
276 (org-overlay-put ovl 'face 'secondary-selection)
277 (org-overlay-put ovl 'edit-buffer buffer)
278 (org-overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
279 (org-overlay-put ovl 'face 'secondary-selection)
280 (org-overlay-put ovl
281 'keymap
282 (let ((map (make-sparse-keymap)))
283 (define-key map [mouse-1] 'org-edit-src-continue)
284 map))
285 (org-overlay-put ovl :read-only "Leave me alone")
286 (switch-to-buffer buffer)
287 (insert code)
288 (remove-text-properties (point-min) (point-max)
289 '(display nil invisible nil intangible nil))
290 (setq nindent (org-do-remove-indentation))
291 (cond
292 ((eq org-edit-fixed-width-region-mode 'artist-mode)
293 (fundamental-mode)
294 (artist-mode 1))
295 (t (funcall org-edit-fixed-width-region-mode)))
296 (set (make-local-variable 'org-edit-src-force-single-line) nil)
297 (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
298 (set (make-local-variable 'org-edit-src-picture) t)
299 (goto-char (point-min))
300 (while (re-search-forward "^[ \t]*: ?" nil t)
301 (replace-match ""))
302 (goto-line (1+ (- line begline)))
303 (org-src-mode)
304 (org-set-local 'org-edit-src-beg-marker beg)
305 (org-set-local 'org-edit-src-end-marker end)
306 (org-set-local 'org-edit-src-overlay ovl)
307 (org-set-local 'org-edit-src-nindent nindent)
308 (and org-edit-src-persistent-message
309 (org-set-local 'header-line-format msg)))
310 (message "%s" msg)
311 t)))
312
313(defun org-edit-src-find-region-and-lang ()
314 "Find the region and language for a local edit.
315Return a list with beginning and end of the region, a string representing
316the language, a switch telling of the content should be in a single line."
317 (let ((re-list
318 (append
319 org-edit-src-region-extra
320 '(
321 ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang)
322 ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style)
323 ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental")
324 ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp")
325 ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl")
326 ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python")
327 ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby")
328 ("^[ \t]*#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n[ \t]*#\\+end_src" 2)
329 ("^[ \t]*#\\+begin_example.*\n" "\n[ \t]*#\\+end_example" "fundamental")
330 ("^[ \t]*#\\+html:" "\n" "html" single-line)
331 ("^[ \t]*#\\+begin_html.*\n" "\n[ \t]*#\\+end_html" "html")
332 ("^[ \t]*#\\+latex:" "\n" "latex" single-line)
333 ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex")
334 ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line)
335 ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental")
336 ("^[ \t]*#\\+docbook:" "\n" "xml" single-line)
337 ("^[ \t]*#\\+begin_docbook.*\n" "\n[ \t]*#\\+end_docbook" "xml")
338 )))
339 (pos (point))
340 re1 re2 single beg end lang lfmt match-re1 ind entry)
341 (catch 'exit
342 (while (setq entry (pop re-list))
343 (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
344 single (nth 3 entry))
345 (save-excursion
346 (if (or (looking-at re1)
347 (re-search-backward re1 nil t))
348 (progn
349 (setq match-re1 (match-string 0))
350 (setq beg (match-end 0)
351 lang (org-edit-src-get-lang lang)
352 lfmt (org-edit-src-get-label-format match-re1)
353 ind (org-edit-src-get-indentation (match-beginning 0)))
354 (if (and (re-search-forward re2 nil t)
355 (>= (match-end 0) pos))
356 (throw 'exit (list beg (match-beginning 0)
357 lang single lfmt ind))))
358 (if (or (looking-at re2)
359 (re-search-forward re2 nil t))
360 (progn
361 (setq end (match-beginning 0))
362 (if (and (re-search-backward re1 nil t)
363 (<= (match-beginning 0) pos))
364 (progn
365 (setq lfmt (org-edit-src-get-label-format
366 (match-string 0))
367 ind (org-edit-src-get-indentation
368 (match-beginning 0)))
369 (throw 'exit
370 (list (match-end 0) end
371 (org-edit-src-get-lang lang)
372 single lfmt ind))))))))))))
373
374(defun org-edit-src-get-lang (lang)
375 "Extract the src language."
376 (let ((m (match-string 0)))
377 (cond
378 ((stringp lang) lang)
379 ((integerp lang) (match-string lang))
380 ((and (eq lang 'lang)
381 (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m))
382 (match-string 1 m))
383 ((and (eq lang 'style)
384 (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m))
385 (match-string 1 m))
386 (t "fundamental"))))
387
388(defun org-edit-src-get-label-format (s)
389 "Extract the label format."
390 (save-match-data
391 (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s)
392 (match-string 1 s))))
393
394(defun org-edit-src-get-indentation (pos)
395 "Extract the label format."
396 (save-match-data
397 (goto-char pos)
398 (org-get-indentation)))
399
400(defun org-edit-src-exit ()
401 "Exit special edit and protect problematic lines."
402 (interactive)
403 (unless (string-match "\\`*Org Edit " (buffer-name (current-buffer)))
404 (error "This is not an sub-editing buffer, something is wrong..."))
405 (let ((beg org-edit-src-beg-marker)
406 (end org-edit-src-end-marker)
407 (ovl org-edit-src-overlay)
408 (buffer (current-buffer))
409 (nindent org-edit-src-nindent)
410 code line)
411 (untabify (point-min) (point-max))
412 (save-excursion
413 (goto-char (point-min))
414 (if (looking-at "[ \t\n]*\n") (replace-match ""))
415 (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))
416 (setq line (if (org-bound-and-true-p org-edit-src-force-single-line)
417 1
418 (org-current-line)))
419 (when (org-bound-and-true-p org-edit-src-force-single-line)
420 (goto-char (point-min))
421 (while (re-search-forward "\n" nil t)
422 (replace-match " "))
423 (goto-char (point-min))
424 (if (looking-at "\\s-*") (replace-match " "))
425 (if (re-search-forward "\\s-+\\'" nil t)
426 (replace-match "")))
427 (when (org-bound-and-true-p org-edit-src-from-org-mode)
428 (goto-char (point-min))
429 (while (re-search-forward
430 (if (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t)
431 (replace-match ",\\1")))
432 (when (org-bound-and-true-p org-edit-src-picture)
433 (untabify (point-min) (point-max))
434 (goto-char (point-min))
435 (while (re-search-forward "^" nil t)
436 (replace-match ": ")))
437 (when nindent
438 (setq nindent (make-string (+ org-edit-src-content-indentation nindent)
439 ?\ ))
440 (goto-char (point-min))
441 (while (re-search-forward "^" nil t)
442 (replace-match nindent)))
443 (setq code (buffer-string))
444 (switch-to-buffer (marker-buffer beg))
445 (kill-buffer buffer)
446 (goto-char beg)
447 (org-delete-overlay ovl)
448 (delete-region beg end)
449 (insert code)
450 (goto-char beg)
451 (goto-line (1- (+ (org-current-line) line)))
452 (move-marker beg nil)
453 (move-marker end nil)))
454
455(defun org-edit-src-save ()
456 "Save parent buffer with current state source-code buffer."
457 (interactive)
458 (let ((p (point)) (m (mark)) msg)
459 (org-edit-src-exit)
460 (save-buffer)
461 (setq msg (current-message))
462 (org-edit-src-code)
463 (push-mark m 'nomessage)
464 (goto-char (min p (point-max)))
465 (message (or msg ""))))
466
467(provide 'org-src)
468
469;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8
470
471;;; 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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -247,13 +247,29 @@ Automatically means, when TAB or RET or C-c C-c are pressed in the line."
247 :type 'boolean) 247 :type 'boolean)
248 248
249(defcustom org-table-error-on-row-ref-crossing-hline t 249(defcustom org-table-error-on-row-ref-crossing-hline t
250 "Non-nil means, a relative row reference that tries to cross a hline errors. 250 "OBSOLETE VARIABLE, please see `org-table-relative-ref-may-cross-hline'."
251When nil, the reference will silently be to the field just next to the hline.
252Coming from below, it will be the field below the hline, coming from
253above, it will be the field above the hline."
254 :group 'org-table 251 :group 'org-table
255 :type 'boolean) 252 :type 'boolean)
256 253
254(defcustom org-table-relative-ref-may-cross-hline t
255 "Non-nil means, reltive formula references may cross hlines.
256Here are the allowed values:
257
258nil Relative references may not cross hlines. They will reference the
259 field next to the hline instead. Coming from below, the reference
260 will be to the field below the hline. Coming from above, it will be
261 to the field above.
262t Relative references may cros hlines.
263error An attempt to cross a hline will throw an error.
264
265It is probably good to never set this variable to nil, for the sake of
266portability of tables."
267 :group 'org-table-calculation
268 :type '(choice
269 (const :tag "Allow to cross" t)
270 (const :tag "Stick to hline" nil)
271 (const :tag "Error on attempt to cross" error)))
272
257(defgroup org-table-import-export nil 273(defgroup org-table-import-export nil
258 "Options concerning table import and export in Org-mode." 274 "Options concerning table import and export in Org-mode."
259 :tag "Org Table Import Export" 275 :tag "Org Table Import Export"
@@ -471,8 +487,9 @@ property, locally or anywhere up in the hierarchy."
471 (error "Abort"))) 487 (error "Abort")))
472 (if (file-directory-p file) 488 (if (file-directory-p file)
473 (error "This is a directory path, not a file")) 489 (error "This is a directory path, not a file"))
474 (if (equal (file-truename file) 490 (if (and (buffer-file-name)
475 (file-truename (buffer-file-name))) 491 (equal (file-truename file)
492 (file-truename (buffer-file-name))))
476 (error "Please specify a file name that is different from current")) 493 (error "Please specify a file name that is different from current"))
477 (unless format 494 (unless format
478 (setq deffmt-readable org-table-export-default-format) 495 (setq deffmt-readable org-table-export-default-format)
@@ -573,7 +590,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
573 (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) 590 (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
574 (hfmt1 (concat 591 (hfmt1 (concat
575 (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) 592 (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
576 emptystrings links dates emph narrow fmax f1 len c e) 593 emptystrings links dates emph narrow falign falign1 fmax f1 len c e)
577 (untabify beg end) 594 (untabify beg end)
578 (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) 595 (remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
579 ;; Check if we have links or dates 596 ;; Check if we have links or dates
@@ -594,7 +611,9 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
594 ;; Check if we are narrowing any columns 611 ;; Check if we are narrowing any columns
595 (goto-char beg) 612 (goto-char beg)
596 (setq narrow (and org-format-transports-properties-p 613 (setq narrow (and org-format-transports-properties-p
597 (re-search-forward "<[0-9]+>" end t))) 614 (re-search-forward "<[rl]?[0-9]+>" end t)))
615 (goto-char beg)
616 (setq falign (re-search-forward "<[rl][0-9]*>" end t))
598 ;; Get the rows 617 ;; Get the rows
599 (setq lines (org-split-string 618 (setq lines (org-split-string
600 (buffer-substring beg end) "\n")) 619 (buffer-substring beg end) "\n"))
@@ -629,12 +648,14 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
629 (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns 648 (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns
630 (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) 649 (setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
631 ;; Check if there is an explicit width specified 650 ;; Check if there is an explicit width specified
632 (when narrow 651 (when (or narrow falign)
633 (setq c column fmax nil) 652 (setq c column fmax nil falign1 nil)
634 (while c 653 (while c
635 (setq e (pop c)) 654 (setq e (pop c))
636 (if (and (stringp e) (string-match "^<\\([0-9]+\\)>$" e)) 655 (when (and (stringp e) (string-match "^<\\([rl]\\)?\\([0-9]+\\)?>$" e))
637 (setq fmax (string-to-number (match-string 1 e)) c nil))) 656 (if (match-end 1) (setq falign1 (match-string 1 e)))
657 (if (match-end 2)
658 (setq fmax (string-to-number (match-string 2 e)) c nil))))
638 ;; Find fields that are wider than fmax, and shorten them 659 ;; Find fields that are wider than fmax, and shorten them
639 (when fmax 660 (when fmax
640 (loop for xx in column do 661 (loop for xx in column do
@@ -654,14 +675,16 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
654 ;; Get the maximum width for each column 675 ;; Get the maximum width for each column
655 (push (apply 'max 1 (mapcar 'org-string-width column)) lengths) 676 (push (apply 'max 1 (mapcar 'org-string-width column)) lengths)
656 ;; Get the fraction of numbers, to decide about alignment of the column 677 ;; Get the fraction of numbers, to decide about alignment of the column
657 (setq cnt 0 frac 0.0) 678 (if falign1
658 (loop for x in column do 679 (push (equal (downcase falign1) "r") typenums)
659 (if (equal x "") 680 (setq cnt 0 frac 0.0)
660 nil 681 (loop for x in column do
661 (setq frac ( / (+ (* frac cnt) 682 (if (equal x "")
662 (if (string-match org-table-number-regexp x) 1 0)) 683 nil
663 (setq cnt (1+ cnt)))))) 684 (setq frac ( / (+ (* frac cnt)
664 (push (>= frac org-table-number-fraction) typenums)) 685 (if (string-match org-table-number-regexp x) 1 0))
686 (setq cnt (1+ cnt))))))
687 (push (>= frac org-table-number-fraction) typenums)))
665 (setq lengths (nreverse lengths) typenums (nreverse typenums)) 688 (setq lengths (nreverse lengths) typenums (nreverse typenums))
666 689
667 ;; Store the alignment of this table, for later editing of single fields 690 ;; Store the alignment of this table, for later editing of single fields
@@ -699,6 +722,16 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
699 ;; Replace the old one 722 ;; Replace the old one
700 (delete-region beg end) 723 (delete-region beg end)
701 (move-marker end nil) 724 (move-marker end nil)
725 (if (equal (char-before) ?\n)
726 ;; This hack is for org-indent, to force redisplay of the
727 ;; line prefix of the first line. Apparently the redisplay
728 ;; is tied to the newline, which is, I think, a bug.
729 ;; To force this redisplay, we remove and re-insert the
730 ;; newline, so that the redisplay engine thinks it belongs
731 ;; to the changed text.
732 (progn
733 (backward-delete-char 1)
734 (insert "\n")))
702 (move-marker org-table-aligned-begin-marker (point)) 735 (move-marker org-table-aligned-begin-marker (point))
703 (insert new) 736 (insert new)
704 (move-marker org-table-aligned-end-marker (point)) 737 (move-marker org-table-aligned-end-marker (point))
@@ -827,13 +860,48 @@ Before doing so, re-align the table if necessary."
827 (org-table-align)) 860 (org-table-align))
828 (if (org-at-table-hline-p) 861 (if (org-at-table-hline-p)
829 (end-of-line 1)) 862 (end-of-line 1))
830 (re-search-backward "|" (org-table-begin)) 863 (condition-case nil
831 (re-search-backward "|" (org-table-begin)) 864 (progn
865 (re-search-backward "|" (org-table-begin))
866 (re-search-backward "|" (org-table-begin)))
867 (error (error "Cannot move to previous table field")))
832 (while (looking-at "|\\(-\\|[ \t]*$\\)") 868 (while (looking-at "|\\(-\\|[ \t]*$\\)")
833 (re-search-backward "|" (org-table-begin))) 869 (re-search-backward "|" (org-table-begin)))
834 (if (looking-at "| ?") 870 (if (looking-at "| ?")
835 (goto-char (match-end 0)))) 871 (goto-char (match-end 0))))
836 872
873(defun org-table-beginning-of-field (&optional n)
874 "Move to the end of the current table field.
875If already at or after the end, move to the end of the next table field.
876With numeric argument N, move N-1 fields forward first."
877 (interactive "p")
878 (let ((pos (point)))
879 (while (> n 1)
880 (setq n (1- n))
881 (org-table-previous-field))
882 (if (not (re-search-backward "|" (point-at-bol 0) t))
883 (error "No more table fields before the current")
884 (goto-char (match-end 0))
885 (and (looking-at " ") (forward-char 1)))
886 (if (>= (point) pos) (org-table-beginning-of-field 2))))
887
888(defun org-table-end-of-field (&optional n)
889 "Move to the beginning of the current table field.
890If already at or before the beginning, move to the beginning of the
891previous field.
892With numeric argument N, move N-1 fields backward first."
893 (interactive "p")
894 (let ((pos (point)))
895 (while (> n 1)
896 (setq n (1- n))
897 (org-table-next-field))
898 (when (re-search-forward "|" (point-at-eol 1) t)
899 (backward-char 1)
900 (skip-chars-backward " ")
901 (if (and (equal (char-before (point)) ?|) (looking-at " "))
902 (forward-char 1)))
903 (if (<= (point) pos) (org-table-end-of-field 2))))
904
837(defun org-table-next-row () 905(defun org-table-next-row ()
838 "Go to the next row (same column) in the current table. 906 "Go to the next row (same column) in the current table.
839Before doing so, re-align the table if necessary." 907Before doing so, re-align the table if necessary."
@@ -1362,15 +1430,21 @@ should be done in reverse order."
1362 1430
1363 1431
1364(defun org-table-cut-region (beg end) 1432(defun org-table-cut-region (beg end)
1365 "Copy region in table to the clipboard and blank all relevant fields." 1433 "Copy region in table to the clipboard and blank all relevant fields.
1366 (interactive "r") 1434If there is no active region, use just the field at point."
1435 (interactive (list
1436 (if (org-region-active-p) (region-beginning) (point))
1437 (if (org-region-active-p) (region-end) (point))))
1367 (org-table-copy-region beg end 'cut)) 1438 (org-table-copy-region beg end 'cut))
1368 1439
1369(defun org-table-copy-region (beg end &optional cut) 1440(defun org-table-copy-region (beg end &optional cut)
1370 "Copy rectangular region in table to clipboard. 1441 "Copy rectangular region in table to clipboard.
1371A special clipboard is used which can only be accessed 1442A special clipboard is used which can only be accessed
1372with `org-table-paste-rectangle'." 1443with `org-table-paste-rectangle'."
1373 (interactive "rP") 1444 (interactive (list
1445 (if (org-region-active-p) (region-beginning) (point))
1446 (if (org-region-active-p) (region-end) (point))
1447 current-prefix-arg))
1374 (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 1448 (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
1375 region cols 1449 region cols
1376 (rpl (if cut " " nil))) 1450 (rpl (if cut " " nil)))
@@ -1778,11 +1852,12 @@ When NAMED is non-nil, look for a named equation."
1778 (setq alist (sort alist 'org-table-formula-less-p)) 1852 (setq alist (sort alist 'org-table-formula-less-p))
1779 (save-excursion 1853 (save-excursion
1780 (goto-char (org-table-end)) 1854 (goto-char (org-table-end))
1781 (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:\\(.*\n?\\)") 1855 (if (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM:\\(.*\n?\\)")
1782 (progn 1856 (progn
1783 ;; don't overwrite TBLFM, we might use text properties to store stuff 1857 ;; don't overwrite TBLFM, we might use text properties to store stuff
1784 (goto-char (match-beginning 2)) 1858 (goto-char (match-beginning 2))
1785 (delete-region (match-beginning 2) (match-end 0))) 1859 (delete-region (match-beginning 2) (match-end 0)))
1860 (org-indent-line-function)
1786 (insert "#+TBLFM:")) 1861 (insert "#+TBLFM:"))
1787 (insert " " 1862 (insert " "
1788 (mapconcat (lambda (x) 1863 (mapconcat (lambda (x)
@@ -1811,7 +1886,7 @@ When NAMED is non-nil, look for a named equation."
1811 (let (scol eq eq-alist strings string seen) 1886 (let (scol eq eq-alist strings string seen)
1812 (save-excursion 1887 (save-excursion
1813 (goto-char (org-table-end)) 1888 (goto-char (org-table-end))
1814 (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") 1889 (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
1815 (setq strings (org-split-string (match-string 2) " *:: *")) 1890 (setq strings (org-split-string (match-string 2) " *:: *"))
1816 (while (setq string (pop strings)) 1891 (while (setq string (pop strings))
1817 (when (string-match "\\`\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string) 1892 (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.
1836For all numbers larger than LIMIT, shift them by DELTA." 1911For all numbers larger than LIMIT, shift them by DELTA."
1837 (save-excursion 1912 (save-excursion
1838 (goto-char (org-table-end)) 1913 (goto-char (org-table-end))
1839 (when (looking-at "#\\+TBLFM:") 1914 (when (looking-at "[ \t]*#\\+TBLFM:")
1840 (let ((re (concat key "\\([0-9]+\\)")) 1915 (let ((re (concat key "\\([0-9]+\\)"))
1841 (re2 1916 (re2
1842 (when remove 1917 (when remove
@@ -1847,14 +1922,17 @@ For all numbers larger than LIMIT, shift them by DELTA."
1847 s n a) 1922 s n a)
1848 (when remove 1923 (when remove
1849 (while (re-search-forward re2 (point-at-eol) t) 1924 (while (re-search-forward re2 (point-at-eol) t)
1850 (replace-match ""))) 1925 (unless (save-match-data (org-in-regexp "remote([^)]+?)"))
1926 (replace-match ""))))
1851 (while (re-search-forward re (point-at-eol) t) 1927 (while (re-search-forward re (point-at-eol) t)
1852 (setq s (match-string 1) n (string-to-number s)) 1928 (unless (save-match-data (org-in-regexp "remote([^)]+?)"))
1853 (cond 1929 (setq s (match-string 1) n (string-to-number s))
1854 ((setq a (assoc s replace)) 1930 (cond
1855 (replace-match (concat key (cdr a)) t t)) 1931 ((setq a (assoc s replace))
1856 ((and limit (> n limit)) 1932 (replace-match (concat key (cdr a)) t t))
1857 (replace-match (concat key (int-to-string (+ n delta))) t t)))))))) 1933 ((and limit (> n limit))
1934 (replace-match (concat key (int-to-string (+ n delta)))
1935 t t)))))))))
1858 1936
1859(defun org-table-get-specials () 1937(defun org-table-get-specials ()
1860 "Get the column names and local parameters for this table." 1938 "Get the column names and local parameters for this table."
@@ -2353,9 +2431,13 @@ and TABLE is a vector with line types."
2353 (>= i 0) (< i l) 2431 (>= i 0) (< i l)
2354 (not (eq (aref table i) type)) 2432 (not (eq (aref table i) type))
2355 (if (and relative (eq (aref table i) 'hline)) 2433 (if (and relative (eq (aref table i) 'hline))
2356 (if org-table-error-on-row-ref-crossing-hline 2434 (cond
2357 (error "Row descriptor %s used in line %d crosses hline" desc cline) 2435 ((eq org-table-relative-ref-may-cross-hline t) t)
2358 (progn (setq i (- i (if backwards -1 1)) n 1) nil)) 2436 ((eq org-table-relative-ref-may-cross-hline 'error)
2437 (error "Row descriptor %s used in line %d crosses hline" desc cline))
2438 (t (setq i (- i (if backwards -1 1))
2439 n 1)
2440 nil))
2359 t))) 2441 t)))
2360 (setq n (1- n))) 2442 (setq n (1- n)))
2361 (if (or (< i 0) (>= i l)) 2443 (if (or (< i 0) (>= i l))
@@ -2620,7 +2702,7 @@ Parameters get priority."
2620(defun org-table-edit-formulas () 2702(defun org-table-edit-formulas ()
2621 "Edit the formulas of the current table in a separate buffer." 2703 "Edit the formulas of the current table in a separate buffer."
2622 (interactive) 2704 (interactive)
2623 (when (save-excursion (beginning-of-line 1) (looking-at "#\\+TBLFM")) 2705 (when (save-excursion (beginning-of-line 1) (looking-at "[ \t]*#\\+TBLFM"))
2624 (beginning-of-line 0)) 2706 (beginning-of-line 0))
2625 (unless (org-at-table-p) (error "Not at a table")) 2707 (unless (org-at-table-p) (error "Not at a table"))
2626 (org-table-get-specials) 2708 (org-table-get-specials)
@@ -3387,6 +3469,8 @@ to execute outside of tables."
3387 '("\C-c`" org-table-edit-field) 3469 '("\C-c`" org-table-edit-field)
3388 '("\C-c*" org-table-recalculate) 3470 '("\C-c*" org-table-recalculate)
3389 '("\C-c^" org-table-sort-lines) 3471 '("\C-c^" org-table-sort-lines)
3472 '("\M-a" org-table-beginning-of-field)
3473 '("\M-e" org-table-end-of-field)
3390 '([(control ?#)] org-table-rotate-recalc-marks))) 3474 '([(control ?#)] org-table-rotate-recalc-marks)))
3391 elt key fun cmd) 3475 elt key fun cmd)
3392 (while (setq elt (pop bindings)) 3476 (while (setq elt (pop bindings))
@@ -3411,6 +3495,16 @@ to execute outside of tables."
3411 (orgtbl-make-binding 'org-table-previous-field 104 3495 (orgtbl-make-binding 'org-table-previous-field 104
3412 [(shift tab)] [(tab)] "\C-i")) 3496 [(shift tab)] [(tab)] "\C-i"))
3413 3497
3498 (org-defkey orgtbl-mode-map [S-iso-lefttab]
3499 (orgtbl-make-binding 'org-table-previous-field 107
3500 [S-iso-lefttab] [backtab] [(shift tab)]
3501 [(tab)] "\C-i"))
3502
3503 (org-defkey orgtbl-mode-map [backtab]
3504 (orgtbl-make-binding 'org-table-previous-field 108
3505 [backtab] [S-iso-lefttab] [(shift tab)]
3506 [(tab)] "\C-i"))
3507
3414 (org-defkey orgtbl-mode-map "\M-\C-m" 3508 (org-defkey orgtbl-mode-map "\M-\C-m"
3415 (orgtbl-make-binding 'org-table-wrap-region 105 3509 (orgtbl-make-binding 'org-table-wrap-region 105
3416 "\M-\C-m" [(meta return)])) 3510 "\M-\C-m" [(meta return)]))
@@ -3491,15 +3585,15 @@ to execute outside of tables."
3491 3585
3492(defun orgtbl-ctrl-c-ctrl-c (arg) 3586(defun orgtbl-ctrl-c-ctrl-c (arg)
3493 "If the cursor is inside a table, realign the table. 3587 "If the cursor is inside a table, realign the table.
3494It it is a table to be sent away to a receiver, do it. 3588If it is a table to be sent away to a receiver, do it.
3495With prefix arg, also recompute table." 3589With prefix arg, also recompute table."
3496 (interactive "P") 3590 (interactive "P")
3497 (let ((pos (point)) action) 3591 (let ((pos (point)) action)
3498 (save-excursion 3592 (save-excursion
3499 (beginning-of-line 1) 3593 (beginning-of-line 1)
3500 (setq action (cond ((looking-at "#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) 3594 (setq action (cond ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0))
3501 ((looking-at "[ \t]*|") pos) 3595 ((looking-at "[ \t]*|") pos)
3502 ((looking-at "#\\+TBLFM:") 'recalc)))) 3596 ((looking-at "[ \t]*#\\+TBLFM:") 'recalc))))
3503 (cond 3597 (cond
3504 ((integerp action) 3598 ((integerp action)
3505 (goto-char action) 3599 (goto-char action)
@@ -3557,7 +3651,8 @@ overwritten, and the table is not marked as requiring realignment."
3557 orgtbl-hijacker-command-102 3651 orgtbl-hijacker-command-102
3558 orgtbl-hijacker-command-103 3652 orgtbl-hijacker-command-103
3559 orgtbl-hijacker-command-104 3653 orgtbl-hijacker-command-104
3560 orgtbl-hijacker-command-105)) 3654 orgtbl-hijacker-command-105
3655 yas/expand))
3561 (org-table-blank-field)) 3656 (org-table-blank-field))
3562 t) 3657 t)
3563 (eq N 1) 3658 (eq N 1)
@@ -3568,14 +3663,27 @@ overwritten, and the table is not marked as requiring realignment."
3568 (goto-char (match-beginning 0)) 3663 (goto-char (match-beginning 0))
3569 (self-insert-command N)) 3664 (self-insert-command N))
3570 (setq org-table-may-need-update t) 3665 (setq org-table-may-need-update t)
3571 (let (orgtbl-mode a) 3666 (let* (orgtbl-mode
3572 (call-interactively 3667 a
3573 (or (key-binding 3668 (cmd (or (key-binding
3574 (or (and (listp function-key-map) 3669 (or (and (listp function-key-map)
3575 (setq a (assoc last-input-event function-key-map)) 3670 (setq a (assoc last-input-event function-key-map))
3576 (cdr a)) 3671 (cdr a))
3577 (vector last-input-event))) 3672 (vector last-input-event)))
3578 'self-insert-command))))) 3673 'self-insert-command)))
3674 (call-interactively cmd)
3675 (if (and org-self-insert-cluster-for-undo
3676 (eq cmd 'self-insert-command))
3677 (if (not (eq last-command 'orgtbl-self-insert-command))
3678 (setq org-self-insert-command-undo-counter 1)
3679 (if (>= org-self-insert-command-undo-counter 20)
3680 (setq org-self-insert-command-undo-counter 1)
3681 (and (> org-self-insert-command-undo-counter 0)
3682 buffer-undo-list
3683 (not (cadr buffer-undo-list)) ; remove nil entry
3684 (setcdr buffer-undo-list (cddr buffer-undo-list)))
3685 (setq org-self-insert-command-undo-counter
3686 (1+ org-self-insert-command-undo-counter))))))))
3579 3687
3580(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" 3688(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$"
3581 "Regular expression matching exponentials as produced by calc.") 3689 "Regular expression matching exponentials as produced by calc.")
@@ -3612,7 +3720,7 @@ a radio table."
3612 (goto-char (org-table-begin)) 3720 (goto-char (org-table-begin))
3613 (let (rtn) 3721 (let (rtn)
3614 (beginning-of-line 0) 3722 (beginning-of-line 0)
3615 (while (looking-at "#\\+ORGTBL[: \t][ \t]*SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") 3723 (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
3616 (let ((name (org-no-properties (match-string 1))) 3724 (let ((name (org-no-properties (match-string 1)))
3617 (transform (intern (match-string 2))) 3725 (transform (intern (match-string 2)))
3618 (params (if (match-end 3) 3726 (params (if (match-end 3)
@@ -4106,17 +4214,20 @@ list of the fields in the rectangle ."
4106 org-table-last-column-widths org-table-last-alignment 4214 org-table-last-column-widths org-table-last-alignment
4107 org-table-last-column-widths tbeg 4215 org-table-last-column-widths tbeg
4108 buffer loc) 4216 buffer loc)
4217 (setq form (org-table-convert-refs-to-rc form))
4109 (save-excursion 4218 (save-excursion
4110 (save-restriction 4219 (save-restriction
4111 (widen) 4220 (widen)
4112 (save-excursion 4221 (save-excursion
4113 (goto-char (point-min)) 4222 (goto-char (point-min))
4114 (if (re-search-forward 4223 (if (re-search-forward
4115 (concat "^#\\+TBLNAME:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") 4224 (concat "^#[ \t]*\\+TBLNAME:[ \t]*" (regexp-quote name-or-id) "[ \t]*$")
4116 nil t) 4225 nil t)
4117 (setq buffer (current-buffer) loc (match-beginning 0)) 4226 (setq buffer (current-buffer) loc (match-beginning 0))
4118 (setq id-loc (org-id-find name-or-id 'marker) 4227 (setq id-loc (org-id-find name-or-id 'marker))
4119 buffer (marker-buffer id-loc) 4228 (unless (and id-loc (markerp id-loc))
4229 (error "Can't find remote table \"%s\"" name-or-id))
4230 (setq buffer (marker-buffer id-loc)
4120 loc (marker-position id-loc)) 4231 loc (marker-position id-loc))
4121 (move-marker id-loc nil))) 4232 (move-marker id-loc nil)))
4122 (switch-to-buffer buffer) 4233 (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 @@
5;; Author: Carsten Dominik <carsten at orgmode dot org> 5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org 7;; Homepage: http://orgmode.org
8;; Version: 6.21b 8;; Version: 6.29c
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -29,6 +29,9 @@
29 29
30(require 'org) 30(require 'org)
31 31
32(declare-function org-show-notification "org-clock" (parameters))
33(declare-function org-agenda-error "org-agenda" ())
34
32(defvar org-timer-start-time nil 35(defvar org-timer-start-time nil
33 "t=0 for the running timer.") 36 "t=0 for the running timer.")
34 37
@@ -253,6 +256,74 @@ VALUE can be `on', `off', or `pause'."
253 (concat " <" (substring (org-timer-value-string) 0 -1) ">")) 256 (concat " <" (substring (org-timer-value-string) 0 -1) ">"))
254 (force-mode-line-update))) 257 (force-mode-line-update)))
255 258
259(defvar org-timer-timer1 nil)
260(defvar org-timer-timer2 nil)
261(defvar org-timer-timer3 nil)
262(defvar org-timer-last-timer nil)
263
264(defun org-timer-cancel-timers ()
265 "Reset all timers."
266 (interactive)
267 (mapc (lambda(timer)
268 (when (eval timer)
269 (cancel-timer timer)
270 (setq timer nil)))
271 '(org-timer-timer1
272 org-timer-timer2
273 org-timer-timer3))
274 (message "All timers reset"))
275
276(defun org-timer-show-remaining-time ()
277 "Display the remaining time before the timer ends."
278 (interactive)
279 (require 'time)
280 (if (and (not org-timer-timer1)
281 (not org-timer-timer2)
282 (not org-timer-timer3))
283 (message "No timer set")
284 (let* ((rtime (decode-time
285 (time-subtract (timer--time org-timer-last-timer)
286 (current-time))))
287 (rsecs (nth 0 rtime))
288 (rmins (nth 1 rtime)))
289 (message "%d minutes %d secondes left before next time out"
290 rmins rsecs))))
291
292;;;###autoload
293(defun org-timer-set-timer (minutes)
294 "Set a timer."
295 (interactive "sTime out in (min)? ")
296 (if (not (string-match "[0-9]+" minutes))
297 (org-timer-show-remaining-time)
298 (let* ((mins (string-to-number (match-string 0 minutes)))
299 (secs (* mins 60))
300 (hl (cond
301 ((string-match "Org Agenda" (buffer-name))
302 (let* ((marker (or (get-text-property (point) 'org-marker)
303 (org-agenda-error)))
304 (hdmarker (or (get-text-property (point) 'org-hd-marker)
305 marker))
306 (pos (marker-position marker)))
307 (with-current-buffer (marker-buffer marker)
308 (widen)
309 (goto-char pos)
310 (org-show-entry)
311 (org-get-heading))))
312 ((eq major-mode 'org-mode)
313 (org-get-heading))
314 (t (error "Not in an Org buffer"))))
315 timer-set)
316 (mapcar (lambda(timer)
317 (if (not (or (eval timer) timer-set))
318 (setq timer-set t
319 timer
320 (run-with-timer secs nil 'org-show-notification
321 (format "%s: time out" hl))
322 org-timer-last-timer timer)))
323 '(org-timer-timer1
324 org-timer-timer2
325 org-timer-timer3)))))
326
256(provide 'org-timer) 327(provide 'org-timer)
257 328
258;; arch-tag: 97538f8c-3871-4509-8f23-1e7b3ff3d107 329;; 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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -71,8 +71,9 @@
71 :message-id message-id) 71 :message-id message-id)
72 (setq message-id (org-remove-angle-brackets message-id)) 72 (setq message-id (org-remove-angle-brackets message-id))
73 (setq folder (abbreviate-file-name folder)) 73 (setq folder (abbreviate-file-name folder))
74 (if (string-match (concat "^" (regexp-quote vm-folder-directory)) 74 (if (and vm-folder-directory
75 folder) 75 (string-match (concat "^" (regexp-quote vm-folder-directory))
76 folder))
76 (setq folder (replace-match "" t t folder))) 77 (setq folder (replace-match "" t t folder)))
77 (setq desc (org-email-link-description)) 78 (setq desc (org-email-link-description))
78 (setq link (org-make-link "vm:" folder "#" message-id)) 79 (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 @@
5;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> 5;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org 7;; Homepage: http://orgmode.org
8;; Version: 6.21b 8;; Version: 6.29c
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -93,7 +93,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly."
93 (setq return-content 93 (setq return-content
94 (concat return-content 94 (concat return-content
95 (buffer-substring (point) transform-end)))) 95 (buffer-substring (point) transform-end))))
96 (kill-new return-content) 96 (org-kill-new return-content)
97 (message "Transforming links...done, use C-y to insert text into Org-mode file") 97 (message "Transforming links...done, use C-y to insert text into Org-mode file")
98 (message "Copy with link transformation complete.")))) 98 (message "Copy with link transformation complete."))))
99 99
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 @@
6;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> 6;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
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 @@
1;;; org-xoxo.el --- XOXO export for Org-mode
2
3;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
4;; Free Software Foundation, Inc.
5
6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org
9;; Version: 6.29c
10;;
11;; This file is part of GNU Emacs.
12;;
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;
27;;; Commentary:
28
29(require 'org-exp)
30
31;;; XOXO export
32
33(defun org-export-as-xoxo-insert-into (buffer &rest output)
34 (with-current-buffer buffer
35 (apply 'insert output)))
36(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1)
37
38;;;###autoload
39(defun org-export-as-xoxo (&optional buffer)
40 "Export the org buffer as XOXO.
41The XOXO buffer is named *xoxo-<source buffer name>*"
42 (interactive (list (current-buffer)))
43 ;; A quickie abstraction
44
45 ;; Output everything as XOXO
46 (with-current-buffer (get-buffer buffer)
47 (let* ((pos (point))
48 (opt-plist (org-combine-plists (org-default-export-plist)
49 (org-infile-export-plist)))
50 (filename (concat (file-name-as-directory
51 (org-export-directory :xoxo opt-plist))
52 (file-name-sans-extension
53 (file-name-nondirectory buffer-file-name))
54 ".html"))
55 (out (find-file-noselect filename))
56 (last-level 1)
57 (hanging-li nil))
58 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed.
59 ;; Check the output buffer is empty.
60 (with-current-buffer out (erase-buffer))
61 ;; Kick off the output
62 (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
63 (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't)
64 (let* ((hd (match-string-no-properties 1))
65 (level (length hd))
66 (text (concat
67 (match-string-no-properties 2)
68 (save-excursion
69 (goto-char (match-end 0))
70 (let ((str ""))
71 (catch 'loop
72 (while 't
73 (forward-line)
74 (if (looking-at "^[ \t]\\(.*\\)")
75 (setq str (concat str (match-string-no-properties 1)))
76 (throw 'loop str)))))))))
77
78 ;; Handle level rendering
79 (cond
80 ((> level last-level)
81 (org-export-as-xoxo-insert-into out "\n<ol>\n"))
82
83 ((< level last-level)
84 (dotimes (- (- last-level level) 1)
85 (if hanging-li
86 (org-export-as-xoxo-insert-into out "</li>\n"))
87 (org-export-as-xoxo-insert-into out "</ol>\n"))
88 (when hanging-li
89 (org-export-as-xoxo-insert-into out "</li>\n")
90 (setq hanging-li nil)))
91
92 ((equal level last-level)
93 (if hanging-li
94 (org-export-as-xoxo-insert-into out "</li>\n")))
95 )
96
97 (setq last-level level)
98
99 ;; And output the new li
100 (setq hanging-li 't)
101 (if (equal ?+ (elt text 0))
102 (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>")
103 (org-export-as-xoxo-insert-into out "<li>" text))))
104
105 ;; Finally finish off the ol
106 (dotimes (- last-level 1)
107 (if hanging-li
108 (org-export-as-xoxo-insert-into out "</li>\n"))
109 (org-export-as-xoxo-insert-into out "</ol>\n"))
110
111 (goto-char pos)
112 ;; Finish the buffer off and clean it up.
113 (switch-to-buffer-other-window out)
114 (indent-region (point-min) (point-max) nil)
115 (save-buffer)
116 (goto-char (point-min))
117 )))
118
119(provide 'org-xoxo)
120
121;; arch-tag: 16e6a31f-f4f5-46f1-af18-48dc89faa702
122
123
124;;; 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 @@
6;; Author: Carsten Dominik <carsten at orgmode dot org> 6;; Author: Carsten Dominik <carsten at orgmode dot org>
7;; Keywords: outlines, hypermedia, calendar, wp 7;; Keywords: outlines, hypermedia, calendar, wp
8;; Homepage: http://orgmode.org 8;; Homepage: http://orgmode.org
9;; Version: 6.21b 9;; Version: 6.29c
10;; 10;;
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12;; 12;;
@@ -88,13 +88,14 @@
88(require 'org-compat) 88(require 'org-compat)
89(require 'org-faces) 89(require 'org-faces)
90(require 'org-list) 90(require 'org-list)
91(require 'org-src)
91(require 'org-footnote) 92(require 'org-footnote)
92 93
93;;;; Customization variables 94;;;; Customization variables
94 95
95;;; Version 96;;; Version
96 97
97(defconst org-version "6.21b" 98(defconst org-version "6.29c"
98 "The version number of the file org.el.") 99 "The version number of the file org.el.")
99 100
100(defun org-version (&optional here) 101(defun org-version (&optional here)
@@ -167,36 +168,45 @@ to add the symbol `xyz', and the package must have a call to
167 (const :tag " id: Global IDs for identifying entries" org-id) 168 (const :tag " id: Global IDs for identifying entries" org-id)
168 (const :tag " info: Links to Info nodes" org-info) 169 (const :tag " info: Links to Info nodes" org-info)
169 (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo) 170 (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo)
171 (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask)
170 (const :tag " irc: Links to IRC/ERC chat sessions" org-irc) 172 (const :tag " irc: Links to IRC/ERC chat sessions" org-irc)
171 (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message) 173 (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message)
172 (const :tag " mew Links to Mew folders/messages" org-mew) 174 (const :tag " mew Links to Mew folders/messages" org-mew)
173 (const :tag " mhe: Links to MHE folders/messages" org-mhe) 175 (const :tag " mhe: Links to MHE folders/messages" org-mhe)
176 (const :tag " protocol: Intercept calls from emacsclient" org-protocol)
174 (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) 177 (const :tag " rmail: Links to RMAIL folders/messages" org-rmail)
175 (const :tag " vm: Links to VM folders/messages" org-vm) 178 (const :tag " vm: Links to VM folders/messages" org-vm)
176 (const :tag " wl: Links to Wanderlust folders/messages" org-wl) 179 (const :tag " wl: Links to Wanderlust folders/messages" org-wl)
177 (const :tag " w3m: Special cut/past from w3m to Org." org-w3m) 180 (const :tag " w3m: Special cut/paste from w3m to Org." org-w3m)
178 (const :tag " mouse: Additional mouse support" org-mouse) 181 (const :tag " mouse: Additional mouse support" org-mouse)
179 182
180 (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) 183 (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
181 (const :tag "C annotation-helper: Call Remember directly from Browser" org-annotation-helper) 184 (const :tag "C annotation-helper: Call Remember directly from Browser (OBSOLETE, use org-protocol)" org-annotation-helper)
182 (const :tag "C bookmark: Org links to bookmarks" org-bookmark) 185 (const :tag "C bookmark: Org links to bookmarks" org-bookmark)
183 (const :tag "C browser-url: Store link, directly from Browser" org-browser-url) 186 (const :tag "C browser-url: Store link, directly from Browser (OBSOLETE, use org-protocol)" org-browser-url)
184 (const :tag "C depend: TODO dependencies for Org-mode" org-depend) 187 (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
188 (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
189 (const :tag "C collector: Collect properties into tables" org-collector)
190 (const :tag "C depend: TODO dependencies for Org-mode (PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
185 (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol) 191 (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol)
186 (const :tag "C eval: Include command output as text" org-eval) 192 (const :tag "C eval: Include command output as text" org-eval)
187 (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) 193 (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light)
188 (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry) 194 (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry)
189 (const :tag "C exp-blocks: Pre-process blocks for export" org-exp-blocks) 195 (const :tag "C exp-bibtex: Export citations using BibTeX" org-exp-bibtex)
190 (const :tag "C interactive-query: Interactive modification of tags query" org-interactive-query) 196 (const :tag "C interactive-query: Interactive modification of tags query (PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
197 (const :tag "C jira Add a jira:ticket protocol to Org" org-jira)
191 (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix) 198 (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix)
199 (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
192 (const :tag "C man: Support for links to manpages in Org-mode" org-man) 200 (const :tag "C man: Support for links to manpages in Org-mode" org-man)
193 (const :tag "C mtags: Support for muse-like tags" org-mtags) 201 (const :tag "C mtags: Support for muse-like tags" org-mtags)
194 (const :tag "C panel: Simple routines for us with bad memory" org-panel) 202 (const :tag "C panel: Simple routines for us with bad memory" org-panel)
203 (const :tag "C R: Computation using the R language" org-R)
195 (const :tag "C registry: A registry for Org links" org-registry) 204 (const :tag "C registry: A registry for Org links" org-registry)
196 (const :tag "C org2rem: Convert org appointments into reminders" org2rem) 205 (const :tag "C org2rem: Convert org appointments into reminders" org2rem)
197 (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) 206 (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen)
198 (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) 207 (const :tag "C special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks)
199 (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) 208 (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert)
209 (const :tag "C toc: Table of contents for Org-mode buffer" org-toc)
200 (repeat :tag "External packages" :inline t (symbol :tag "Package")))) 210 (repeat :tag "External packages" :inline t (symbol :tag "Package"))))
201 211
202(defcustom org-support-shift-select nil 212(defcustom org-support-shift-select nil
@@ -268,6 +278,18 @@ uninteresting. Also tables look terrible when wrapped."
268 :group 'org-startup 278 :group 'org-startup
269 :type 'boolean) 279 :type 'boolean)
270 280
281(defcustom org-startup-indented nil
282 "Non-nil means, turn on `org-indent-mode' on startup.
283This can also be configured on a per-file basis by adding one of
284the following lines anywhere in the buffer:
285
286 #+STARTUP: indent
287 #+STARTUP: noindent"
288 :group 'org-structure
289 :type '(choice
290 (const :tag "Not" nil)
291 (const :tag "Globally (slow on startup in large files)" t)))
292
271(defcustom org-startup-align-all-tables nil 293(defcustom org-startup-align-all-tables nil
272 "Non-nil means, align all tables when visiting a file. 294 "Non-nil means, align all tables when visiting a file.
273This is useful when the column width in tables is forced with <N> cookies 295This is useful when the column width in tables is forced with <N> cookies
@@ -292,7 +314,8 @@ has been set."
292(defcustom org-replace-disputed-keys nil 314(defcustom org-replace-disputed-keys nil
293 "Non-nil means use alternative key bindings for some keys. 315 "Non-nil means use alternative key bindings for some keys.
294Org-mode uses S-<cursor> keys for changing timestamps and priorities. 316Org-mode uses S-<cursor> keys for changing timestamps and priorities.
295These keys are also used by other packages like `CUA-mode' or `windmove.el'. 317These keys are also used by other packages like shift-selection-mode'
318\(built into Emacs 23), `CUA-mode' or `windmove.el'.
296If you want to use Org-mode together with one of these other modes, 319If you want to use Org-mode together with one of these other modes,
297or more generally if you would like to move some Org-mode commands to 320or more generally if you would like to move some Org-mode commands to
298other keys, set this variable and configure the keys with the variable 321other 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
543 :tag "Org Cycle" 566 :tag "Org Cycle"
544 :group 'org-structure) 567 :group 'org-structure)
545 568
546(defcustom org-drawers '("PROPERTIES" "CLOCK") 569(defcustom org-cycle-skip-children-state-if-no-children t
570 "Non-nil means, skip CHILDREN state in entries that don't have any."
571 :group 'org-cycle
572 :type 'boolean)
573
574(defcustom org-cycle-max-level nil
575 "Maximum level which should still be subject to visibility cycling.
576Levels higher than this will, for cycling, be treated as text, not a headline.
577When `org-odd-levels-only' is set, a value of N in this variable actually
578means 2N-1 stars as the limiting headline.
579When nil, cycle all levels.
580Note that the limiting level of cycling is also influenced by
581`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but
582`org-inlinetask-min-level' is, cycling will be limited to levels one less
583than its value."
584 :group 'org-cycle
585 :type '(choice
586 (const :tag "No limit" nil)
587 (integer :tag "Maximum level")))
588
589(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK")
547 "Names of drawers. Drawers are not opened by cycling on the headline above. 590 "Names of drawers. Drawers are not opened by cycling on the headline above.
548Drawers only open with a TAB on the drawer line itself. A drawer looks like 591Drawers only open with a TAB on the drawer line itself. A drawer looks like
549this: 592this:
@@ -557,8 +600,19 @@ Drawers can be defined on the per-file basis with a line like:
557 600
558#+DRAWERS: HIDDEN STATE PROPERTIES" 601#+DRAWERS: HIDDEN STATE PROPERTIES"
559 :group 'org-structure 602 :group 'org-structure
603 :group 'org-cycle
560 :type '(repeat (string :tag "Drawer Name"))) 604 :type '(repeat (string :tag "Drawer Name")))
561 605
606(defcustom org-hide-block-startup nil
607 "Non-nil means, , entering Org-mode will fold all blocks.
608This can also be set in on a per-file basis with
609
610#+STARTUP: hideblocks
611#+STARTUP: showblocks"
612 :group 'org-startup
613 :group 'org-cycle
614 :type 'boolean)
615
562(defcustom org-cycle-global-at-bob nil 616(defcustom org-cycle-global-at-bob nil
563 "Cycle globally if cursor is at beginning of buffer and not at a headline. 617 "Cycle globally if cursor is at beginning of buffer and not at a headline.
564This makes it possible to do global cycling without having to use S-TAB or 618This 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."
603 :type 'integer) 657 :type 'integer)
604(put 'org-cycle-separator-lines 'safe-local-variable 'integerp) 658(put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
605 659
660(defcustom org-pre-cycle-hook nil
661 "Hook that is run before visibility cycling is happening.
662The function(s) in this hook must accept a single argument which indicates
663the new state that will be set right after running this hook. The
664argument is a symbol. Before a global state change, it can have the values
665`overview', `content', or `all'. Before a local state change, it can have
666the values `folded', `children', or `subtree'."
667 :group 'org-cycle
668 :type 'hook)
669
606(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees 670(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
607 org-cycle-hide-drawers 671 org-cycle-hide-drawers
608 org-cycle-show-empty-lines 672 org-cycle-show-empty-lines
@@ -638,33 +702,62 @@ lines to the buffer:
638 :type 'boolean) 702 :type 'boolean)
639 703
640(defcustom org-adapt-indentation t 704(defcustom org-adapt-indentation t
641 "Non-nil means, adapt indentation when promoting and demoting. 705 "Non-nil means, adapt indentation to outline node level.
642When this is set and the *entire* text in an entry is indented, the 706
643indentation is increased by one space in a demotion command, and 707When this variable is set, Org assumes that you write outlines by
644decreased by one in a promotion command. If any line in the entry 708indenting text in each node to align with the headline (after the stars).
645body starts at column 0, indentation is not changed at all." 709The following issues are influenced by this variable:
710
711- When this is set and the *entire* text in an entry is indented, the
712 indentation is increased by one space in a demotion command, and
713 decreased by one in a promotion command. If any line in the entry
714 body starts with text at column 0, indentation is not changed at all.
715
716- Property drawers and planning information is inserted indented when
717 this variable s set. When nil, they will not be indented.
718
719- TAB indents a line relative to context. The lines below a headline
720 will be indented when this variable is set.
721
722Note that this is all about true indentation, by adding and removing
723space characters. See also `org-indent.el' which does level-dependent
724indentation in a virtual way, i.e. at display time in Emacs."
646 :group 'org-edit-structure 725 :group 'org-edit-structure
647 :type 'boolean) 726 :type 'boolean)
648 727
649(defcustom org-special-ctrl-a/e nil 728(defcustom org-special-ctrl-a/e nil
650 "Non-nil means `C-a' and `C-e' behave specially in headlines and items. 729 "Non-nil means `C-a' and `C-e' behave specially in headlines and items.
730
651When t, `C-a' will bring back the cursor to the beginning of the 731When t, `C-a' will bring back the cursor to the beginning of the
652headline text, i.e. after the stars and after a possible TODO keyword. 732headline text, i.e. after the stars and after a possible TODO keyword.
653In an item, this will be the position after the bullet. 733In an item, this will be the position after the bullet.
654When the cursor is already at that position, another `C-a' will bring 734When the cursor is already at that position, another `C-a' will bring
655it to the beginning of the line. 735it to the beginning of the line.
736
656`C-e' will jump to the end of the headline, ignoring the presence of tags 737`C-e' will jump to the end of the headline, ignoring the presence of tags
657in the headline. A second `C-e' will then jump to the true end of the 738in the headline. A second `C-e' will then jump to the true end of the
658line, after any tags. 739line, after any tags.
740
659When set to the symbol `reversed', the first `C-a' or `C-e' works normally, 741When set to the symbol `reversed', the first `C-a' or `C-e' works normally,
660and only a directly following, identical keypress will bring the cursor 742going to the true line boundary first. Only a directly following, identical
661to the special positions." 743keypress will bring the cursor to the special positions.
744
745This may also be a cons cell where the behavior for `C-a' and `C-e' is
746set separately."
662 :group 'org-edit-structure 747 :group 'org-edit-structure
663 :type '(choice 748 :type '(choice
664 (const :tag "off" nil) 749 (const :tag "off" nil)
665 (const :tag "after bullet first" t) 750 (const :tag "after stars/bullet and before tags first" t)
666 (const :tag "border first" reversed))) 751 (const :tag "true line boundary first" reversed)
667 752 (cons :tag "Set C-a and C-e separately"
753 (choice :tag "Special C-a"
754 (const :tag "off" nil)
755 (const :tag "after stars/bullet first" t)
756 (const :tag "before stars/bullet first" reversed))
757 (choice :tag "Special C-e"
758 (const :tag "off" nil)
759 (const :tag "before tags first" t)
760 (const :tag "after tags first" reversed)))))
668(if (fboundp 'defvaralias) 761(if (fboundp 'defvaralias)
669 (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) 762 (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e))
670 763
@@ -736,7 +829,9 @@ for the duration of the command."
736 (plain-list-item . auto)) 829 (plain-list-item . auto))
737 "Should `org-insert-heading' leave a blank line before new heading/item? 830 "Should `org-insert-heading' leave a blank line before new heading/item?
738The value is an alist, with `heading' and `plain-list-item' as car, 831The value is an alist, with `heading' and `plain-list-item' as car,
739and a boolean flag as cdr." 832and a boolean flag as cdr. For plain lists, if the variable
833`org-empty-line-terminates-plain-lists' is set, the setting here
834is ignored and no empty line is inserted, to keep the list in tact."
740 :group 'org-edit-structure 835 :group 'org-edit-structure
741 :type '(list 836 :type '(list
742 (cons (const heading) 837 (cons (const heading)
@@ -761,49 +856,6 @@ See also the QUOTE keyword."
761 :group 'org-edit-structure 856 :group 'org-edit-structure
762 :type 'boolean) 857 :type 'boolean)
763 858
764(defcustom org-edit-src-region-extra nil
765 "Additional regexps to identify regions for editing with `org-edit-src-code'.
766For examples see the function `org-edit-src-find-region-and-lang'.
767The regular expression identifying the begin marker should end with a newline,
768and the regexp marking the end line should start with a newline, to make sure
769there are kept outside the narrowed region."
770 :group 'org-edit-structure
771 :type '(repeat
772 (list
773 (regexp :tag "begin regexp")
774 (regexp :tag "end regexp")
775 (choice :tag "language"
776 (string :tag "specify")
777 (integer :tag "from match group")
778 (const :tag "from `lang' element")
779 (const :tag "from `style' element")))))
780
781(defcustom org-coderef-label-format "(ref:%s)"
782 "The default coderef format.
783This format string will be used to search for coderef labels in literal
784examples (EXAMPLE and SRC blocks). The format can be overwritten
785an individual literal example with the -f option, like
786
787#+BEGIN_SRC pascal +n -r -l \"((%s))\"
788...
789#+END_SRC
790
791If you want to use this for HTML export, make sure that the format does
792not introduce special font-locking, and avoid the HTML special
793characters `<', `>', and `&'. The reason for this restriction is that
794the labels are searched for only after htmlize has done its job."
795 :group 'org-edit-structure ; FIXME this is not in the right group
796 :type 'string)
797
798(defcustom org-edit-fixed-width-region-mode 'artist-mode
799 "The mode that should be used to edit fixed-width regions.
800These are the regions where each line starts with a colon."
801 :group 'org-edit-structure
802 :type '(choice
803 (const artist-mode)
804 (const picture-mode)
805 (const fundamental-mode)
806 (function :tag "Other (specify)")))
807 859
808(defcustom org-goto-auto-isearch t 860(defcustom org-goto-auto-isearch t
809 "Non-nil means, typing characters in org-goto starts incremental search." 861 "Non-nil means, typing characters in org-goto starts incremental search."
@@ -849,7 +901,7 @@ as possible."
849 "The maximum level for Imenu access to Org-mode headlines. 901 "The maximum level for Imenu access to Org-mode headlines.
850This also applied for speedbar access." 902This also applied for speedbar access."
851 :group 'org-imenu-and-speedbar 903 :group 'org-imenu-and-speedbar
852 :type 'number) 904 :type 'integer)
853 905
854(defgroup org-table nil 906(defgroup org-table nil
855 "Options concerning tables in Org-mode." 907 "Options concerning tables in Org-mode."
@@ -887,6 +939,14 @@ See also the variable `org-table-auto-blank-field'."
887 (const :tag "on" t) 939 (const :tag "on" t)
888 (const :tag "on, optimized" optimized))) 940 (const :tag "on, optimized" optimized)))
889 941
942(defcustom org-self-insert-cluster-for-undo t
943 "Non-nil means cluster self-insert commands for undo when possible.
944If this is set, then, like in the Emacs command loop, 20 consequtive
945characters will be undone together.
946This is configurable, because there is some impact on typing performance."
947 :group 'org-table
948 :type 'boolean)
949
890(defcustom org-table-tab-recognizes-table.el t 950(defcustom org-table-tab-recognizes-table.el t
891 "Non-nil means, TAB will automatically notice a table.el table. 951 "Non-nil means, TAB will automatically notice a table.el table.
892When it sees such a table, it moves point into it and - if necessary - 952When 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.
912 972
913 [[linkkey:tag][description]] 973 [[linkkey:tag][description]]
914 974
975The 'linkkey' must be a word word, starting with a letter, followed
976by letters, numbers, '-' or '_'.
977
915If REPLACE is a string, the tag will simply be appended to create the link. 978If REPLACE is a string, the tag will simply be appended to create the link.
916If the string contains \"%s\", the tag will be inserted there. Alternatively, 979If the string contains \"%s\", the tag will be inserted there. Alternatively,
917the placeholder \"%h\" will cause a url-encoded version of the tag to 980the 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."
1026 :group 'org-link-store 1089 :group 'org-link-store
1027 :type 'regexp) 1090 :type 'regexp)
1028 1091
1029(defcustom org-link-to-org-use-id 'create-if-interactive 1092(defcustom org-link-to-org-use-id 'create-if-interactive-and-no-custom-id
1030 "Non-nil means, storing a link to an Org file will use entry IDs. 1093 "Non-nil means, storing a link to an Org file will use entry IDs.
1031 1094
1032Note that before this variable is even considered, org-id must be loaded, 1095Note that before this variable is even considered, org-id must be loaded,
1033to please customize `org-modules' and turn it on. 1096so please customize `org-modules' and turn it on.
1034 1097
1035The variable can have the following values: 1098The variable can have the following values:
1036 1099
@@ -1047,6 +1110,10 @@ create-if-interactive
1047 template to an entry not having an ID, create it first by 1110 template to an entry not having an ID, create it first by
1048 explicitly creating a link to it, using `C-c C-l' first. 1111 explicitly creating a link to it, using `C-c C-l' first.
1049 1112
1113create-if-interactive-and-no-custom-id
1114 Like create-if-interactive, but do not create an ID if there is
1115 a CUSTOM_ID property defined in the entry. This is the default.
1116
1050use-existing 1117use-existing
1051 Use existing ID, do not create one. 1118 Use existing ID, do not create one.
1052 1119
@@ -1055,9 +1122,11 @@ nil Never use an ID to make a link, instead link using a text search for
1055 :group 'org-link-store 1122 :group 'org-link-store
1056 :type '(choice 1123 :type '(choice
1057 (const :tag "Create ID to make link" t) 1124 (const :tag "Create ID to make link" t)
1058 (const :tag "Create if string link interactively" 1125 (const :tag "Create if storing link interactively"
1059 'create-if-interactive) 1126 create-if-interactive)
1060 (const :tag "Only use existing" 'use-existing) 1127 (const :tag "Create if storing link interactively and no CUSTOM_ID is present"
1128 create-if-interactive-and-no-custom-id)
1129 (const :tag "Only use existing" use-existing)
1061 (const :tag "Do not use ID to create link" nil))) 1130 (const :tag "Do not use ID to create link" nil)))
1062 1131
1063(defcustom org-context-in-file-links t 1132(defcustom org-context-in-file-links t
@@ -1109,7 +1178,9 @@ links created by planner."
1109 1178
1110(defcustom org-tab-follows-link nil 1179(defcustom org-tab-follows-link nil
1111 "Non-nil means, on links TAB will follow the link. 1180 "Non-nil means, on links TAB will follow the link.
1112Needs to be set before org.el is loaded." 1181Needs to be set before org.el is loaded.
1182This really should not be used, it does not make sense, and the
1183implementation is bad."
1113 :group 'org-link-follow 1184 :group 'org-link-follow
1114 :type 'boolean) 1185 :type 'boolean)
1115 1186
@@ -1186,7 +1257,10 @@ changes to the current buffer."
1186 1257
1187(defcustom org-open-non-existing-files nil 1258(defcustom org-open-non-existing-files nil
1188 "Non-nil means, `org-open-file' will open non-existing files. 1259 "Non-nil means, `org-open-file' will open non-existing files.
1189When nil, an error will be generated." 1260When nil, an error will be generated.
1261This variable applies only to external applications because they
1262might choke on non-existing files. If the link is to a file that
1263will be openend in Emacs, the variable is ignored."
1190 :group 'org-link-follow 1264 :group 'org-link-follow
1191 :type 'boolean) 1265 :type 'boolean)
1192 1266
@@ -1219,7 +1293,7 @@ Shell links can be dangerous: just think about a link
1219This link would show up in your Org-mode document as \"Google Search\", 1293This link would show up in your Org-mode document as \"Google Search\",
1220but really it would remove your entire home directory. 1294but really it would remove your entire home directory.
1221Therefore we advise against setting this variable to nil. 1295Therefore we advise against setting this variable to nil.
1222Just change it to `y-or-n-p' of you want to confirm with a 1296Just change it to `y-or-n-p' if you want to confirm with a
1223single keystroke rather than having to type \"yes\"." 1297single keystroke rather than having to type \"yes\"."
1224 :group 'org-link-follow 1298 :group 'org-link-follow
1225 :type '(choice 1299 :type '(choice
@@ -1236,7 +1310,7 @@ Elisp links can be dangerous: just think about a link
1236This link would show up in your Org-mode document as \"Google Search\", 1310This link would show up in your Org-mode document as \"Google Search\",
1237but really it would remove your entire home directory. 1311but really it would remove your entire home directory.
1238Therefore we advise against setting this variable to nil. 1312Therefore we advise against setting this variable to nil.
1239Just change it to `y-or-n-p' of you want to confirm with a 1313Just change it to `y-or-n-p' if you want to confirm with a
1240single keystroke rather than having to type \"yes\"." 1314single keystroke rather than having to type \"yes\"."
1241 :group 'org-link-follow 1315 :group 'org-link-follow
1242 :type '(choice 1316 :type '(choice
@@ -1324,9 +1398,9 @@ Possible values for the command are:
1324 does define this command, but you can overrule/replace it 1398 does define this command, but you can overrule/replace it
1325 here. 1399 here.
1326 string A command to be executed by a shell; %s will be replaced 1400 string A command to be executed by a shell; %s will be replaced
1327 by the path to the file. 1401 by the path to the file.
1328 sexp A Lisp form which will be evaluated. The file path will 1402 sexp A Lisp form which will be evaluated. The file path will
1329 be available in the Lisp variable `file'. 1403 be available in the Lisp variable `file'.
1330For more examples, see the system specific constants 1404For more examples, see the system specific constants
1331`org-file-apps-defaults-macosx' 1405`org-file-apps-defaults-macosx'
1332`org-file-apps-defaults-windowsnt' 1406`org-file-apps-defaults-windowsnt'
@@ -1355,8 +1429,16 @@ For more examples, see the system specific constants
1355 1429
1356(defcustom org-directory "~/org" 1430(defcustom org-directory "~/org"
1357 "Directory with org files. 1431 "Directory with org files.
1358This directory will be used as default to prompt for org files. 1432This is just a default location to look for Org files. There is no need
1359Used by the hooks for remember.el." 1433at all to put your files into this directory. It is only used in the
1434following situations:
1435
14361. When a remember template specifies a target file that is not an
1437 absolute path. The path will then be interpreted relative to
1438 `org-directory'
14392. When a remember note is filed away in an interactive way (when exiting the
1440 note buffer with `C-1 C-c C-c'. The the user is prompted for an org file,
1441 with `org-directory' as the default path."
1360 :group 'org-refile 1442 :group 'org-refile
1361 :group 'org-remember 1443 :group 'org-remember
1362 :type 'directory) 1444 :type 'directory)
@@ -1390,7 +1472,7 @@ outline-path-completion Headlines in the current buffer are offered via
1390(defcustom org-goto-max-level 5 1472(defcustom org-goto-max-level 5
1391 "Maximum level to be considered when running org-goto with refile interface." 1473 "Maximum level to be considered when running org-goto with refile interface."
1392 :group 'org-refile 1474 :group 'org-refile
1393 :type 'number) 1475 :type 'integer)
1394 1476
1395(defcustom org-reverse-note-order nil 1477(defcustom org-reverse-note-order nil
1396 "Non-nil means, store new notes at the beginning of a file or entry. 1478 "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:
1413 a file name or a list of file names. If you use `org-agenda-files' for 1495 a file name or a list of file names. If you use `org-agenda-files' for
1414 that, all agenda files will be scanned for targets. Nil means, consider 1496 that, all agenda files will be scanned for targets. Nil means, consider
1415 headings in the current buffer. 1497 headings in the current buffer.
1416- A specification of how to select find candidate refile targets. This 1498- A specification of how to find candidate refile targets. This may be
1417 may be any of 1499 any of:
1418 - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. 1500 - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
1419 This tag has to be present in all target headlines, inheritance will 1501 This tag has to be present in all target headlines, inheritance will
1420 not be considered. 1502 not be considered.
@@ -1423,7 +1505,14 @@ This is list of cons cells. Each cell contains:
1423 - a cons cell (:regexp . \"REGEXP\") with a regular expression matching 1505 - a cons cell (:regexp . \"REGEXP\") with a regular expression matching
1424 headlines that are refiling targets. 1506 headlines that are refiling targets.
1425 - a cons cell (:level . N). Any headline of level N is considered a target. 1507 - a cons cell (:level . N). Any headline of level N is considered a target.
1508 Note that, when `org-odd-levels-only' is set, level corresponds to
1509 order in hierarchy, not to the number of stars.
1426 - a cons cell (:maxlevel . N). Any headline with level <= N is a target. 1510 - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
1511 Note that, when `org-odd-levels-only' is set, level corresponds to
1512 order in hierarchy, not to the number of stars.
1513
1514You can set the variable `org-refile-target-verify-function' to a function
1515to verify each headline found by the simple critery above.
1427 1516
1428When this variable is nil, all top-level headlines in the current buffer 1517When this variable is nil, all top-level headlines in the current buffer
1429are used, equivalent to the value `((nil . (:level . 1))'." 1518are used, equivalent to the value `((nil . (:level . 1))'."
@@ -1441,11 +1530,29 @@ are used, equivalent to the value `((nil . (:level . 1))'."
1441 (cons :tag "Level number" (const :value :level) (integer)) 1530 (cons :tag "Level number" (const :value :level) (integer))
1442 (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) 1531 (cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
1443 1532
1533(defcustom org-refile-target-verify-function nil
1534 "Function to verify if the headline at point should be a refile target.
1535The function will be called without arguments, with point at the
1536beginning of the headline. It should return t and leave point
1537where it is if the headline is a valid target for refiling.
1538
1539If the target should not be selected, the function must return nil.
1540In addition to this, it may move point to a place from where the search
1541should be continued. For example, the function may decide that the entire
1542subtree of the current entry should be excluded and move point to the end
1543of the subtree."
1544 :group 'org-refile
1545 :type 'function)
1546
1444(defcustom org-refile-use-outline-path nil 1547(defcustom org-refile-use-outline-path nil
1445 "Non-nil means, provide refile targets as paths. 1548 "Non-nil means, provide refile targets as paths.
1446So a level 3 headline will be available as level1/level2/level3. 1549So a level 3 headline will be available as level1/level2/level3.
1550
1447When the value is `file', also include the file name (without directory) 1551When the value is `file', also include the file name (without directory)
1448into the path. When `full-file-path', include the full file path." 1552into the path. In this case, you can also stop the completion after
1553the file name, to get entries inserted as top level in the file.
1554
1555 When `full-file-path', include the full file path."
1449 :group 'org-refile 1556 :group 'org-refile
1450 :type '(choice 1557 :type '(choice
1451 (const :tag "Not" nil) 1558 (const :tag "Not" nil)
@@ -1465,6 +1572,23 @@ fast, while still showing the whole path to the entry."
1465 :group 'org-refile 1572 :group 'org-refile
1466 :type 'boolean) 1573 :type 'boolean)
1467 1574
1575(defcustom org-refile-allow-creating-parent-nodes nil
1576 "Non-nil means, allow to create new nodes as refile targets.
1577New nodes are then created by adding \"/new node name\" to the completion
1578of an existing node. When the value of this variable is `confirm',
1579new node creation must be confirmed by the user (recommended)
1580When nil, the completion must match an existing entry.
1581
1582Note that, if the new heading is not seen by the criteria
1583listed in `org-refile-targets', multiple instances of the same
1584heading would be created by trying again to file under the new
1585heading."
1586 :group 'org-refile
1587 :type '(choice
1588 (const :tag "Never" nil)
1589 (const :tag "Always" t)
1590 (const :tag "Prompt for confirmation" confirm)))
1591
1468(defgroup org-todo nil 1592(defgroup org-todo nil
1469 "Options concerning TODO items in Org-mode." 1593 "Options concerning TODO items in Org-mode."
1470 :tag "Org TODO" 1594 :tag "Org TODO"
@@ -1475,6 +1599,14 @@ fast, while still showing the whole path to the entry."
1475 :tag "Org Progress" 1599 :tag "Org Progress"
1476 :group 'org-time) 1600 :group 'org-time)
1477 1601
1602(defvar org-todo-interpretation-widgets
1603 '(
1604 (:tag "Sequence (cycling hits every state)" sequence)
1605 (:tag "Type (cycling directly to DONE)" type))
1606 "The available interpretation symbols for customizing
1607 `org-todo-keywords'.
1608 Interested libraries should add to this list.")
1609
1478(defcustom org-todo-keywords '((sequence "TODO" "DONE")) 1610(defcustom org-todo-keywords '((sequence "TODO" "DONE"))
1479 "List of TODO entry keyword sequences and their interpretation. 1611 "List of TODO entry keyword sequences and their interpretation.
1480\\<org-mode-map>This is a list of sequences. 1612\\<org-mode-map>This is a list of sequences.
@@ -1524,8 +1656,18 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'."
1524 (cons 1656 (cons
1525 (choice 1657 (choice
1526 :tag "Interpretation" 1658 :tag "Interpretation"
1527 (const :tag "Sequence (cycling hits every state)" sequence) 1659 ;;Quick and dirty way to see
1528 (const :tag "Type (cycling directly to DONE)" type)) 1660 ;;`org-todo-interpretations'. This takes the
1661 ;;place of item arguments
1662 :convert-widget
1663 (lambda (widget)
1664 (widget-put widget
1665 :args (mapcar
1666 #'(lambda (x)
1667 (widget-convert
1668 (cons 'const x)))
1669 org-todo-interpretation-widgets))
1670 widget))
1529 (repeat 1671 (repeat
1530 (string :tag "Keyword")))))) 1672 (string :tag "Keyword"))))))
1531 1673
@@ -1591,8 +1733,25 @@ by a letter in parenthesis, like TODO(t)."
1591 1733
1592(defcustom org-provide-todo-statistics t 1734(defcustom org-provide-todo-statistics t
1593 "Non-nil means, update todo statistics after insert and toggle. 1735 "Non-nil means, update todo statistics after insert and toggle.
1594When this is set, todo statistics is updated in the parent of the current 1736ALL-HEADLINES means update todo statistics by including headlines
1595entry each time a todo state is changed." 1737with no TODO keyword as well, counting them as not done.
1738A list of TODO keywords means the same, but skip keywords that are
1739not in this list.
1740
1741When this is set, todo statistics is updated in the parent of the
1742current entry each time a todo state is changed."
1743 :group 'org-todo
1744 :type '(choice
1745 (const :tag "Yes, only for TODO entries" t)
1746 (const :tag "Yes, including all entries" 'all-headlines)
1747 (repeat :tag "Yes, for TODOs in this list"
1748 (string :tag "TODO keyword"))
1749 (other :tag "No TODO statistics" nil)))
1750
1751(defcustom org-hierarchical-todo-statistics t
1752 "Non-nil means, TODO statistics covers just direct children.
1753When nil, all entries in the subtree are considered.
1754This has only an effect if `org-provide-todo-statistics' is set."
1596 :group 'org-todo 1755 :group 'org-todo
1597 :type 'boolean) 1756 :type 'boolean)
1598 1757
@@ -1636,6 +1795,8 @@ TODO state changes
1636 "Non-nil means, undone TODO entries will block switching the parent to DONE. 1795 "Non-nil means, undone TODO entries will block switching the parent to DONE.
1637Also, if a parent has an :ORDERED: property, switching an entry to DONE will 1796Also, if a parent has an :ORDERED: property, switching an entry to DONE will
1638be blocked if any prior sibling is not yet done. 1797be blocked if any prior sibling is not yet done.
1798Finally, if the parent is blocked because of ordered siblings of its own,
1799the child will also be blocked.
1639This variable needs to be set before org.el is loaded, and you need to 1800This variable needs to be set before org.el is loaded, and you need to
1640restart Emacs after a change to make the change effective. The only way 1801restart Emacs after a change to make the change effective. The only way
1641to change is while Emacs is running is through the customize interface." 1802to 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."
1643 (set var val) 1804 (set var val)
1644 (if val 1805 (if val
1645 (add-hook 'org-blocker-hook 1806 (add-hook 'org-blocker-hook
1646 'org-block-todo-from-children-or-siblings) 1807 'org-block-todo-from-children-or-siblings-or-parent)
1647 (remove-hook 'org-blocker-hook 1808 (remove-hook 'org-blocker-hook
1648 'org-block-todo-from-children-or-siblings))) 1809 'org-block-todo-from-children-or-siblings-or-parent)))
1649 :group 'org-todo 1810 :group 'org-todo
1650 :type 'boolean) 1811 :type 'boolean)
1651 1812
@@ -1667,6 +1828,22 @@ to change is while Emacs is running is through the customize interface."
1667 :group 'org-todo 1828 :group 'org-todo
1668 :type 'boolean) 1829 :type 'boolean)
1669 1830
1831(defcustom org-treat-insert-todo-heading-as-state-change nil
1832 "Non-nil means, inserting a TODO heading is treated as state change.
1833So when the command \\[org-insert-todo-heading] is used, state change
1834logging will apply if appropriate. When nil, the new TODO item will
1835be inserted directly, and no logging will take place."
1836 :group 'org-todo
1837 :type 'boolean)
1838
1839(defcustom org-treat-S-cursor-todo-selection-as-state-change t
1840 "Non-nil means, switching TODO states with S-cursor counts as state change.
1841This is the default behavior. However, setting this to nil allows a
1842convenient way to select a TODO state and bypass any logging associated
1843with that."
1844 :group 'org-todo
1845 :type 'boolean)
1846
1670(defcustom org-todo-state-tags-triggers nil 1847(defcustom org-todo-state-tags-triggers nil
1671 "Tag changes that should be triggered by TODO state changes. 1848 "Tag changes that should be triggered by TODO state changes.
1672This is a list. Each entry is 1849This is a list. Each entry is
@@ -1737,7 +1914,7 @@ When nil, only the date will be recorded."
1737 1914
1738(defcustom org-log-note-headings 1915(defcustom org-log-note-headings
1739 '((done . "CLOSING NOTE %t") 1916 '((done . "CLOSING NOTE %t")
1740 (state . "State %-12s %t") 1917 (state . "State %-12s from %-12S %t")
1741 (note . "Note taken on %t") 1918 (note . "Note taken on %t")
1742 (clock-out . "")) 1919 (clock-out . ""))
1743 "Headings for notes added to entries. 1920 "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
1746empty string. 1923empty string.
1747%t in the heading will be replaced by a time stamp. 1924%t in the heading will be replaced by a time stamp.
1748%s will be replaced by the new TODO state, in double quotes. 1925%s will be replaced by the new TODO state, in double quotes.
1926%S will be replaced by the old TODO state, in double quotes.
1749%u will be replaced by the user name. 1927%u will be replaced by the user name.
1750%U will be replaced by the full user name." 1928%U will be replaced by the full user name."
1751 :group 'org-todo 1929 :group 'org-todo
@@ -1761,12 +1939,51 @@ empty string.
1761(unless (assq 'note org-log-note-headings) 1939(unless (assq 'note org-log-note-headings)
1762 (push '(note . "%t") org-log-note-headings)) 1940 (push '(note . "%t") org-log-note-headings))
1763 1941
1942(defcustom org-log-into-drawer nil
1943 "Non-nil means, insert state change notes and time stamps into a drawer.
1944When nil, state changes notes will be inserted after the headline and
1945any scheduling and clock lines, but not inside a drawer.
1946
1947The value of this variable should be the name of the drawer to use.
1948LOGBOOK is proposed at the default drawer for this purpose, you can
1949also set this to a string to define the drawer of your choice.
1950
1951A value of t is also allowed, representing \"LOGBOOK\".
1952
1953If this variable is set, `org-log-state-notes-insert-after-drawers'
1954will be ignored.
1955
1956You can set the property LOG_INTO_DRAWER to overrule this setting for
1957a subtree."
1958 :group 'org-todo
1959 :group 'org-progress
1960 :type '(choice
1961 (const :tag "Not into a drawer" nil)
1962 (const :tag "LOGBOOK" t)
1963 (string :tag "Other")))
1964
1965(if (fboundp 'defvaralias)
1966 (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer))
1967
1968(defun org-log-into-drawer ()
1969 "Return the value of `org-log-into-drawer', but let properties overrule.
1970If the current entry has or inherits a LOG_INTO_DRAWER property, it will be
1971used instead of the default value."
1972 (let ((p (ignore-errors (org-entry-get nil "LOG_INTO_DRAWER" 'inherit))))
1973 (cond
1974 ((or (not p) (equal p "nil")) org-log-into-drawer)
1975 ((equal p "t") "LOGBOOK")
1976 (t p))))
1977
1764(defcustom org-log-state-notes-insert-after-drawers nil 1978(defcustom org-log-state-notes-insert-after-drawers nil
1765 "Non-nil means, insert state change notes after any drawers in entry. 1979 "Non-nil means, insert state change notes after any drawers in entry.
1766Only the drawers that *immediately* follow the headline and the 1980Only the drawers that *immediately* follow the headline and the
1767deadline/scheduled line are skipped. 1981deadline/scheduled line are skipped.
1768When nil, insert notes right after the heading and perhaps the line 1982When nil, insert notes right after the heading and perhaps the line
1769with deadline/scheduling if present." 1983with deadline/scheduling if present.
1984
1985This variable will have no effect if `org-log-into-drawer' is
1986set."
1770 :group 'org-todo 1987 :group 'org-todo
1771 :group 'org-progress 1988 :group 'org-progress
1772 :type 'boolean) 1989 :type 'boolean)
@@ -1811,6 +2028,13 @@ property to one or more of these keywords."
1811 :tag "Org Priorities" 2028 :tag "Org Priorities"
1812 :group 'org-todo) 2029 :group 'org-todo)
1813 2030
2031(defcustom org-enable-priority-commands t
2032 "Non-nil means, priority commands are active.
2033When nil, these commands will be disabled, so that you never accidentally
2034set a priority."
2035 :group 'org-priorities
2036 :type 'boolean)
2037
1814(defcustom org-highest-priority ?A 2038(defcustom org-highest-priority ?A
1815 "The highest priority of TODO items. A character like ?A, ?B etc. 2039 "The highest priority of TODO items. A character like ?A, ?B etc.
1816Must have a smaller ASCII number than `org-lowest-priority'." 2040Must 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:
1897 "Custom formats for time stamps. See `format-time-string' for the syntax. 2121 "Custom formats for time stamps. See `format-time-string' for the syntax.
1898These are overlayed over the default ISO format if the variable 2122These are overlayed over the default ISO format if the variable
1899`org-display-custom-times' is set. Time like %H:%M should be at the 2123`org-display-custom-times' is set. Time like %H:%M should be at the
1900end of the second format." 2124end of the second format. The custom formats are also honored by export
2125commands, if custom time display is turned on at the time of export."
1901 :group 'org-time 2126 :group 'org-time
1902 :type 'sexp) 2127 :type 'sexp)
1903 2128
@@ -1919,10 +2144,12 @@ org-mode generates a time duration."
1919 "No. of days before expiration during which a deadline becomes active. 2144 "No. of days before expiration during which a deadline becomes active.
1920This variable governs the display in sparse trees and in the agenda. 2145This variable governs the display in sparse trees and in the agenda.
1921When 0 or negative, it means use this number (the absolute value of it) 2146When 0 or negative, it means use this number (the absolute value of it)
1922even if a deadline has a different individual lead time specified." 2147even if a deadline has a different individual lead time specified.
2148
2149Custom commands can set this variable in the options section."
1923 :group 'org-time 2150 :group 'org-time
1924 :group 'org-agenda-daily/weekly 2151 :group 'org-agenda-daily/weekly
1925 :type 'number) 2152 :type 'integer)
1926 2153
1927(defcustom org-read-date-prefer-future t 2154(defcustom org-read-date-prefer-future t
1928 "Non-nil means, assume future for incomplete date input from user. 2155 "Non-nil means, assume future for incomplete date input from user.
@@ -1959,6 +2186,13 @@ When nil, only the minibuffer will be available."
1959 (defvaralias 'org-popup-calendar-for-date-prompt 2186 (defvaralias 'org-popup-calendar-for-date-prompt
1960 'org-read-date-popup-calendar)) 2187 'org-read-date-popup-calendar))
1961 2188
2189(defcustom org-read-date-minibuffer-setup-hook nil
2190 "Hook to be used to set up keys for the date/time interface.
2191Add key definitions to `minibuffer-local-map', which will be a temporary
2192copy."
2193 :group 'org-time
2194 :type 'hook)
2195
1962(defcustom org-extend-today-until 0 2196(defcustom org-extend-today-until 0
1963 "The hour when your day really ends. Must be an integer. 2197 "The hour when your day really ends. Must be an integer.
1964This has influence for the following applications: 2198This has influence for the following applications:
@@ -1972,7 +2206,7 @@ IMPORTANT: This is a feature whose implementation is and likely will
1972remain incomplete. Really, it is only here because past midnight seems to 2206remain incomplete. Really, it is only here because past midnight seems to
1973be the favorite working time of John Wiegley :-)" 2207be the favorite working time of John Wiegley :-)"
1974 :group 'org-time 2208 :group 'org-time
1975 :type 'number) 2209 :type 'integer)
1976 2210
1977(defcustom org-edit-timestamp-down-means-later nil 2211(defcustom org-edit-timestamp-down-means-later nil
1978 "Non-nil means, S-down will increase the time in a time stamp. 2212 "Non-nil means, S-down will increase the time in a time stamp.
@@ -2006,7 +2240,28 @@ See the manual for details."
2006 (cons (string :tag "Tag name") 2240 (cons (string :tag "Tag name")
2007 (character :tag "Access char")) 2241 (character :tag "Access char"))
2008 (const :tag "Start radio group" (:startgroup)) 2242 (const :tag "Start radio group" (:startgroup))
2009 (const :tag "End radio group" (:endgroup))))) 2243 (const :tag "End radio group" (:endgroup))
2244 (const :tag "New line" (:newline)))))
2245
2246(defcustom org-tag-persistent-alist nil
2247 "List of tags that will always appear in all Org-mode files.
2248This is in addition to any in buffer settings or customizations
2249of `org-tag-alist'.
2250When this list is nil, Org-mode will base TAG input on `org-tag-alist'.
2251The value of this variable is an alist, the car of each entry must be a
2252keyword as a string, the cdr may be a character that is used to select
2253that tag through the fast-tag-selection interface.
2254See the manual for details.
2255To disable these tags on a per-file basis, insert anywhere in the file:
2256 #+STARTUP: noptag"
2257 :group 'org-tags
2258 :type '(repeat
2259 (choice
2260 (cons (string :tag "Tag name")
2261 (character :tag "Access char"))
2262 (const :tag "Start radio group" (:startgroup))
2263 (const :tag "End radio group" (:endgroup))
2264 (const :tag "New line" (:newline)))))
2010 2265
2011(defvar org-file-tags nil 2266(defvar org-file-tags nil
2012 "List of tags that can be inherited by all entries in the file. 2267 "List of tags that can be inherited by all entries in the file.
@@ -2102,23 +2357,35 @@ see the variable `org-use-tag-inheritance'."
2102 (t (error "Invalid setting of `org-use-tag-inheritance'")))) 2357 (t (error "Invalid setting of `org-use-tag-inheritance'"))))
2103 2358
2104(defcustom org-tags-match-list-sublevels t 2359(defcustom org-tags-match-list-sublevels t
2105 "Non-nil means list also sublevels of headlines matching tag search. 2360 "Non-nil means list also sublevels of headlines matching a search.
2361This variable applies to tags/property searches, and also to stuck
2362projects because this search is based on a tags match as well.
2363
2364When set to the symbol `indented', sublevels are indented with
2365leading dots.
2366
2106Because of tag inheritance (see variable `org-use-tag-inheritance'), 2367Because of tag inheritance (see variable `org-use-tag-inheritance'),
2107the sublevels of a headline matching a tag search often also match 2368the sublevels of a headline matching a tag search often also match
2108the same search. Listing all of them can create very long lists. 2369the same search. Listing all of them can create very long lists.
2109Setting this variable to nil causes subtrees of a match to be skipped. 2370Setting this variable to nil causes subtrees of a match to be skipped.
2110This option is off by default, because inheritance in on. If you turn
2111inheritance off, you very likely want to turn this option on.
2112
2113As a special case, if the tag search is restricted to TODO items, the
2114value of this variable is ignored and sublevels are always checked, to
2115make sure all corresponding TODO items find their way into the list.
2116 2371
2117This variable is semi-obsolete and probably should always be true. It 2372This variable is semi-obsolete and probably should always be true. It
2118is better to limit inheritance to certain tags using the variables 2373is better to limit inheritance to certain tags using the variables
2119`org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'." 2374`org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'."
2120 :group 'org-tags 2375 :group 'org-tags
2121 :type 'boolean) 2376 :type '(choice
2377 (const :tag "No, don't list them" nil)
2378 (const :tag "Yes, do list them" t)
2379 (const :tag "List them, indented with leading dots" indented)))
2380
2381(defcustom org-tags-sort-function nil
2382 "When set, tags are sorted using this function as a comparator"
2383 :group 'org-tags
2384 :type '(choice
2385 (const :tag "No sorting" nil)
2386 (const :tag "Alphabetical" string<)
2387 (const :tag "Reverse alphabetical" string>)
2388 (function :tag "Custom function" nil)))
2122 2389
2123(defvar org-tags-history nil 2390(defvar org-tags-history nil
2124 "History of minibuffer reads for tags.") 2391 "History of minibuffer reads for tags.")
@@ -2220,13 +2487,26 @@ Effort estimates given in this property need to have the format H:MM."
2220 :type '(string :tag "Property")) 2487 :type '(string :tag "Property"))
2221 2488
2222(defconst org-global-properties-fixed 2489(defconst org-global-properties-fixed
2223 '(("VISIBILITY_ALL" . "folded children content all")) 2490 '(("VISIBILITY_ALL" . "folded children content all")
2491 ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto"))
2224 "List of property/value pairs that can be inherited by any entry. 2492 "List of property/value pairs that can be inherited by any entry.
2225These are fixed values, for the preset properties.")
2226 2493
2494These are fixed values, for the preset properties. The user variable
2495that can be used to add to this list is `org-global-properties'.
2496
2497The entries in this list are cons cells where the car is a property
2498name and cdr is a string with the value. If the value represents
2499multiple items like an \"_ALL\" property, separate the items by
2500spaces.")
2227 2501
2228(defcustom org-global-properties nil 2502(defcustom org-global-properties nil
2229 "List of property/value pairs that can be inherited by any entry. 2503 "List of property/value pairs that can be inherited by any entry.
2504
2505This list will be combined with the constant `org-global-properties-fixed'.
2506
2507The entries in this list are cons cells where the car is a property
2508name and cdr is a string with the value.
2509
2230You can set buffer-local values for the same purpose in the variable 2510You can set buffer-local values for the same purpose in the variable
2231`org-file-properties' this by adding lines like 2511`org-file-properties' this by adding lines like
2232 2512
@@ -2419,6 +2699,13 @@ Changing this variable requires a restart of Emacs to take effect."
2419 :group 'org-font-lock 2699 :group 'org-font-lock
2420 :type 'boolean) 2700 :type 'boolean)
2421 2701
2702(defcustom org-fontify-whole-heading-line nil
2703 "Non-nil means fontify the whole line for headings.
2704This is useful when setting a background color for the
2705org-leve-* faces."
2706 :group 'org-font-lock
2707 :type 'boolean)
2708
2422(defcustom org-highlight-latex-fragments-and-specials nil 2709(defcustom org-highlight-latex-fragments-and-specials nil
2423 "Non-nil means, fontify what is treated specially by the exporters." 2710 "Non-nil means, fontify what is treated specially by the exporters."
2424 :group 'org-font-lock 2711 :group 'org-font-lock
@@ -2491,7 +2778,7 @@ Changing this variable requires a restart of Emacs to take effect."
2491 "\\([" post "]\\|$\\)"))))) 2778 "\\([" post "]\\|$\\)")))))
2492 2779
2493(defcustom org-emphasis-regexp-components 2780(defcustom org-emphasis-regexp-components
2494 '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1) 2781 '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1)
2495 "Components used to build the regular expression for emphasis. 2782 "Components used to build the regular expression for emphasis.
2496This is a list with 6 entries. Terminology: In an emphasis string 2783This is a list with 6 entries. Terminology: In an emphasis string
2497like \" *strong word* \", we call the initial space PREMATCH, the final 2784like \" *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
2531example *bold*, _underlined_ and /italic/. This variable sets the marker 2818example *bold*, _underlined_ and /italic/. This variable sets the marker
2532characters, the face to be used by font-lock for highlighting in Org-mode 2819characters, the face to be used by font-lock for highlighting in Org-mode
2533Emacs buffers, and the HTML tags to be used for this. 2820Emacs buffers, and the HTML tags to be used for this.
2821For LaTeX export, see the variable `org-export-latex-emphasis-alist'.
2534Use customize to modify this, or restart Emacs after changing it." 2822Use customize to modify this, or restart Emacs after changing it."
2535 :group 'org-font-lock 2823 :group 'org-font-lock
2536 :set 'org-set-emph-re 2824 :set 'org-set-emph-re
@@ -2544,6 +2832,11 @@ Use customize to modify this, or restart Emacs after changing it."
2544 (string :tag "HTML end tag") 2832 (string :tag "HTML end tag")
2545 (option (const verbatim))))) 2833 (option (const verbatim)))))
2546 2834
2835(defvar org-protecting-blocks
2836 '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R")
2837 "Blocks that contain text that is quoted, i.e. not processed as Org syntax.
2838This is needed for font-lock setup.")
2839
2547;;; Miscellaneous options 2840;;; Miscellaneous options
2548 2841
2549(defgroup org-completion nil 2842(defgroup org-completion nil
@@ -2606,7 +2899,8 @@ Normal means, no org-mode-specific context."
2606(declare-function org-agenda-copy-local-variable "org-agenda" (var)) 2899(declare-function org-agenda-copy-local-variable "org-agenda" (var))
2607(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item 2900(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
2608 "org-agenda" (&optional end)) 2901 "org-agenda" (&optional end))
2609 2902(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
2903(declare-function org-indent-mode "org-indent" (arg))
2610(declare-function parse-time-string "parse-time" (string)) 2904(declare-function parse-time-string "parse-time" (string))
2611(declare-function remember "remember" (&optional initial)) 2905(declare-function remember "remember" (&optional initial))
2612(declare-function remember-buffer-desc "remember" ()) 2906(declare-function remember-buffer-desc "remember" ())
@@ -2734,26 +3028,37 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
2734 (while (re-search-forward org-table-any-line-regexp nil t) 3028 (while (re-search-forward org-table-any-line-regexp nil t)
2735 (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) 3029 (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))
2736 (beginning-of-line 1) 3030 (beginning-of-line 1)
2737 (if (looking-at org-table-line-regexp) 3031 (when (looking-at org-table-line-regexp)
2738 (save-excursion (funcall function))) 3032 (save-excursion (funcall function))
3033 (or (looking-at org-table-line-regexp)
3034 (forward-char 1)))
2739 (re-search-forward org-table-any-border-regexp nil 1)))) 3035 (re-search-forward org-table-any-border-regexp nil 1))))
2740 (message "Mapping tables: done")) 3036 (message "Mapping tables: done"))
2741 3037
2742;; Declare and autoload functions from org-exp.el 3038;; Declare and autoload functions from org-exp.el & Co
2743 3039
2744(declare-function org-default-export-plist "org-exp") 3040(declare-function org-default-export-plist "org-exp")
2745(declare-function org-infile-export-plist "org-exp") 3041(declare-function org-infile-export-plist "org-exp")
2746(declare-function org-get-current-options "org-exp") 3042(declare-function org-get-current-options "org-exp")
2747(eval-and-compile 3043(eval-and-compile
2748 (org-autoload "org-exp" 3044 (org-autoload "org-exp"
2749 '(org-export org-export-as-ascii org-export-visible 3045 '(org-export org-export-visible
2750 org-insert-export-options-template org-export-as-html-and-open 3046 org-insert-export-options-template
2751 org-export-as-html-batch org-export-as-html-to-buffer 3047 org-table-clean-before-export))
2752 org-replace-region-by-html org-export-region-as-html 3048 (org-autoload "org-ascii"
2753 org-export-as-html org-export-icalendar-this-file 3049 '(org-export-as-ascii org-export-ascii-preprocess
2754 org-export-icalendar-all-agenda-files 3050 org-export-as-ascii-to-buffer org-replace-region-by-ascii
2755 org-table-clean-before-export 3051 org-export-region-as-ascii))
2756 org-export-icalendar-combine-agenda-files org-export-as-xoxo))) 3052 (org-autoload "org-html"
3053 '(org-export-as-html-and-open
3054 org-export-as-html-batch org-export-as-html-to-buffer
3055 org-replace-region-by-html org-export-region-as-html
3056 org-export-as-html))
3057 (org-autoload "org-icalendar"
3058 '(org-export-icalendar-this-file
3059 org-export-icalendar-all-agenda-files
3060 org-export-icalendar-combine-agenda-files))
3061 (org-autoload "org-xoxo" '(org-export-as-xoxo)))
2757 3062
2758;; Declare and autoload functions from org-agenda.el 3063;; Declare and autoload functions from org-agenda.el
2759 3064
@@ -2780,6 +3085,10 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
2780(defvar org-clock-start-time) 3085(defvar org-clock-start-time)
2781(defvar org-clock-marker (make-marker) 3086(defvar org-clock-marker (make-marker)
2782 "Marker recording the last clock-in.") 3087 "Marker recording the last clock-in.")
3088(defun org-clock-is-active ()
3089 "Return non-nil if clock is currently running.
3090The return value is actually the clock marker."
3091 (marker-buffer org-clock-marker))
2783 3092
2784(eval-and-compile 3093(eval-and-compile
2785 (org-autoload 3094 (org-autoload
@@ -2849,14 +3158,29 @@ If yes, offer to stop it and to save the buffer with the changes."
2849 3158
2850;; Autoload org-timer.el 3159;; Autoload org-timer.el
2851 3160
2852;(declare-function org-timer "org-timer")
2853
2854(eval-and-compile 3161(eval-and-compile
2855 (org-autoload 3162 (org-autoload
2856 "org-timer" 3163 "org-timer"
2857 '(org-timer-start org-timer org-timer-item 3164 '(org-timer-start org-timer org-timer-item
2858 org-timer-change-times-in-region))) 3165 org-timer-change-times-in-region
3166 org-timer-set-timer
3167 org-timer-reset-timers
3168 org-timer-show-remaining-time)))
3169
3170;; Autoload org-feed.el
2859 3171
3172(eval-and-compile
3173 (org-autoload
3174 "org-feed"
3175 '(org-feed-update org-feed-update-all org-feed-goto-inbox)))
3176
3177
3178;; Autoload org-indent.el
3179
3180(eval-and-compile
3181 (org-autoload
3182 "org-indent"
3183 '(org-indent-mode)))
2860 3184
2861;; Autoload archiving code 3185;; Autoload archiving code
2862;; The stuff that is needed for cycling and tags has to be defined here. 3186;; 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."
2935 :group 'org-agenda-skip 3259 :group 'org-agenda-skip
2936 :type 'boolean) 3260 :type 'boolean)
2937 3261
3262(defcustom org-columns-skip-arrchived-trees t
3263 "Non-nil means, irgnore archived trees when creating column view."
3264 :group 'org-archive
3265 :group 'org-properties
3266 :type 'boolean)
3267
2938(defcustom org-cycle-open-archived-trees nil 3268(defcustom org-cycle-open-archived-trees nil
2939 "Non-nil means, `org-cycle' will open archived trees. 3269 "Non-nil means, `org-cycle' will open archived trees.
2940An archived tree is a tree marked with the tag ARCHIVE. 3270An archived tree is a tree marked with the tag ARCHIVE.
@@ -3003,12 +3333,20 @@ collapsed state."
3003;; Autoload ID code 3333;; Autoload ID code
3004 3334
3005(declare-function org-id-store-link "org-id") 3335(declare-function org-id-store-link "org-id")
3336(declare-function org-id-locations-load "org-id")
3337(declare-function org-id-locations-save "org-id")
3338(defvar org-id-track-globally)
3006(org-autoload "org-id" 3339(org-autoload "org-id"
3007 '(org-id-get-create org-id-new org-id-copy org-id-get 3340 '(org-id-get-create org-id-new org-id-copy org-id-get
3008 org-id-get-with-outline-path-completion 3341 org-id-get-with-outline-path-completion
3009 org-id-get-with-outline-drilling 3342 org-id-get-with-outline-drilling
3010 org-id-goto org-id-find org-id-store-link)) 3343 org-id-goto org-id-find org-id-store-link))
3011 3344
3345;; Autoload Plotting Code
3346
3347(org-autoload "org-plot"
3348 '(org-plot/gnuplot))
3349
3012;;; Variables for pre-computed regular expressions, all buffer local 3350;;; Variables for pre-computed regular expressions, all buffer local
3013 3351
3014(defvar org-drawer-regexp nil 3352(defvar org-drawer-regexp nil
@@ -3020,6 +3358,9 @@ collapsed state."
3020(defvar org-not-done-regexp nil 3358(defvar org-not-done-regexp nil
3021 "Matches any of the TODO state keywords except the last one.") 3359 "Matches any of the TODO state keywords except the last one.")
3022(make-variable-buffer-local 'org-not-done-regexp) 3360(make-variable-buffer-local 'org-not-done-regexp)
3361(defvar org-not-done-heading-regexp nil
3362 "Matches a TODO headline that is not done.")
3363(make-variable-buffer-local 'org-not-done-regexp)
3023(defvar org-todo-line-regexp nil 3364(defvar org-todo-line-regexp nil
3024 "Matches a headline and puts TODO state into group 2 if present.") 3365 "Matches a headline and puts TODO state into group 2 if present.")
3025(make-variable-buffer-local 'org-todo-line-regexp) 3366(make-variable-buffer-local 'org-todo-line-regexp)
@@ -3122,6 +3463,8 @@ After a match, the following groups carry important information:
3122 ("nofold" org-startup-folded nil) 3463 ("nofold" org-startup-folded nil)
3123 ("showall" org-startup-folded nil) 3464 ("showall" org-startup-folded nil)
3124 ("content" org-startup-folded content) 3465 ("content" org-startup-folded content)
3466 ("indent" org-startup-indented t)
3467 ("noindent" org-startup-indented nil)
3125 ("hidestars" org-hide-leading-stars t) 3468 ("hidestars" org-hide-leading-stars t)
3126 ("showstars" org-hide-leading-stars nil) 3469 ("showstars" org-hide-leading-stars nil)
3127 ("odd" org-odd-levels-only t) 3470 ("odd" org-odd-levels-only t)
@@ -3144,8 +3487,13 @@ After a match, the following groups carry important information:
3144 ("fnprompt" org-footnote-auto-label nil) 3487 ("fnprompt" org-footnote-auto-label nil)
3145 ("fnconfirm" org-footnote-auto-label confirm) 3488 ("fnconfirm" org-footnote-auto-label confirm)
3146 ("fnplain" org-footnote-auto-label plain) 3489 ("fnplain" org-footnote-auto-label plain)
3490 ("fnadjust" org-footnote-auto-adjust t)
3491 ("nofnadjust" org-footnote-auto-adjust nil)
3147 ("constcgs" constants-unit-system cgs) 3492 ("constcgs" constants-unit-system cgs)
3148 ("constSI" constants-unit-system SI)) 3493 ("constSI" constants-unit-system SI)
3494 ("noptag" org-tag-persistent-alist nil)
3495 ("hideblocks" org-hide-block-startup t)
3496 ("nohideblocks" org-hide-block-startup nil))
3149 "Variable associated with STARTUP options for org-mode. 3497 "Variable associated with STARTUP options for org-mode.
3150Each element is a list of three items: The startup options as written 3498Each element is a list of three items: The startup options as written
3151in the #+STARTUP line, the corresponding variable, and the value to 3499in 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.")
3166 (org-set-local 'org-file-properties nil) 3514 (org-set-local 'org-file-properties nil)
3167 (org-set-local 'org-file-tags nil) 3515 (org-set-local 'org-file-tags nil)
3168 (let ((re (org-make-options-regexp 3516 (let ((re (org-make-options-regexp
3169 '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS" 3517 '("CATEGORY" "TODO" "COLUMNS"
3170 "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" 3518 "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES"
3171 "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE"))) 3519 "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE")
3520 "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)"))
3172 (splitre "[ \t]+") 3521 (splitre "[ \t]+")
3173 kwds kws0 kwsa key log value cat arch tags const links hw dws 3522 kwds kws0 kwsa key log value cat arch tags const links hw dws
3174 tail sep kws1 prio props ftags drawers 3523 tail sep kws1 prio props ftags drawers
@@ -3193,8 +3542,13 @@ means to push this value onto the list in the variable.")
3193 (push (cons 'sequence (org-split-string value splitre)) kwds)) 3542 (push (cons 'sequence (org-split-string value splitre)) kwds))
3194 ((equal key "TYP_TODO") 3543 ((equal key "TYP_TODO")
3195 (push (cons 'type (org-split-string value splitre)) kwds)) 3544 (push (cons 'type (org-split-string value splitre)) kwds))
3545 ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key)
3546 ;; general TODO-like setup
3547 (push (cons (intern (downcase (match-string 1 key)))
3548 (org-split-string value splitre)) kwds))
3196 ((equal key "TAGS") 3549 ((equal key "TAGS")
3197 (setq tags (append tags (org-split-string value splitre)))) 3550 (setq tags (append tags (if tags '("\\n") nil)
3551 (org-split-string value splitre))))
3198 ((equal key "COLUMNS") 3552 ((equal key "COLUMNS")
3199 (org-set-local 'org-columns-default-format value)) 3553 (org-set-local 'org-columns-default-format value))
3200 ((equal key "LINK") 3554 ((equal key "LINK")
@@ -3259,7 +3613,8 @@ means to push this value onto the list in the variable.")
3259 (org-set-local 'org-lowest-priority (nth 1 prio)) 3613 (org-set-local 'org-lowest-priority (nth 1 prio))
3260 (org-set-local 'org-default-priority (nth 2 prio))) 3614 (org-set-local 'org-default-priority (nth 2 prio)))
3261 (and props (org-set-local 'org-file-properties (nreverse props))) 3615 (and props (org-set-local 'org-file-properties (nreverse props)))
3262 (and ftags (org-set-local 'org-file-tags ftags)) 3616 (and ftags (org-set-local 'org-file-tags
3617 (mapcar 'org-add-prop-inherited ftags)))
3263 (and drawers (org-set-local 'org-drawers drawers)) 3618 (and drawers (org-set-local 'org-drawers drawers))
3264 (and arch (org-set-local 'org-archive-location arch)) 3619 (and arch (org-set-local 'org-archive-location arch))
3265 (and links (setq org-link-abbrev-alist-local (nreverse links))) 3620 (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.")
3274 (setq kwds (nreverse kwds)) 3629 (setq kwds (nreverse kwds))
3275 (let (inter kws kw) 3630 (let (inter kws kw)
3276 (while (setq kws (pop kwds)) 3631 (while (setq kws (pop kwds))
3277 (setq inter (pop kws) sep (member "|" kws) 3632 (let ((kws (or
3278 kws0 (delete "|" (copy-sequence kws)) 3633 (run-hook-with-args-until-success
3279 kwsa nil 3634 'org-todo-setup-filter-hook kws)
3280 kws1 (mapcar 3635 kws)))
3281 (lambda (x) 3636 (setq inter (pop kws) sep (member "|" kws)
3282 ;; 1 2 3637 kws0 (delete "|" (copy-sequence kws))
3283 (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) 3638 kwsa nil
3284 (progn 3639 kws1 (mapcar
3285 (setq kw (match-string 1 x) 3640 (lambda (x)
3286 key (and (match-end 2) (match-string 2 x)) 3641 ;; 1 2
3287 log (org-extract-log-state-settings x)) 3642 (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x)
3288 (push (cons kw (and key (string-to-char key))) kwsa) 3643 (progn
3289 (and log (push log org-todo-log-states)) 3644 (setq kw (match-string 1 x)
3290 kw) 3645 key (and (match-end 2) (match-string 2 x))
3291 (error "Invalid TODO keyword %s" x))) 3646 log (org-extract-log-state-settings x))
3292 kws0) 3647 (push (cons kw (and key (string-to-char key))) kwsa)
3293 kwsa (if kwsa (append '((:startgroup)) 3648 (and log (push log org-todo-log-states))
3294 (nreverse kwsa) 3649 kw)
3295 '((:endgroup)))) 3650 (error "Invalid TODO keyword %s" x)))
3296 hw (car kws1) 3651 kws0)
3297 dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) 3652 kwsa (if kwsa (append '((:startgroup))
3298 tail (list inter hw (car dws) (org-last dws))) 3653 (nreverse kwsa)
3654 '((:endgroup))))
3655 hw (car kws1)
3656 dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1))
3657 tail (list inter hw (car dws) (org-last dws))))
3299 (add-to-list 'org-todo-heads hw 'append) 3658 (add-to-list 'org-todo-heads hw 'append)
3300 (push kws1 org-todo-sets) 3659 (push kws1 org-todo-sets)
3301 (setq org-done-keywords (append org-done-keywords dws nil)) 3660 (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.")
3321 (cond 3680 (cond
3322 ((equal e "{") (push '(:startgroup) tgs)) 3681 ((equal e "{") (push '(:startgroup) tgs))
3323 ((equal e "}") (push '(:endgroup) tgs)) 3682 ((equal e "}") (push '(:endgroup) tgs))
3683 ((equal e "\\n") (push '(:newline) tgs))
3324 ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) 3684 ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e)
3325 (push (cons (match-string 1 e) 3685 (push (cons (match-string 1 e)
3326 (string-to-char (match-string 2 e))) 3686 (string-to-char (match-string 2 e)))
@@ -3352,6 +3712,10 @@ means to push this value onto the list in the variable.")
3352 (concat "\\<\\(" 3712 (concat "\\<\\("
3353 (mapconcat 'regexp-quote org-not-done-keywords "\\|") 3713 (mapconcat 'regexp-quote org-not-done-keywords "\\|")
3354 "\\)\\>") 3714 "\\)\\>")
3715 org-not-done-heading-regexp
3716 (concat "^\\(\\*+\\)[ \t]+\\("
3717 (mapconcat 'regexp-quote org-not-done-keywords "\\|")
3718 "\\)\\>")
3355 org-todo-line-regexp 3719 org-todo-line-regexp
3356 (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" 3720 (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
3357 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") 3721 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
@@ -3457,6 +3821,7 @@ Respect keys that are already there."
3457 (cond 3821 (cond
3458 ((equal e '(:startgroup)) (push e new)) 3822 ((equal e '(:startgroup)) (push e new))
3459 ((equal e '(:endgroup)) (push e new)) 3823 ((equal e '(:endgroup)) (push e new))
3824 ((equal e '(:newline)) (push e new))
3460 (t 3825 (t
3461 (setq k (car e) c2 nil) 3826 (setq k (car e) c2 nil)
3462 (if (cdr e) 3827 (if (cdr e)
@@ -3485,10 +3850,8 @@ This is for getting out of special buffers like remember.")
3485;; FIXME: Occasionally check by commenting these, to make sure 3850;; FIXME: Occasionally check by commenting these, to make sure
3486;; no other functions uses these, forgetting to let-bind them. 3851;; no other functions uses these, forgetting to let-bind them.
3487(defvar entry) 3852(defvar entry)
3488(defvar state)
3489(defvar last-state) 3853(defvar last-state)
3490(defvar date) 3854(defvar date)
3491(defvar description)
3492 3855
3493;; Defined somewhere in this file, but used before definition. 3856;; Defined somewhere in this file, but used before definition.
3494(defvar org-html-entities) 3857(defvar org-html-entities)
@@ -3517,6 +3880,8 @@ This variable is set by `org-before-change-function'.
3517 "Mode hook for Org-mode, run after the mode was turned on.") 3880 "Mode hook for Org-mode, run after the mode was turned on.")
3518(defvar org-inhibit-startup nil) ; Dynamically-scoped param. 3881(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
3519(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. 3882(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
3883(defvar org-inhibit-logging nil) ; Dynamically-scoped param.
3884(defvar org-inhibit-blocking nil) ; Dynamically-scoped param.
3520(defvar org-table-buffer-is-an nil) 3885(defvar org-table-buffer-is-an nil)
3521(defconst org-outline-regexp "\\*+ ") 3886(defconst org-outline-regexp "\\*+ ")
3522 3887
@@ -3560,6 +3925,7 @@ The following commands are available:
3560 (org-install-agenda-files-menu) 3925 (org-install-agenda-files-menu)
3561 (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) 3926 (if org-descriptive-links (org-add-to-invisibility-spec '(org-link)))
3562 (org-add-to-invisibility-spec '(org-cwidth)) 3927 (org-add-to-invisibility-spec '(org-cwidth))
3928 (org-add-to-invisibility-spec '(org-hide-block . t))
3563 (when (featurep 'xemacs) 3929 (when (featurep 'xemacs)
3564 (org-set-local 'line-move-ignore-invisible t)) 3930 (org-set-local 'line-move-ignore-invisible t))
3565 (org-set-local 'outline-regexp org-outline-regexp) 3931 (org-set-local 'outline-regexp org-outline-regexp)
@@ -3601,9 +3967,9 @@ The following commands are available:
3601 ;; too late :-( 3967 ;; too late :-(
3602 (if org-enforce-todo-dependencies 3968 (if org-enforce-todo-dependencies
3603 (add-hook 'org-blocker-hook 3969 (add-hook 'org-blocker-hook
3604 'org-block-todo-from-children-or-siblings) 3970 'org-block-todo-from-children-or-siblings-or-parent)
3605 (remove-hook 'org-blocker-hook 3971 (remove-hook 'org-blocker-hook
3606 'org-block-todo-from-children-or-siblings)) 3972 'org-block-todo-from-children-or-siblings-or-parent))
3607 (if org-enforce-todo-checkbox-dependencies 3973 (if org-enforce-todo-checkbox-dependencies
3608 (add-hook 'org-blocker-hook 3974 (add-hook 'org-blocker-hook
3609 'org-block-todo-from-checkboxes) 3975 'org-block-todo-from-checkboxes)
@@ -3645,6 +4011,9 @@ The following commands are available:
3645 (let ((bmp (buffer-modified-p))) 4011 (let ((bmp (buffer-modified-p)))
3646 (org-table-map-tables 'org-table-align) 4012 (org-table-map-tables 'org-table-align)
3647 (set-buffer-modified-p bmp))) 4013 (set-buffer-modified-p bmp)))
4014 (when org-startup-indented
4015 (require 'org-indent)
4016 (org-indent-mode 1))
3648 (org-set-startup-visibility))) 4017 (org-set-startup-visibility)))
3649 4018
3650(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) 4019(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
@@ -3671,9 +4040,6 @@ The following commands are available:
3671(when org-tab-follows-link 4040(when org-tab-follows-link
3672 (org-defkey org-mouse-map [(tab)] 'org-open-at-point) 4041 (org-defkey org-mouse-map [(tab)] 'org-open-at-point)
3673 (org-defkey org-mouse-map "\C-i" 'org-open-at-point)) 4042 (org-defkey org-mouse-map "\C-i" 'org-open-at-point))
3674(when org-return-follows-link
3675 (org-defkey org-mouse-map [(return)] 'org-open-at-point)
3676 (org-defkey org-mouse-map "\C-m" 'org-open-at-point))
3677 4043
3678(require 'font-lock) 4044(require 'font-lock)
3679 4045
@@ -3796,16 +4162,19 @@ The time stamps may be either active or inactive.")
3796 4162
3797(defun org-do-emphasis-faces (limit) 4163(defun org-do-emphasis-faces (limit)
3798 "Run through the buffer and add overlays to links." 4164 "Run through the buffer and add overlays to links."
3799 (let (rtn) 4165 (let (rtn a)
3800 (while (and (not rtn) (re-search-forward org-emph-re limit t)) 4166 (while (and (not rtn) (re-search-forward org-emph-re limit t))
3801 (if (not (= (char-after (match-beginning 3)) 4167 (if (not (= (char-after (match-beginning 3))
3802 (char-after (match-beginning 4)))) 4168 (char-after (match-beginning 4))))
3803 (progn 4169 (progn
3804 (setq rtn t) 4170 (setq rtn t)
4171 (setq a (assoc (match-string 3) org-emphasis-alist))
3805 (font-lock-prepend-text-property (match-beginning 2) (match-end 2) 4172 (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
3806 'face 4173 'face
3807 (nth 1 (assoc (match-string 3) 4174 (nth 1 a))
3808 org-emphasis-alist))) 4175 (and (nth 4 a)
4176 (org-remove-flyspell-overlays-in
4177 (match-beginning 0) (match-end 0)))
3809 (add-text-properties (match-beginning 2) (match-end 2) 4178 (add-text-properties (match-beginning 2) (match-end 2)
3810 '(font-lock-multiline t)) 4179 '(font-lock-multiline t))
3811 (when org-hide-emphasis-markers 4180 (when org-hide-emphasis-markers
@@ -3871,55 +4240,115 @@ will be prompted for."
3871(defconst org-nonsticky-props 4240(defconst org-nonsticky-props
3872 '(mouse-face highlight keymap invisible intangible help-echo org-linked-text)) 4241 '(mouse-face highlight keymap invisible intangible help-echo org-linked-text))
3873 4242
4243(defsubst org-rear-nonsticky-at (pos)
4244 (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
3874 4245
3875(defun org-activate-plain-links (limit) 4246(defun org-activate-plain-links (limit)
3876 "Run through the buffer and add overlays to links." 4247 "Run through the buffer and add overlays to links."
3877 (catch 'exit 4248 (catch 'exit
3878 (let (f) 4249 (let (f)
3879 (while (re-search-forward org-plain-link-re limit t) 4250 (if (re-search-forward org-plain-link-re limit t)
3880 (setq f (get-text-property (match-beginning 0) 'face)) 4251 (progn
3881 (if (or (eq f 'org-tag) 4252 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
3882 (and (listp f) (memq 'org-tag f))) 4253 (setq f (get-text-property (match-beginning 0) 'face))
3883 nil 4254 (if (or (eq f 'org-tag)
3884 (add-text-properties (match-beginning 0) (match-end 0) 4255 (and (listp f) (memq 'org-tag f)))
3885 (list 'mouse-face 'highlight 4256 nil
3886 'rear-nonsticky org-nonsticky-props 4257 (add-text-properties (match-beginning 0) (match-end 0)
3887 'keymap org-mouse-map 4258 (list 'mouse-face 'highlight
3888 )) 4259 'keymap org-mouse-map))
3889 (throw 'exit t)))))) 4260 (org-rear-nonsticky-at (match-end 0)))
4261 t)))))
3890 4262
3891(defun org-activate-code (limit) 4263(defun org-activate-code (limit)
3892 (if (re-search-forward "^[ \t]*\\(: .*\n?\\)" limit t) 4264 (if (re-search-forward "^[ \t]*\\(: .*\n?\\)" limit t)
3893 (progn 4265 (progn
4266 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
3894 (remove-text-properties (match-beginning 0) (match-end 0) 4267 (remove-text-properties (match-beginning 0) (match-end 0)
3895 '(display t invisible t intangible t)) 4268 '(display t invisible t intangible t))
3896 t))) 4269 t)))
3897 4270
4271(defun org-fontify-meta-lines-and-blocks (limit)
4272 "Fontify #+ lines and blocks, in the correct ways."
4273 (let ((case-fold-search t))
4274 (if (re-search-forward
4275 "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\)\\(_\\([a-zA-Z]+\\)\\)?\\)\\(.*\\)\\)"
4276 limit t)
4277 (let ((beg (match-beginning 0))
4278 (beg1 (line-beginning-position 2))
4279 (dc1 (downcase (match-string 2)))
4280 (dc3 (downcase (match-string 3)))
4281 end end1 quoting)
4282 (cond
4283 ((member dc1 '("html:" "ascii:" "latex:" "docbook:"))
4284 ;; a single line of backend-specific content
4285 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
4286 (remove-text-properties (match-beginning 0) (match-end 0)
4287 '(display t invisible t intangible t))
4288 (add-text-properties (match-beginning 1) (match-end 3)
4289 '(font-lock-fontified t face org-meta-line))
4290 (add-text-properties (match-beginning 6) (match-end 6)
4291 '(font-lock-fontified t face org-block))
4292 t)
4293 ((and (match-end 4) (equal dc3 "begin"))
4294 ;; Truely a block
4295 (setq quoting (member (downcase (match-string 5))
4296 org-protecting-blocks))
4297 (when (re-search-forward
4298 (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
4299 nil t) ;; on purpose, we look further than LIMIT
4300 (setq end (match-end 0) end1 (1- (match-beginning 0)))
4301 (when quoting
4302 (remove-text-properties beg end
4303 '(display t invisible t intangible t)))
4304 (add-text-properties
4305 beg end
4306 '(font-lock-fontified t font-lock-multiline t))
4307 (add-text-properties beg beg1 '(face org-meta-line))
4308 (add-text-properties end1 end '(face org-meta-line))
4309 (when quoting
4310 (add-text-properties beg1 end1 '(face org-block)))
4311 t))
4312 ((not (member (char-after beg) '(?\ ?\t)))
4313 ;; just any other in-buffer setting, but not indented
4314 (add-text-properties
4315 beg (match-end 0)
4316 '(font-lock-fontified t face org-meta-line))
4317 t)
4318 ((or (member dc1 '("caption:" "label:" "orgtbl:" "tblfm:" "tblname:"))
4319 (and (match-end 4) (equal dc3 "attr")))
4320 (add-text-properties
4321 beg (match-end 0)
4322 '(font-lock-fontified t face org-meta-line))
4323 t)
4324 (t nil))))))
4325
3898(defun org-activate-angle-links (limit) 4326(defun org-activate-angle-links (limit)
3899 "Run through the buffer and add overlays to links." 4327 "Run through the buffer and add overlays to links."
3900 (if (re-search-forward org-angle-link-re limit t) 4328 (if (re-search-forward org-angle-link-re limit t)
3901 (progn 4329 (progn
4330 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
3902 (add-text-properties (match-beginning 0) (match-end 0) 4331 (add-text-properties (match-beginning 0) (match-end 0)
3903 (list 'mouse-face 'highlight 4332 (list 'mouse-face 'highlight
3904 'rear-nonsticky org-nonsticky-props 4333 'keymap org-mouse-map))
3905 'keymap org-mouse-map 4334 (org-rear-nonsticky-at (match-end 0))
3906 ))
3907 t))) 4335 t)))
3908 4336
3909(defun org-activate-footnote-links (limit) 4337(defun org-activate-footnote-links (limit)
3910 "Run through the buffer and add overlays to links." 4338 "Run through the buffer and add overlays to links."
3911 (if (re-search-forward "\\(^\\|[^][]\\)\\(\\[\\([0-9]+\\]\\|fn:[^ \t\r\n:]+?[]:]\\)\\)" 4339 (if (re-search-forward "\\(^\\|[^][]\\)\\(\\[\\([0-9]+\\]\\|fn:[^ \t\r\n:]+?[]:]\\)\\)"
3912 limit t) 4340 limit t)
3913 (progn 4341 (progn
4342 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
3914 (add-text-properties (match-beginning 2) (match-end 2) 4343 (add-text-properties (match-beginning 2) (match-end 2)
3915 (list 'mouse-face 'highlight 4344 (list 'mouse-face 'highlight
3916 'rear-nonsticky org-nonsticky-props
3917 'keymap org-mouse-map 4345 'keymap org-mouse-map
3918 'help-echo 4346 'help-echo
3919 (if (= (point-at-bol) (match-beginning 2)) 4347 (if (= (point-at-bol) (match-beginning 2))
3920 "Footnote definition" 4348 "Footnote definition"
3921 "Footnote reference") 4349 "Footnote reference")
3922 )) 4350 ))
4351 (org-rear-nonsticky-at (match-end 2))
3923 t))) 4352 t)))
3924 4353
3925(defun org-activate-bracket-links (limit) 4354(defun org-activate-bracket-links (limit)
@@ -3931,34 +4360,41 @@ will be prompted for."
3931 ;; but that requires another match, protecting match data, 4360 ;; but that requires another match, protecting match data,
3932 ;; a lot of overhead for font-lock. 4361 ;; a lot of overhead for font-lock.
3933 (ip (org-maybe-intangible 4362 (ip (org-maybe-intangible
3934 (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props 4363 (list 'invisible 'org-link
3935 'keymap org-mouse-map 'mouse-face 'highlight 4364 'keymap org-mouse-map 'mouse-face 'highlight
3936 'font-lock-multiline t 'help-echo help))) 4365 'font-lock-multiline t 'help-echo help)))
3937 (vp (list 'rear-nonsticky org-nonsticky-props 4366 (vp (list 'keymap org-mouse-map 'mouse-face 'highlight
3938 'keymap org-mouse-map 'mouse-face 'highlight 4367 'font-lock-multiline t 'help-echo help)))
3939 ' font-lock-multiline t 'help-echo help)))
3940 ;; We need to remove the invisible property here. Table narrowing 4368 ;; We need to remove the invisible property here. Table narrowing
3941 ;; may have made some of this invisible. 4369 ;; may have made some of this invisible.
4370 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
3942 (remove-text-properties (match-beginning 0) (match-end 0) 4371 (remove-text-properties (match-beginning 0) (match-end 0)
3943 '(invisible nil)) 4372 '(invisible nil))
3944 (if (match-end 3) 4373 (if (match-end 3)
3945 (progn 4374 (progn
3946 (add-text-properties (match-beginning 0) (match-beginning 3) ip) 4375 (add-text-properties (match-beginning 0) (match-beginning 3) ip)
4376 (org-rear-nonsticky-at (match-beginning 3))
3947 (add-text-properties (match-beginning 3) (match-end 3) vp) 4377 (add-text-properties (match-beginning 3) (match-end 3) vp)
3948 (add-text-properties (match-end 3) (match-end 0) ip)) 4378 (org-rear-nonsticky-at (match-end 3))
4379 (add-text-properties (match-end 3) (match-end 0) ip)
4380 (org-rear-nonsticky-at (match-end 0)))
3949 (add-text-properties (match-beginning 0) (match-beginning 1) ip) 4381 (add-text-properties (match-beginning 0) (match-beginning 1) ip)
4382 (org-rear-nonsticky-at (match-beginning 1))
3950 (add-text-properties (match-beginning 1) (match-end 1) vp) 4383 (add-text-properties (match-beginning 1) (match-end 1) vp)
3951 (add-text-properties (match-end 1) (match-end 0) ip)) 4384 (org-rear-nonsticky-at (match-end 1))
4385 (add-text-properties (match-end 1) (match-end 0) ip)
4386 (org-rear-nonsticky-at (match-end 0)))
3952 t))) 4387 t)))
3953 4388
3954(defun org-activate-dates (limit) 4389(defun org-activate-dates (limit)
3955 "Run through the buffer and add overlays to dates." 4390 "Run through the buffer and add overlays to dates."
3956 (if (re-search-forward org-tsr-regexp-both limit t) 4391 (if (re-search-forward org-tsr-regexp-both limit t)
3957 (progn 4392 (progn
4393 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
3958 (add-text-properties (match-beginning 0) (match-end 0) 4394 (add-text-properties (match-beginning 0) (match-end 0)
3959 (list 'mouse-face 'highlight 4395 (list 'mouse-face 'highlight
3960 'rear-nonsticky org-nonsticky-props
3961 'keymap org-mouse-map)) 4396 'keymap org-mouse-map))
4397 (org-rear-nonsticky-at (match-end 0))
3962 (when org-display-custom-times 4398 (when org-display-custom-times
3963 (if (match-end 3) 4399 (if (match-end 3)
3964 (org-display-custom-time (match-beginning 3) (match-end 3))) 4400 (org-display-custom-time (match-beginning 3) (match-end 3)))
@@ -3981,12 +4417,13 @@ will be prompted for."
3981 (let ((case-fold-search t)) 4417 (let ((case-fold-search t))
3982 (if (re-search-forward org-target-link-regexp limit t) 4418 (if (re-search-forward org-target-link-regexp limit t)
3983 (progn 4419 (progn
4420 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
3984 (add-text-properties (match-beginning 0) (match-end 0) 4421 (add-text-properties (match-beginning 0) (match-end 0)
3985 (list 'mouse-face 'highlight 4422 (list 'mouse-face 'highlight
3986 'rear-nonsticky org-nonsticky-props
3987 'keymap org-mouse-map 4423 'keymap org-mouse-map
3988 'help-echo "Radio target link" 4424 'help-echo "Radio target link"
3989 'org-linked-text t)) 4425 'org-linked-text t))
4426 (org-rear-nonsticky-at (match-end 0))
3990 t))))) 4427 t)))))
3991 4428
3992(defun org-update-radio-target-regexp () 4429(defun org-update-radio-target-regexp ()
@@ -4045,7 +4482,10 @@ will be prompted for."
4045 (regexp-opt 4482 (regexp-opt
4046 (append (mapcar 'car org-html-entities) 4483 (append (mapcar 'car org-html-entities)
4047 (if (boundp 'org-latex-entities) 4484 (if (boundp 'org-latex-entities)
4048 org-latex-entities nil)) 4485 (mapcar (lambda (x)
4486 (or (car-safe x) x))
4487 org-latex-entities)
4488 nil))
4049 'words))) ; FIXME 4489 'words))) ; FIXME
4050 )) 4490 ))
4051 ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) 4491 ;; (list "\\\\\\(?:[a-zA-Z]+\\)")))
@@ -4119,10 +4559,11 @@ between words."
4119(defun org-activate-tags (limit) 4559(defun org-activate-tags (limit)
4120 (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) 4560 (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t)
4121 (progn 4561 (progn
4562 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
4122 (add-text-properties (match-beginning 1) (match-end 1) 4563 (add-text-properties (match-beginning 1) (match-end 1)
4123 (list 'mouse-face 'highlight 4564 (list 'mouse-face 'highlight
4124 'rear-nonsticky org-nonsticky-props
4125 'keymap org-mouse-map)) 4565 'keymap org-mouse-map))
4566 (org-rear-nonsticky-at (match-end 1))
4126 t))) 4567 t)))
4127 4568
4128(defun org-outline-level () 4569(defun org-outline-level ()
@@ -4151,8 +4592,12 @@ between words."
4151 ;; Call the hook 4592 ;; Call the hook
4152 '(org-font-lock-hook) 4593 '(org-font-lock-hook)
4153 ;; Headlines 4594 ;; Headlines
4154 '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1)) 4595 `(,(if org-fontify-whole-heading-line
4155 (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) 4596 "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)"
4597 "^\\(\\**\\)\\(\\* \\)\\(.*\\)")
4598 (1 (org-get-level-face 1))
4599 (2 (org-get-level-face 2))
4600 (3 (org-get-level-face 3)))
4156 ;; Table lines 4601 ;; Table lines
4157 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 4602 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
4158 (1 'org-table t)) 4603 (1 'org-table t))
@@ -4160,6 +4605,7 @@ between words."
4160 '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) 4605 '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
4161 '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) 4606 '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
4162 '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) 4607 '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
4608 '("| *\\(<[lr]?[0-9]*>\\)" (1 'org-formula t))
4163 ;; Drawers 4609 ;; Drawers
4164 (list org-drawer-regexp '(0 'org-special-keyword t)) 4610 (list org-drawer-regexp '(0 'org-special-keyword t))
4165 (list "^[ \t]*:END:" '(0 'org-special-keyword t)) 4611 (list "^[ \t]*:END:" '(0 'org-special-keyword t))
@@ -4167,8 +4613,6 @@ between words."
4167 (list org-property-re 4613 (list org-property-re
4168 '(1 'org-special-keyword t) 4614 '(1 'org-special-keyword t)
4169 '(3 'org-property-value t)) 4615 '(3 'org-property-value t))
4170 (if org-format-transports-properties-p
4171 '("| *\\(<[0-9]+>\\) *" (1 'org-formula t)))
4172 ;; Links 4616 ;; Links
4173 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) 4617 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
4174 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) 4618 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
@@ -4181,7 +4625,7 @@ between words."
4181 '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) 4625 '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
4182 '(org-hide-wide-columns (0 nil append)) 4626 '(org-hide-wide-columns (0 nil append))
4183 ;; TODO lines 4627 ;; TODO lines
4184 (list (concat "^\\*+[ \t]+" org-todo-regexp) 4628 (list (concat "^\\*+[ \t]+" org-todo-regexp "\\([ \t]\\|$\\)")
4185 '(1 (org-get-todo-face 1) t)) 4629 '(1 (org-get-todo-face 1) t))
4186 ;; DONE 4630 ;; DONE
4187 (if org-fontify-done-headline 4631 (if org-fontify-done-headline
@@ -4191,7 +4635,7 @@ between words."
4191 '(2 'org-headline-done t)) 4635 '(2 'org-headline-done t))
4192 nil) 4636 nil)
4193 ;; Priorities 4637 ;; Priorities
4194 (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) 4638 '(org-font-lock-add-priority-faces)
4195 ;; Tags 4639 ;; Tags
4196 '(org-font-lock-add-tag-faces) 4640 '(org-font-lock-add-tag-faces)
4197 ;; Special keywords 4641 ;; Special keywords
@@ -4206,13 +4650,14 @@ between words."
4206 '(org-do-emphasis-faces))) 4650 '(org-do-emphasis-faces)))
4207 ;; Checkboxes 4651 ;; Checkboxes
4208 '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" 4652 '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)"
4209 2 'bold prepend) 4653 2 'org-checkbox prepend)
4210 (if org-provide-checkbox-statistics 4654 (if org-provide-checkbox-statistics
4211 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" 4655 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
4212 (0 (org-get-checkbox-statistics-face) t))) 4656 (0 (org-get-checkbox-statistics-face) t)))
4213 ;; Description list items 4657 ;; Description list items
4214 '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(.*? ::\\)" 4658 '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(.*? ::\\)"
4215 2 'bold prepend) 4659 2 'bold prepend)
4660 ;; ARCHIVEd headings
4216 (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") 4661 (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)")
4217 '(1 'org-archived prepend)) 4662 '(1 'org-archived prepend))
4218 ;; Specials 4663 ;; Specials
@@ -4224,6 +4669,8 @@ between words."
4224 "\\|" org-quote-string "\\)\\>") 4669 "\\|" org-quote-string "\\)\\>")
4225 '(1 'org-special-keyword t)) 4670 '(1 'org-special-keyword t))
4226 '("^#.*" (0 'font-lock-comment-face t)) 4671 '("^#.*" (0 'font-lock-comment-face t))
4672 ;; Blocks and meta lines
4673 '(org-fontify-meta-lines-and-blocks)
4227 ))) 4674 )))
4228 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) 4675 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
4229 ;; Now set the full font-lock-keywords 4676 ;; Now set the full font-lock-keywords
@@ -4232,6 +4679,15 @@ between words."
4232 '(org-font-lock-keywords t nil nil backward-paragraph)) 4679 '(org-font-lock-keywords t nil nil backward-paragraph))
4233 (kill-local-variable 'font-lock-keywords) nil)) 4680 (kill-local-variable 'font-lock-keywords) nil))
4234 4681
4682(defun org-fontify-like-in-org-mode (s &optional odd-levels)
4683 "Fontify string S like in Org-mode"
4684 (with-temp-buffer
4685 (insert s)
4686 (let ((org-odd-levels-only odd-levels))
4687 (org-mode)
4688 (font-lock-fontify-buffer)
4689 (buffer-string))))
4690
4235(defvar org-m nil) 4691(defvar org-m nil)
4236(defvar org-l nil) 4692(defvar org-l nil)
4237(defvar org-f nil) 4693(defvar org-f nil)
@@ -4262,6 +4718,16 @@ If KWD is a number, get the corresponding match group."
4262 'font-lock-fontified t)) 4718 'font-lock-fontified t))
4263 (backward-char 1)))) 4719 (backward-char 1))))
4264 4720
4721(defun org-font-lock-add-priority-faces (limit)
4722 "Add the special priority faces."
4723 (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t)
4724 (add-text-properties
4725 (match-beginning 0) (match-end 0)
4726 (list 'face (or (cdr (assoc (char-after (match-beginning 1))
4727 org-priority-faces))
4728 'org-special-keyword)
4729 'font-lock-fontified t))))
4730
4265(defun org-get-tag-face (kwd) 4731(defun org-get-tag-face (kwd)
4266 "Get the right face for a TODO keyword KWD. 4732 "Get the right face for a TODO keyword KWD.
4267If KWD is a number, get the corresponding match group." 4733If KWD is a number, get the corresponding match group."
@@ -4278,7 +4744,9 @@ If KWD is a number, get the corresponding match group."
4278 deactivate-mark buffer-file-name buffer-file-truename) 4744 deactivate-mark buffer-file-name buffer-file-truename)
4279 (remove-text-properties beg end 4745 (remove-text-properties beg end
4280 '(mouse-face t keymap t org-linked-text t 4746 '(mouse-face t keymap t org-linked-text t
4281 invisible t intangible t)))) 4747 invisible t intangible t
4748 line-prefix t wrap-prefix t
4749 org-no-flyspell t))))
4282 4750
4283;;;; Visibility cycling, including org-goto and indirect buffer 4751;;;; Visibility cycling, including org-goto and indirect buffer
4284 4752
@@ -4290,19 +4758,28 @@ If KWD is a number, get the corresponding match group."
4290(make-variable-buffer-local 'org-cycle-subtree-status) 4758(make-variable-buffer-local 'org-cycle-subtree-status)
4291 4759
4292;;;###autoload 4760;;;###autoload
4761
4762(defvar org-inlinetask-min-level)
4763
4293(defun org-cycle (&optional arg) 4764(defun org-cycle (&optional arg)
4294 "Visibility cycling for Org-mode. 4765 "TAB-action and visibility cycling for Org-mode.
4766
4767This is the command invoked in Org-moe by the TAB key. It's main purpose
4768is outine visibility cycling, but it also invokes other actions
4769in special contexts.
4295 4770
4296- When this function is called with a prefix argument, rotate the entire 4771- When this function is called with a prefix argument, rotate the entire
4297 buffer through 3 states (global cycling) 4772 buffer through 3 states (global cycling)
4298 1. OVERVIEW: Show only top-level headlines. 4773 1. OVERVIEW: Show only top-level headlines.
4299 2. CONTENTS: Show all headlines of all levels, but no body text. 4774 2. CONTENTS: Show all headlines of all levels, but no body text.
4300 3. SHOW ALL: Show everything. 4775 3. SHOW ALL: Show everything.
4301 When called with two C-u C-u prefixes, switch to the startup visibility, 4776 When called with two `C-u C-u' prefixes, switch to the startup visibility,
4302 determined by the variable `org-startup-folded', and by any VISIBILITY 4777 determined by the variable `org-startup-folded', and by any VISIBILITY
4303 properties in the buffer. 4778 properties in the buffer.
4304 When called with three C-u C-u C-u prefixed, show the entire buffer, 4779 When called with three `C-u C-u C-u' prefixed, show the entire buffer,
4305 including drawers. 4780 including any drawers.
4781
4782- When inside a table, re-align the table and move to the next field.
4306 4783
4307- When point is at the beginning of a headline, rotate the subtree started 4784- When point is at the beginning of a headline, rotate the subtree started
4308 by this line through 3 different states (local cycling) 4785 by this line through 3 different states (local cycling)
@@ -4311,6 +4788,7 @@ If KWD is a number, get the corresponding match group."
4311 From this state, you can move to one of the children 4788 From this state, you can move to one of the children
4312 and zoom in further. 4789 and zoom in further.
4313 3. SUBTREE: Show the entire subtree, including body text. 4790 3. SUBTREE: Show the entire subtree, including body text.
4791 If there is no subtree, switch directly from CHILDREN to FOLDED.
4314 4792
4315- When there is a numeric prefix, go up to a heading with level ARG, do 4793- When there is a numeric prefix, go up to a heading with level ARG, do
4316 a `show-subtree' and return to the previous cursor position. If ARG 4794 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."
4325 But only if also the variable `org-cycle-global-at-bob' is t." 4803 But only if also the variable `org-cycle-global-at-bob' is t."
4326 (interactive "P") 4804 (interactive "P")
4327 (org-load-modules-maybe) 4805 (org-load-modules-maybe)
4328 (let* ((outline-regexp 4806 (unless (run-hook-with-args-until-success 'org-tab-first-hook)
4329 (if (and (org-mode-p) org-cycle-include-plain-lists) 4807 (let* ((limit-level
4330 "\\(?:\\*+ \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" 4808 (or org-cycle-max-level
4331 outline-regexp)) 4809 (and (boundp 'org-inlinetask-min-level)
4332 (bob-special (and org-cycle-global-at-bob (bobp) 4810 org-inlinetask-min-level
4333 (not (looking-at outline-regexp)))) 4811 (1- org-inlinetask-min-level))))
4334 (org-cycle-hook 4812 (nstars (and limit-level
4335 (if bob-special 4813 (if org-odd-levels-only
4336 (delq 'org-optimize-window-after-visibility-change 4814 (and limit-level (1- (* limit-level 2)))
4337 (copy-sequence org-cycle-hook)) 4815 limit-level)))
4338 org-cycle-hook)) 4816 (outline-regexp
4339 (pos (point))) 4817 (cond
4340 4818 ((not (org-mode-p)) outline-regexp)
4341 (if (or bob-special (equal arg '(4))) 4819 ((or (eq org-cycle-include-plain-lists 'integrate)
4342 ;; special case: use global cycling 4820 (and org-cycle-include-plain-lists (org-at-item-p)))
4343 (setq arg t)) 4821 (concat "\\(?:\\*"
4822 (if nstars (format "\\{1,%d\\}" nstars) "+")
4823 " \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)"))
4824 (t (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))))
4825 (bob-special (and org-cycle-global-at-bob (bobp)
4826 (not (looking-at outline-regexp))))
4827 (org-cycle-hook
4828 (if bob-special
4829 (delq 'org-optimize-window-after-visibility-change
4830 (copy-sequence org-cycle-hook))
4831 org-cycle-hook))
4832 (pos (point)))
4833
4834 (if (or bob-special (equal arg '(4)))
4835 ;; special case: use global cycling
4836 (setq arg t))
4344 4837
4345 (cond 4838 (cond
4346 4839
4347 ((equal arg '(16)) 4840 ((equal arg '(16))
4348 (org-set-startup-visibility) 4841 (org-set-startup-visibility)
4349 (message "Startup visibility, plus VISIBILITY properties")) 4842 (message "Startup visibility, plus VISIBILITY properties"))
4350 4843
4351 ((equal arg '(64)) 4844 ((equal arg '(64))
4352 (show-all) 4845 (show-all)
4353 (message "Entire buffer visible, including drawers")) 4846 (message "Entire buffer visible, including drawers"))
4354 4847
4355 ((org-at-table-p 'any) 4848 ((org-at-table-p 'any)
4356 ;; Enter the table or move to the next field in the table 4849 ;; Enter the table or move to the next field in the table
4357 (or (org-table-recognize-table.el) 4850 (or (org-table-recognize-table.el)
4358 (progn 4851 (progn
4359 (if arg (org-table-edit-field t) 4852 (if arg (org-table-edit-field t)
4360 (org-table-justify-field-maybe) 4853 (org-table-justify-field-maybe)
4361 (call-interactively 'org-table-next-field))))) 4854 (call-interactively 'org-table-next-field)))))
4855
4856 ((run-hook-with-args-until-success
4857 'org-tab-after-check-for-table-hook))
4858
4859 ((eq arg t) ;; Global cycling
4860 (org-cycle-internal-global))
4861
4862 ((and org-drawers org-drawer-regexp
4863 (save-excursion
4864 (beginning-of-line 1)
4865 (looking-at org-drawer-regexp)))
4866 ;; Toggle block visibility
4867 (org-flag-drawer
4868 (not (get-char-property (match-end 0) 'invisible))))
4869
4870 ((integerp arg)
4871 ;; Show-subtree, ARG levels up from here.
4872 (save-excursion
4873 (org-back-to-heading)
4874 (outline-up-heading (if (< arg 0) (- arg)
4875 (- (funcall outline-level) arg)))
4876 (org-show-subtree)))
4362 4877
4363 ((eq arg t) ;; Global cycling 4878 ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp))
4879 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
4364 4880
4365 (cond 4881 (org-cycle-internal-local))
4366 ((and (eq last-command this-command)
4367 (eq org-cycle-global-status 'overview))
4368 ;; We just created the overview - now do table of contents
4369 ;; This can be slow in very large buffers, so indicate action
4370 (message "CONTENTS...")
4371 (org-content)
4372 (message "CONTENTS...done")
4373 (setq org-cycle-global-status 'contents)
4374 (run-hook-with-args 'org-cycle-hook 'contents))
4375
4376 ((and (eq last-command this-command)
4377 (eq org-cycle-global-status 'contents))
4378 ;; We just showed the table of contents - now show everything
4379 (show-all)
4380 (message "SHOW ALL")
4381 (setq org-cycle-global-status 'all)
4382 (run-hook-with-args 'org-cycle-hook 'all))
4383 4882
4384 (t 4883 ;; TAB emulation and template completion
4385 ;; Default action: go to overview 4884 (buffer-read-only (org-back-to-heading))
4386 (org-overview)
4387 (message "OVERVIEW")
4388 (setq org-cycle-global-status 'overview)
4389 (run-hook-with-args 'org-cycle-hook 'overview))))
4390 4885
4391 ((and org-drawers org-drawer-regexp 4886 ((run-hook-with-args-until-success
4392 (save-excursion 4887 'org-tab-after-check-for-cycling-hook))
4393 (beginning-of-line 1)
4394 (looking-at org-drawer-regexp)))
4395 ;; Toggle block visibility
4396 (org-flag-drawer
4397 (not (get-char-property (match-end 0) 'invisible))))
4398 4888
4399 ((integerp arg) 4889 ((org-try-structure-completion))
4400 ;; Show-subtree, ARG levels up from here.
4401 (save-excursion
4402 (org-back-to-heading)
4403 (outline-up-heading (if (< arg 0) (- arg)
4404 (- (funcall outline-level) arg)))
4405 (org-show-subtree)))
4406 4890
4407 ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) 4891 ((org-try-cdlatex-tab))
4408 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
4409 ;; At a heading: rotate between three different views
4410 (org-back-to-heading)
4411 (let ((goal-column 0) eoh eol eos)
4412 ;; First, some boundaries
4413 (save-excursion
4414 (org-back-to-heading)
4415 (save-excursion
4416 (beginning-of-line 2)
4417 (while (and (not (eobp)) ;; this is like `next-line'
4418 (get-char-property (1- (point)) 'invisible))
4419 (beginning-of-line 2)) (setq eol (point)))
4420 (outline-end-of-heading) (setq eoh (point))
4421 (org-end-of-subtree t)
4422 (unless (eobp)
4423 (skip-chars-forward " \t\n")
4424 (beginning-of-line 1) ; in case this is an item
4425 )
4426 (setq eos (1- (point))))
4427 ;; Find out what to do next and set `this-command'
4428 (cond
4429 ((= eos eoh)
4430 ;; Nothing is hidden behind this heading
4431 (message "EMPTY ENTRY")
4432 (setq org-cycle-subtree-status nil)
4433 (save-excursion
4434 (goto-char eos)
4435 (outline-next-heading)
4436 (if (org-invisible-p) (org-flag-heading nil))))
4437 ((or (>= eol eos)
4438 (not (string-match "\\S-" (buffer-substring eol eos))))
4439 ;; Entire subtree is hidden in one line: open it
4440 (org-show-entry)
4441 (show-children)
4442 (message "CHILDREN")
4443 (save-excursion
4444 (goto-char eos)
4445 (outline-next-heading)
4446 (if (org-invisible-p) (org-flag-heading nil)))
4447 (setq org-cycle-subtree-status 'children)
4448 (run-hook-with-args 'org-cycle-hook 'children))
4449 ((and (eq last-command this-command)
4450 (eq org-cycle-subtree-status 'children))
4451 ;; We just showed the children, now show everything.
4452 (org-show-subtree)
4453 (message "SUBTREE")
4454 (setq org-cycle-subtree-status 'subtree)
4455 (run-hook-with-args 'org-cycle-hook 'subtree))
4456 (t
4457 ;; Default action: hide the subtree.
4458 (hide-subtree)
4459 (message "FOLDED")
4460 (setq org-cycle-subtree-status 'folded)
4461 (run-hook-with-args 'org-cycle-hook 'folded)))))
4462 4892
4463 ;; TAB emulation and template completion 4893 ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
4464 (buffer-read-only (org-back-to-heading)) 4894 (or (not (bolp))
4895 (not (looking-at outline-regexp))))
4896 (call-interactively (global-key-binding "\t")))
4465 4897
4466 ((org-try-structure-completion)) 4898 ((if (and (memq org-cycle-emulate-tab '(white whitestart))
4899 (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
4900 (or (and (eq org-cycle-emulate-tab 'white)
4901 (= (match-end 0) (point-at-eol)))
4902 (and (eq org-cycle-emulate-tab 'whitestart)
4903 (>= (match-end 0) pos))))
4904 t
4905 (eq org-cycle-emulate-tab t))
4906 (call-interactively (global-key-binding "\t")))
4467 4907
4468 ((org-try-cdlatex-tab)) 4908 (t (save-excursion
4909 (org-back-to-heading)
4910 (org-cycle)))))))
4469 4911
4470 ((and (eq org-cycle-emulate-tab 'exc-hl-bol) 4912(defun org-cycle-internal-global ()
4471 (or (not (bolp)) 4913 "Do the global cycling action."
4472 (not (looking-at outline-regexp)))) 4914 (cond
4473 (call-interactively (global-key-binding "\t"))) 4915 ((and (eq last-command this-command)
4474 4916 (eq org-cycle-global-status 'overview))
4475 ((if (and (memq org-cycle-emulate-tab '(white whitestart)) 4917 ;; We just created the overview - now do table of contents
4476 (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) 4918 ;; This can be slow in very large buffers, so indicate action
4477 (or (and (eq org-cycle-emulate-tab 'white) 4919 (run-hook-with-args 'org-pre-cycle-hook 'contents)
4478 (= (match-end 0) (point-at-eol))) 4920 (message "CONTENTS...")
4479 (and (eq org-cycle-emulate-tab 'whitestart) 4921 (org-content)
4480 (>= (match-end 0) pos)))) 4922 (message "CONTENTS...done")
4481 t 4923 (setq org-cycle-global-status 'contents)
4482 (eq org-cycle-emulate-tab t)) 4924 (run-hook-with-args 'org-cycle-hook 'contents))
4483 (call-interactively (global-key-binding "\t"))) 4925
4926 ((and (eq last-command this-command)
4927 (eq org-cycle-global-status 'contents))
4928 ;; We just showed the table of contents - now show everything
4929 (run-hook-with-args 'org-pre-cycle-hook 'all)
4930 (show-all)
4931 (message "SHOW ALL")
4932 (setq org-cycle-global-status 'all)
4933 (run-hook-with-args 'org-cycle-hook 'all))
4484 4934
4485 (t (save-excursion 4935 (t
4486 (org-back-to-heading) 4936 ;; Default action: go to overview
4487 (org-cycle)))))) 4937 (run-hook-with-args 'org-pre-cycle-hook 'overview)
4938 (org-overview)
4939 (message "OVERVIEW")
4940 (setq org-cycle-global-status 'overview)
4941 (run-hook-with-args 'org-cycle-hook 'overview))))
4942
4943(defun org-cycle-internal-local ()
4944 "Do the local cycling action."
4945 (org-back-to-heading)
4946 (let ((goal-column 0) eoh eol eos level has-children children-skipped)
4947 ;; First, some boundaries
4948 (save-excursion
4949 (org-back-to-heading)
4950 (setq level (funcall outline-level))
4951 (save-excursion
4952 (beginning-of-line 2)
4953 (if (or (featurep 'xemacs) (<= emacs-major-version 21))
4954 ; XEmacs does not have `next-single-char-property-change'
4955 ; I'm not sure about Emacs 21.
4956 (while (and (not (eobp)) ;; this is like `next-line'
4957 (get-char-property (1- (point)) 'invisible))
4958 (beginning-of-line 2))
4959 (while (and (not (eobp)) ;; this is like `next-line'
4960 (get-char-property (1- (point)) 'invisible))
4961 (goto-char (next-single-char-property-change (point) 'invisible))
4962;;;??? (or (bolp) (beginning-of-line 2))))
4963 (and (eolp) (beginning-of-line 2))))
4964 (setq eol (point)))
4965 (outline-end-of-heading) (setq eoh (point))
4966 (save-excursion
4967 (outline-next-heading)
4968 (setq has-children (and (org-at-heading-p t)
4969 (> (funcall outline-level) level))))
4970 (org-end-of-subtree t)
4971 (unless (eobp)
4972 (skip-chars-forward " \t\n")
4973 (beginning-of-line 1) ; in case this is an item
4974 )
4975 (setq eos (1- (point))))
4976 ;; Find out what to do next and set `this-command'
4977 (cond
4978 ((= eos eoh)
4979 ;; Nothing is hidden behind this heading
4980 (run-hook-with-args 'org-pre-cycle-hook 'empty)
4981 (message "EMPTY ENTRY")
4982 (setq org-cycle-subtree-status nil)
4983 (save-excursion
4984 (goto-char eos)
4985 (outline-next-heading)
4986 (if (org-invisible-p) (org-flag-heading nil))))
4987 ((and (or (>= eol eos)
4988 (not (string-match "\\S-" (buffer-substring eol eos))))
4989 (or has-children
4990 (not (setq children-skipped
4991 org-cycle-skip-children-state-if-no-children))))
4992 ;; Entire subtree is hidden in one line: children view
4993 (run-hook-with-args 'org-pre-cycle-hook 'children)
4994 (org-show-entry)
4995 (show-children)
4996 (message "CHILDREN")
4997 (save-excursion
4998 (goto-char eos)
4999 (outline-next-heading)
5000 (if (org-invisible-p) (org-flag-heading nil)))
5001 (setq org-cycle-subtree-status 'children)
5002 (run-hook-with-args 'org-cycle-hook 'children))
5003 ((or children-skipped
5004 (and (eq last-command this-command)
5005 (eq org-cycle-subtree-status 'children)))
5006 ;; We just showed the children, or no children are there,
5007 ;; now show everything.
5008 (run-hook-with-args 'org-pre-cycle-hook 'subtree)
5009 (org-show-subtree)
5010 (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
5011 (setq org-cycle-subtree-status 'subtree)
5012 (run-hook-with-args 'org-cycle-hook 'subtree))
5013 (t
5014 ;; Default action: hide the subtree.
5015 (run-hook-with-args 'org-pre-cycle-hook 'folded)
5016 (hide-subtree)
5017 (message "FOLDED")
5018 (setq org-cycle-subtree-status 'folded)
5019 (run-hook-with-args 'org-cycle-hook 'folded)))))
4488 5020
4489;;;###autoload 5021;;;###autoload
4490(defun org-global-cycle (&optional arg) 5022(defun org-global-cycle (&optional arg)
@@ -4513,6 +5045,7 @@ With a numeric prefix, show all headlines up to that level."
4513 ((eq org-startup-folded 'content) 5045 ((eq org-startup-folded 'content)
4514 (let ((this-command 'org-cycle) (last-command 'org-cycle)) 5046 (let ((this-command 'org-cycle) (last-command 'org-cycle))
4515 (org-cycle '(4)) (org-cycle '(4))))) 5047 (org-cycle '(4)) (org-cycle '(4)))))
5048 (if org-hide-block-startup (org-hide-block-all))
4516 (org-set-visibility-according-to-property 'no-cleanup) 5049 (org-set-visibility-according-to-property 'no-cleanup)
4517 (org-cycle-hide-archived-subtrees 'all) 5050 (org-cycle-hide-archived-subtrees 'all)
4518 (org-cycle-hide-drawers 'all) 5051 (org-cycle-hide-drawers 'all)
@@ -4590,14 +5123,13 @@ With numerical argument N, show content up to level N."
4590This function is the default value of the hook `org-cycle-hook'." 5123This function is the default value of the hook `org-cycle-hook'."
4591 (when (get-buffer-window (current-buffer)) 5124 (when (get-buffer-window (current-buffer))
4592 (cond 5125 (cond
4593; ((eq state 'overview) (org-first-headline-recenter 1))
4594; ((eq state 'overview) (org-beginning-of-line))
4595 ((eq state 'content) nil) 5126 ((eq state 'content) nil)
4596 ((eq state 'all) nil) 5127 ((eq state 'all) nil)
4597 ((eq state 'folded) nil) 5128 ((eq state 'folded) nil)
4598 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) 5129 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
4599 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) 5130 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
4600 5131
5132;; FIXME: no longer in use
4601(defun org-compact-display-after-subtree-move () 5133(defun org-compact-display-after-subtree-move ()
4602 "Show a compacter version of the tree of the entry's parent." 5134 "Show a compacter version of the tree of the entry's parent."
4603 (save-excursion 5135 (save-excursion
@@ -4610,6 +5142,45 @@ This function is the default value of the hook `org-cycle-hook'."
4610 (org-cycle-hide-drawers 'children)) 5142 (org-cycle-hide-drawers 'children))
4611 (org-overview)))) 5143 (org-overview))))
4612 5144
5145(defun org-remove-empty-overlays-at (pos)
5146 "Remove outline overlays that do not contain non-white stuff."
5147 (mapc
5148 (lambda (o)
5149 (and (eq 'outline (org-overlay-get o 'invisible))
5150 (not (string-match "\\S-" (buffer-substring (org-overlay-start o)
5151 (org-overlay-end o))))
5152 (org-delete-overlay o)))
5153 (org-overlays-at pos)))
5154
5155(defun org-clean-visibility-after-subtree-move ()
5156 "Fix visibility issues after moving a subtree."
5157 ;; First, find a reasonable region to look at:
5158 ;; Start two siblings above, end three below
5159 (let* ((beg (save-excursion
5160 (and (outline-get-last-sibling)
5161 (outline-get-last-sibling))
5162 (point)))
5163 (end (save-excursion
5164 (and (outline-get-next-sibling)
5165 (outline-get-next-sibling)
5166 (outline-get-next-sibling))
5167 (if (org-at-heading-p)
5168 (point-at-eol)
5169 (point))))
5170 (level (looking-at "\\*+"))
5171 (re (if level (concat "^" (regexp-quote (match-string 0)) " "))))
5172 (save-excursion
5173 (save-restriction
5174 (narrow-to-region beg end)
5175 (when re
5176 ;; Properly fold already folded siblings
5177 (goto-char (point-min))
5178 (while (re-search-forward re nil t)
5179 (if (save-excursion (goto-char (point-at-eol)) (org-invisible-p))
5180 (hide-entry))))
5181 (org-cycle-show-empty-lines 'overview)
5182 (org-cycle-hide-drawers 'overview)))))
5183
4613(defun org-cycle-show-empty-lines (state) 5184(defun org-cycle-show-empty-lines (state)
4614 "Show empty lines above all visible headlines. 5185 "Show empty lines above all visible headlines.
4615The region to be covered depends on STATE when called through 5186The 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."
4657(defun org-cycle-hide-drawers (state) 5228(defun org-cycle-hide-drawers (state)
4658 "Re-hide all drawers after a visibility state change." 5229 "Re-hide all drawers after a visibility state change."
4659 (when (and (org-mode-p) 5230 (when (and (org-mode-p)
4660 (not (memq state '(overview folded)))) 5231 (not (memq state '(overview folded contents))))
4661 (save-excursion 5232 (save-excursion
4662 (let* ((globalp (memq state '(contents all))) 5233 (let* ((globalp (memq state '(contents all)))
4663 (beg (if globalp (point-min) (point))) 5234 (beg (if globalp (point-min) (point)))
4664 (end (if globalp (point-max) (org-end-of-subtree t)))) 5235 (end (if globalp (point-max)
5236 (if (eq state 'children)
5237 (save-excursion (outline-next-heading) (point))
5238 (org-end-of-subtree t)))))
4665 (goto-char beg) 5239 (goto-char beg)
4666 (while (re-search-forward org-drawer-regexp end t) 5240 (while (re-search-forward org-drawer-regexp end t)
4667 (org-flag-drawer t)))))) 5241 (org-flag-drawer t))))))
@@ -4691,6 +5265,91 @@ Optional argument N means, put the headline into the Nth line of the window."
4691 (beginning-of-line) 5265 (beginning-of-line)
4692 (recenter (prefix-numeric-value N)))) 5266 (recenter (prefix-numeric-value N))))
4693 5267
5268;;; Folding of blocks
5269
5270(defconst org-block-regexp
5271
5272 "^[ \t]*#\\+begin_\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_\\1[ \t]*$"
5273 "Regular expression for hiding blocks.")
5274
5275(defvar org-hide-block-overlays nil
5276 "Overays hiding blocks.")
5277(make-variable-buffer-local 'org-hide-block-overlays)
5278
5279(defun org-block-map (function &optional start end)
5280 "Call func at the head of all source blocks in the current
5281buffer. Optional arguments START and END can be used to limit
5282the range."
5283 (let ((start (or start (point-min)))
5284 (end (or end (point-max))))
5285 (save-excursion
5286 (goto-char start)
5287 (while (and (< (point) end) (re-search-forward org-block-regexp end t))
5288 (save-excursion
5289 (save-match-data
5290 (goto-char (match-beginning 0))
5291 (funcall function)))))))
5292
5293(defun org-hide-block-toggle-all ()
5294 "Toggle the visibility of all blocks in the current buffer."
5295 (org-block-map #'org-hide-block-toggle))
5296
5297(defun org-hide-block-all ()
5298 "Fold all blocks in the current buffer."
5299 (interactive)
5300 (org-show-block-all)
5301 (org-block-map #'org-hide-block-toggle-maybe))
5302
5303(defun org-show-block-all ()
5304 "Unfold all blocks in the current buffer."
5305 (mapc 'org-delete-overlay org-hide-block-overlays)
5306 (setq org-hide-block-overlays nil))
5307
5308(defun org-hide-block-toggle-maybe ()
5309 "Toggle visibility of block at point."
5310 (interactive)
5311 (let ((case-fold-search t))
5312 (if (save-excursion
5313 (beginning-of-line 1)
5314 (looking-at org-block-regexp))
5315 (progn (org-hide-block-toggle)
5316 t) ;; to signal that we took action
5317 nil))) ;; to signal that we did not
5318
5319(defun org-hide-block-toggle (&optional force)
5320 "Toggle the visibility of the current block."
5321 (interactive)
5322 (save-excursion
5323 (beginning-of-line)
5324 (if (re-search-forward org-block-regexp nil t)
5325 (let ((start (- (match-beginning 4) 1)) ;; beginning of body
5326 (end (match-end 0))
5327 ov) ;; end of entire body
5328 (if (memq t (mapcar (lambda (overlay)
5329 (eq (org-overlay-get overlay 'invisible)
5330 'org-hide-block))
5331 (org-overlays-at start)))
5332 (if (or (not force) (eq force 'off))
5333 (mapc (lambda (ov)
5334 (when (member ov org-hide-block-overlays)
5335 (setq org-hide-block-overlays
5336 (delq ov org-hide-block-overlays)))
5337 (when (eq (org-overlay-get ov 'invisible)
5338 'org-hide-block)
5339 (org-delete-overlay ov)))
5340 (org-overlays-at start)))
5341 (setq ov (org-make-overlay start end))
5342 (org-overlay-put ov 'invisible 'org-hide-block)
5343 (push ov org-hide-block-overlays)))
5344 (error "Not looking at a source block"))))
5345
5346;; org-tab-after-check-for-cycling-hook
5347(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe)
5348;; Remove overlays when changing major mode
5349(add-hook 'org-mode-hook
5350 (lambda () (org-add-hook 'change-major-mode-hook
5351 'org-show-block-all 'append 'local)))
5352
4694;;; Org-goto 5353;;; Org-goto
4695 5354
4696(defvar org-goto-window-configuration nil) 5355(defvar org-goto-window-configuration nil)
@@ -4754,6 +5413,7 @@ the headline hierarchy above."
4754 (interactive "P") 5413 (interactive "P")
4755 (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) 5414 (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
4756 (org-refile-use-outline-path t) 5415 (org-refile-use-outline-path t)
5416 (org-refile-target-verify-function nil)
4757 (interface 5417 (interface
4758 (if (not alternative-interface) 5418 (if (not alternative-interface)
4759 org-goto-interface 5419 org-goto-interface
@@ -4973,7 +5633,7 @@ frame is not changed."
4973 (or (beginning-of-line 0) t) 5633 (or (beginning-of-line 0) t)
4974 (save-match-data 5634 (save-match-data
4975 (looking-at "[ \t]*$"))))) 5635 (looking-at "[ \t]*$")))))
4976 5636
4977(defun org-insert-heading (&optional force-heading) 5637(defun org-insert-heading (&optional force-heading)
4978 "Insert a new heading or item with same depth at point. 5638 "Insert a new heading or item with same depth at point.
4979If point is in a plain list and FORCE-HEADING is nil, create a new list item. 5639If 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:
5089 (org-match-string-no-properties 4) 5749 (org-match-string-no-properties 4)
5090 (org-match-string-no-properties 5))))) 5750 (org-match-string-no-properties 5)))))
5091 5751
5752(defun org-get-entry ()
5753 "Get the entry text, after heading, entire subtree."
5754 (save-excursion
5755 (org-back-to-heading t)
5756 (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
5757
5092(defun org-insert-heading-after-current () 5758(defun org-insert-heading-after-current ()
5093 "Insert a new heading with same level as current, after current subtree." 5759 "Insert a new heading with same level as current, after current subtree."
5094 (interactive) 5760 (interactive)
@@ -5118,11 +5784,23 @@ state (TODO by default). Also with prefix arg, force first state."
5118 (org-back-to-heading) 5784 (org-back-to-heading)
5119 (outline-previous-heading) 5785 (outline-previous-heading)
5120 (looking-at org-todo-line-regexp)) 5786 (looking-at org-todo-line-regexp))
5121 (if (or arg 5787 (let*
5122 (not (match-beginning 2)) 5788 ((new-mark-x
5123 (member (match-string 2) org-done-keywords)) 5789 (if (or arg
5124 (insert (car org-todo-keywords-1) " ") 5790 (not (match-beginning 2))
5125 (insert (match-string 2) " ")) 5791 (member (match-string 2) org-done-keywords))
5792 (car org-todo-keywords-1)
5793 (match-string 2)))
5794 (new-mark
5795 (or
5796 (run-hook-with-args-until-success
5797 'org-todo-get-default-hook new-mark-x nil)
5798 new-mark-x)))
5799 (beginning-of-line 1)
5800 (and (looking-at "\\*+ ") (goto-char (match-end 0))
5801 (if org-treat-insert-todo-heading-as-state-change
5802 (org-todo new-mark)
5803 (insert new-mark " "))))
5126 (when org-provide-todo-statistics 5804 (when org-provide-todo-statistics
5127 (org-update-parent-todo-statistics)))) 5805 (org-update-parent-todo-statistics))))
5128 5806
@@ -5146,6 +5824,16 @@ Works for outline headings and for plain lists alike."
5146 5824
5147;;; Promotion and Demotion 5825;;; Promotion and Demotion
5148 5826
5827(defvar org-after-demote-entry-hook nil
5828 "Hook run after an entry has been demoted.
5829The cursor will be at the beginning of the entry.
5830When a subtree is being demoted, the hook will be called for each node.")
5831
5832(defvar org-after-promote-entry-hook nil
5833 "Hook run after an entry has been promoted.
5834The cursor will be at the beginning of the entry.
5835When a subtree is being promoted, the hook will be called for each node.")
5836
5149(defun org-promote-subtree () 5837(defun org-promote-subtree ()
5150 "Promote the entire subtree. 5838 "Promote the entire subtree.
5151See also `org-promote'." 5839See also `org-promote'."
@@ -5210,7 +5898,7 @@ even level numbers will become the next higher odd number."
5210 (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) 5898 (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
5211 ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) 5899 ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2))))
5212 ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) 5900 ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
5213 (max 1 (+ level change)))) 5901 (max 1 (+ level (or change 0)))))
5214 5902
5215(if (boundp 'define-obsolete-function-alias) 5903(if (boundp 'define-obsolete-function-alias)
5216 (if (or (featurep 'xemacs) (< emacs-major-version 23)) 5904 (if (or (featurep 'xemacs) (< emacs-major-version 23))
@@ -5231,7 +5919,8 @@ in the region."
5231 (replace-match up-head nil t) 5919 (replace-match up-head nil t)
5232 ;; Fixup tag positioning 5920 ;; Fixup tag positioning
5233 (and org-auto-align-tags (org-set-tags nil t)) 5921 (and org-auto-align-tags (org-set-tags nil t))
5234 (if org-adapt-indentation (org-fixup-indentation (- diff))))) 5922 (if org-adapt-indentation (org-fixup-indentation (- diff)))
5923 (run-hooks 'org-after-promote-entry-hook)))
5235 5924
5236(defun org-demote () 5925(defun org-demote ()
5237 "Demote the current heading lower down the tree. 5926 "Demote the current heading lower down the tree.
@@ -5244,7 +5933,8 @@ in the region."
5244 (replace-match down-head nil t) 5933 (replace-match down-head nil t)
5245 ;; Fixup tag positioning 5934 ;; Fixup tag positioning
5246 (and org-auto-align-tags (org-set-tags nil t)) 5935 (and org-auto-align-tags (org-set-tags nil t))
5247 (if org-adapt-indentation (org-fixup-indentation diff)))) 5936 (if org-adapt-indentation (org-fixup-indentation diff))
5937 (run-hooks 'org-after-demote-entry-hook)))
5248 5938
5249(defun org-map-tree (fun) 5939(defun org-map-tree (fun)
5250 "Call FUN for every heading underneath the current one." 5940 "Call FUN for every heading underneath the current one."
@@ -5388,8 +6078,10 @@ is signaled in this case."
5388 (setq txt (buffer-substring beg end)) 6078 (setq txt (buffer-substring beg end))
5389 (org-save-markers-in-region beg end) 6079 (org-save-markers-in-region beg end)
5390 (delete-region beg end) 6080 (delete-region beg end)
6081 (org-remove-empty-overlays-at beg)
5391 (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil)) 6082 (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil))
5392 (or (bobp) (outline-flag-region (1- (point)) (point) nil)) 6083 (or (bobp) (outline-flag-region (1- (point)) (point) nil))
6084 (and (not (bolp)) (looking-at "\n") (forward-char 1))
5393 (let ((bbb (point))) 6085 (let ((bbb (point)))
5394 (insert-before-markers txt) 6086 (insert-before-markers txt)
5395 (org-reinstall-markers-in-region bbb) 6087 (org-reinstall-markers-in-region bbb)
@@ -5408,12 +6100,12 @@ is signaled in this case."
5408 (kill-line (- ne-ins ne-beg)) (point))) 6100 (kill-line (- ne-ins ne-beg)) (point)))
5409 (insert (make-string (- ne-ins ne-beg) ?\n))) 6101 (insert (make-string (- ne-ins ne-beg) ?\n)))
5410 (move-marker ins-point nil) 6102 (move-marker ins-point nil)
5411 (org-compact-display-after-subtree-move) 6103 (if folded
5412 (org-show-empty-lines-in-parent) 6104 (hide-subtree)
5413 (unless folded
5414 (org-show-entry) 6105 (org-show-entry)
5415 (show-children) 6106 (show-children)
5416 (org-cycle-hide-drawers 'children)))) 6107 (org-cycle-hide-drawers 'children))
6108 (org-clean-visibility-after-subtree-move)))
5417 6109
5418(defvar org-subtree-clip "" 6110(defvar org-subtree-clip ""
5419 "Clipboard for cut and paste of subtrees. 6111 "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."
5451 (save-excursion (outline-end-of-heading) 6143 (save-excursion (outline-end-of-heading)
5452 (setq folded (org-invisible-p))) 6144 (setq folded (org-invisible-p)))
5453 (condition-case nil 6145 (condition-case nil
5454 (outline-forward-same-level (1- n)) 6146 (org-forward-same-level (1- n) t)
5455 (error nil)) 6147 (error nil))
5456 (org-end-of-subtree t t)) 6148 (org-end-of-subtree t t))
5457 (org-back-over-empty-lines) 6149 (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
5492move back over whitespace before inserting, and move point to the end of 6184move back over whitespace before inserting, and move point to the end of
5493the inserted text when done." 6185the inserted text when done."
5494 (interactive "P") 6186 (interactive "P")
6187 (setq tree (or tree (and kill-ring (current-kill 0))))
5495 (unless (org-kill-is-subtree-p tree) 6188 (unless (org-kill-is-subtree-p tree)
5496 (error "%s" 6189 (error "%s"
5497 (substitute-command-keys 6190 (substitute-command-keys
5498 "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) 6191 "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
5499 (let* ((visp (not (org-invisible-p))) 6192 (let* ((visp (not (org-invisible-p)))
5500 (txt (or tree (and kill-ring (current-kill 0)))) 6193 (txt tree)
5501 (^re (concat "^\\(" outline-regexp "\\)")) 6194 (^re (concat "^\\(" outline-regexp "\\)"))
5502 (re (concat "\\(" outline-regexp "\\)")) 6195 (re (concat "\\(" outline-regexp "\\)"))
5503 (^re_ (concat "\\(\\*+\\)[ \t]*")) 6196 (^re_ (concat "\\(\\*+\\)[ \t]*"))
@@ -5643,15 +6336,86 @@ If yes, remember the marker and the distance to BEG."
5643 (save-excursion 6336 (save-excursion
5644 (save-match-data 6337 (save-match-data
5645 (narrow-to-region 6338 (narrow-to-region
5646 (progn (org-back-to-heading) (point)) 6339 (progn (org-back-to-heading t) (point))
5647 (progn (org-end-of-subtree t) (point)))))) 6340 (progn (org-end-of-subtree t) (point))))))
5648 6341
6342(defun org-clone-subtree-with-time-shift (n &optional shift)
6343 "Clone the task (subtree) at point N times.
6344The clones will be inserted as siblings.
6345
6346In interactive use, the user will be prompted for the number of clones
6347to be produced, and for a time SHIFT, which may be a repeater as used
6348in time stamps, for example `+3d'.
6349
6350When a valid repeater is given and the entry contains any time stamps,
6351the clones will become a sequence in time, with time stamps in the
6352subtree shifted for each clone produced. If SHIFT is nil or the
6353empty string, time stamps will be left alone.
6354
6355If the original subtree did contain time stamps with a repeater,
6356the following will happen:
6357- the repeater will be removed in each clone
6358- an additional clone will be produced, with the current, unshifted
6359 date(s) in the entry.
6360- the original entry will be placed *after* all the clones, with
6361 repeater intact.
6362- the start days in the repeater in the original entry will be shifted
6363 to past the last clone.
6364I this way you can spell out a number of instances of a repeating task,
6365and still retain the repeater to cover future instances of the task."
6366 (interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ")
6367 (let (beg end template task
6368 shift-n shift-what doshift nmin nmax (n-no-remove -1))
6369 (if (not (and (integerp n) (> n 0)))
6370 (error "Invalid number of replications %s" n))
6371 (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift)))
6372 (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'"
6373 shift)))
6374 (error "Invalid shift specification %s" shift))
6375 (when doshift
6376 (setq shift-n (string-to-number (match-string 1 shift))
6377 shift-what (cdr (assoc (match-string 2 shift)
6378 '(("d" . day) ("w" . week)
6379 ("m" . month) ("y" . year))))))
6380 (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day))
6381 (setq nmin 1 nmax n)
6382 (org-back-to-heading t)
6383 (setq beg (point))
6384 (org-end-of-subtree t t)
6385 (setq end (point))
6386 (setq template (buffer-substring beg end))
6387 (when (and doshift
6388 (string-match "<[^<>\n]+ \\+[0-9]+[dwmy][^<>\n]*>" template))
6389 (delete-region beg end)
6390 (setq end beg)
6391 (setq nmin 0 nmax (1+ nmax) n-no-remove nmax))
6392 (goto-char end)
6393 (loop for n from nmin to nmax do
6394 (if (not doshift)
6395 (setq task template)
6396 (with-temp-buffer
6397 (insert template)
6398 (org-mode)
6399 (goto-char (point-min))
6400 (while (re-search-forward org-ts-regexp-both nil t)
6401 (org-timestamp-change (* n shift-n) shift-what))
6402 (unless (= n n-no-remove)
6403 (goto-char (point-min))
6404 (while (re-search-forward org-ts-regexp nil t)
6405 (save-excursion
6406 (goto-char (match-beginning 0))
6407 (if (looking-at "<[^<>\n]+\\( +\\+[0-9]+[dwmy]\\)")
6408 (delete-region (match-beginning 1) (match-end 1))))))
6409 (setq task (buffer-string))))
6410 (insert task))
6411 (goto-char beg)))
5649 6412
5650;;; Outline Sorting 6413;;; Outline Sorting
5651 6414
5652(defun org-sort (with-case) 6415(defun org-sort (with-case)
5653 "Call `org-sort-entries-or-items' or `org-table-sort-lines'. 6416 "Call `org-sort-entries-or-items' or `org-table-sort-lines'.
5654Optional argument WITH-CASE means sort case-sensitively." 6417Optional argument WITH-CASE means sort case-sensitively.
6418With a double prefix argument, also remove duplicate entries."
5655 (interactive "P") 6419 (interactive "P")
5656 (if (org-at-table-p) 6420 (if (org-at-table-p)
5657 (org-call-with-arg 'org-table-sort-lines with-case) 6421 (org-call-with-arg 'org-table-sort-lines with-case)
@@ -5667,17 +6431,43 @@ Optional argument WITH-CASE means sort case-sensitively."
5667 6431
5668(defvar org-priority-regexp) ; defined later in the file 6432(defvar org-priority-regexp) ; defined later in the file
5669 6433
6434(defvar org-after-sorting-entries-or-items-hook nil
6435 "Hook that is run after a bunch of entries or items have been sorted.
6436When children are sorted, the cursor is in the parent line when this
6437hook gets called. When a region or a plain list is sorted, the cursor
6438will be in the first entry of the sorted region/list.")
6439
5670(defun org-sort-entries-or-items 6440(defun org-sort-entries-or-items
5671 (&optional with-case sorting-type getkey-func compare-func property) 6441 (&optional with-case sorting-type getkey-func compare-func property)
5672 "Sort entries on a certain level of an outline tree. 6442 "Sort entries on a certain level of an outline tree, or plain list items.
5673If there is an active region, the entries in the region are sorted. 6443If there is an active region, the entries in the region are sorted.
5674Else, if the cursor is before the first entry, sort the top-level items. 6444Else, if the cursor is before the first entry, sort the top-level items.
5675Else, the children of the entry at point are sorted. 6445Else, the children of the entry at point are sorted.
6446If the cursor is at the first item in a plain list, the list items will be
6447sorted.
6448
6449Sorting can be alphabetically, numerically, by date/time as given by
6450a time stamp, by a property or by priority.
6451
6452The command prompts for the sorting type unless it has been given to the
6453function through the SORTING-TYPE argument, which needs to a character,
6454\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the
6455precise meaning of each character:
6456
6457n Numerically, by converting the beginning of the entry/item to a number.
6458a Alphabetically, ignoring the TODO keyword and the priority, if any.
6459t By date/time, either the first active time stamp in the entry, or, if
6460 none exist, by the first inactive one.
6461 In items, only the first line will be chekced.
6462s By the scheduled date/time.
6463d By deadline date/time.
6464c By creation time, which is assumed to be the first inactive time stamp
6465 at the beginning of a line.
6466p By priority according to the cookie.
6467r By the value of a property.
6468
6469Capital letters will reverse the sort order.
5676 6470
5677Sorting can be alphabetically, numerically, and by date/time as given by
5678the first time stamp in the entry. The command prompts for the sorting
5679type unless it has been given to the function through the SORTING-TYPE
5680argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F).
5681If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be 6471If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
5682called with point at the beginning of the record. It must return either 6472called with point at the beginning of the record. It must return either
5683a string or a number that should serve as the sorting key for that record. 6473a 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."
5740 (unless sorting-type 6530 (unless sorting-type
5741 (message 6531 (message
5742 (if plain-list-p 6532 (if plain-list-p
5743 "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" 6533 "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:"
5744 "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:") 6534 "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc
6535 [t]ime [s]cheduled [d]eadline [c]reated
6536 A/N/T/S/D/C/P/O/F means reversed:")
5745 what) 6537 what)
5746 (setq sorting-type (read-char-exclusive)) 6538 (setq sorting-type (read-char-exclusive))
5747 6539
@@ -5763,6 +6555,7 @@ WITH-CASE, the sorting considers case as well."
5763 (narrow-to-region start end) 6555 (narrow-to-region start end)
5764 6556
5765 (let ((dcst (downcase sorting-type)) 6557 (let ((dcst (downcase sorting-type))
6558 (case-fold-search nil)
5766 (now (current-time))) 6559 (now (current-time)))
5767 (sort-subr 6560 (sort-subr
5768 (/= dcst sorting-type) 6561 (/= dcst sorting-type)
@@ -5797,10 +6590,11 @@ WITH-CASE, the sorting considers case as well."
5797 ((= dcst ?a) 6590 ((= dcst ?a)
5798 (buffer-substring (match-end 0) (point-at-eol))) 6591 (buffer-substring (match-end 0) (point-at-eol)))
5799 ((= dcst ?t) 6592 ((= dcst ?t)
5800 (if (re-search-forward org-ts-regexp 6593 (if (or (re-search-forward org-ts-regexp (point-at-eol) t)
5801 (point-at-eol) t) 6594 (re-search-forward org-ts-regexp-both
5802 (org-time-string-to-time (match-string 0)) 6595 (point-at-eol) t))
5803 now)) 6596 (org-time-string-to-seconds (match-string 0))
6597 (time-to-seconds now)))
5804 ((= dcst ?f) 6598 ((= dcst ?f)
5805 (if getkey-func 6599 (if getkey-func
5806 (progn 6600 (progn
@@ -5820,12 +6614,28 @@ WITH-CASE, the sorting considers case as well."
5820 (funcall case-func (match-string 4)) 6614 (funcall case-func (match-string 4))
5821 nil)) 6615 nil))
5822 ((= dcst ?t) 6616 ((= dcst ?t)
5823 (if (re-search-forward org-ts-regexp 6617 (let ((end (save-excursion (outline-next-heading) (point))))
5824 (save-excursion 6618 (if (or (re-search-forward org-ts-regexp end t)
5825 (forward-line 2) 6619 (re-search-forward org-ts-regexp-both end t))
5826 (point)) t) 6620 (org-time-string-to-seconds (match-string 0))
5827 (org-time-string-to-time (match-string 0)) 6621 (time-to-seconds now))))
5828 now)) 6622 ((= dcst ?c)
6623 (let ((end (save-excursion (outline-next-heading) (point))))
6624 (if (re-search-forward
6625 (concat "^[ \t]*\\[" org-ts-regexp1 "\\]")
6626 end t)
6627 (org-time-string-to-seconds (match-string 0))
6628 (time-to-seconds now))))
6629 ((= dcst ?s)
6630 (let ((end (save-excursion (outline-next-heading) (point))))
6631 (if (re-search-forward org-scheduled-time-regexp end t)
6632 (org-time-string-to-seconds (match-string 1))
6633 (time-to-seconds now))))
6634 ((= dcst ?d)
6635 (let ((end (save-excursion (outline-next-heading) (point))))
6636 (if (re-search-forward org-deadline-time-regexp end t)
6637 (org-time-string-to-seconds (match-string 1))
6638 (time-to-seconds now))))
5829 ((= dcst ?p) 6639 ((= dcst ?p)
5830 (if (re-search-forward org-priority-regexp (point-at-eol) t) 6640 (if (re-search-forward org-priority-regexp (point-at-eol) t)
5831 (string-to-char (match-string 2)) 6641 (string-to-char (match-string 2))
@@ -5847,9 +6657,10 @@ WITH-CASE, the sorting considers case as well."
5847 nil 6657 nil
5848 (cond 6658 (cond
5849 ((= dcst ?a) 'string<) 6659 ((= dcst ?a) 'string<)
5850 ((= dcst ?t) 'time-less-p)
5851 ((= dcst ?f) compare-func) 6660 ((= dcst ?f) compare-func)
6661 ((member dcst '(?p ?t ?s ?d ?c)) '<)
5852 (t nil))))) 6662 (t nil)))))
6663 (run-hooks 'org-after-sorting-entries-or-items-hook)
5853 (message "Sorting entries...done"))) 6664 (message "Sorting entries...done")))
5854 6665
5855(defun org-do-sort (table what &optional with-case sorting-type) 6666(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."
5881 ((= dcst ?t) 6692 ((= dcst ?t)
5882 (setq extractfun 6693 (setq extractfun
5883 (lambda (x) 6694 (lambda (x)
5884 (if (string-match org-ts-regexp x) 6695 (if (or (string-match org-ts-regexp x)
6696 (string-match org-ts-regexp-both x))
5885 (time-to-seconds 6697 (time-to-seconds
5886 (org-time-string-to-time (match-string 0 x))) 6698 (org-time-string-to-time (match-string 0 x)))
5887 0)) 6699 0))
@@ -5892,231 +6704,6 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive."
5892 table) 6704 table)
5893 (lambda (a b) (funcall comparefun (car a) (car b)))))) 6705 (lambda (a b) (funcall comparefun (car a) (car b))))))
5894 6706
5895;;; Editing source examples
5896
5897(defvar org-exit-edit-mode-map (make-sparse-keymap))
5898(define-key org-exit-edit-mode-map "\C-c'" 'org-edit-src-exit)
5899(defvar org-edit-src-force-single-line nil)
5900(defvar org-edit-src-from-org-mode nil)
5901(defvar org-edit-src-picture nil)
5902
5903(define-minor-mode org-exit-edit-mode
5904 "Minor mode installing a single key binding, \"C-c '\" to exit special edit.")
5905
5906(defun org-edit-src-code ()
5907 "Edit the source code example at point.
5908An indirect buffer is created, and that buffer is then narrowed to the
5909example at point and switched to the correct language mode. When done,
5910exit by killing the buffer with \\[org-edit-src-exit]."
5911 (interactive)
5912 (let ((line (org-current-line))
5913 (case-fold-search t)
5914 (msg (substitute-command-keys
5915 "Edit, then exit with C-c ' (C-c and single quote)"))
5916 (info (org-edit-src-find-region-and-lang))
5917 (org-mode-p (eq major-mode 'org-mode))
5918 beg end lang lang-f single lfmt)
5919 (if (not info)
5920 nil
5921 (setq beg (nth 0 info)
5922 end (nth 1 info)
5923 lang (nth 2 info)
5924 single (nth 3 info)
5925 lfmt (nth 4 info)
5926 lang-f (intern (concat lang "-mode")))
5927 (unless (functionp lang-f)
5928 (error "No such language mode: %s" lang-f))
5929 (goto-line line)
5930 (if (get-buffer "*Org Edit Src Example*")
5931 (kill-buffer "*Org Edit Src Example*"))
5932 (switch-to-buffer (make-indirect-buffer (current-buffer)
5933 "*Org Edit Src Example*"))
5934 (narrow-to-region beg end)
5935 (remove-text-properties beg end '(display nil invisible nil
5936 intangible nil))
5937 (let ((org-inhibit-startup t))
5938 (funcall lang-f))
5939 (set (make-local-variable 'org-edit-src-force-single-line) single)
5940 (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
5941 (when lfmt
5942 (set (make-local-variable 'org-coderef-label-format) lfmt))
5943 (when org-mode-p
5944 (goto-char (point-min))
5945 (while (re-search-forward "^," nil t)
5946 (replace-match "")))
5947 (goto-line line)
5948 (org-exit-edit-mode)
5949 (org-set-local 'header-line-format msg)
5950 (message "%s" msg)
5951 t)))
5952
5953(defun org-edit-fixed-width-region ()
5954 "Edit the fixed-width ascii drawing at point.
5955This must be a region where each line starts with a colon followed by
5956a space character.
5957An indirect buffer is created, and that buffer is then narrowed to the
5958example at point and switched to artist-mode. When done,
5959exit by killing the buffer with \\[org-edit-src-exit]."
5960 (interactive)
5961 (let ((line (org-current-line))
5962 (case-fold-search t)
5963 (msg (substitute-command-keys
5964 "Edit, then exit with C-c ' (C-c and single quote)"))
5965 (org-mode-p (eq major-mode 'org-mode))
5966 beg end)
5967 (beginning-of-line 1)
5968 (if (looking-at "[ \t]*[^:\n \t]")
5969 nil
5970 (if (looking-at "[ \t]*\\(\n\\|\\'\\)")
5971 (setq beg (point) end beg)
5972 (save-excursion
5973 (if (re-search-backward "^[ \t]*[^:]" nil 'move)
5974 (setq beg (point-at-bol 2))
5975 (setq beg (point))))
5976 (save-excursion
5977 (if (re-search-forward "^[ \t]*[^:]" nil 'move)
5978 (setq end (1- (match-beginning 0)))
5979 (setq end (point))))
5980 (goto-line line))
5981 (if (get-buffer "*Org Edit Picture*")
5982 (kill-buffer "*Org Edit Picture*"))
5983 (switch-to-buffer (make-indirect-buffer (current-buffer)
5984 "*Org Edit Picture*"))
5985 (narrow-to-region beg end)
5986 (remove-text-properties beg end '(display nil invisible nil
5987 intangible nil))
5988 (when (fboundp 'font-lock-unfontify-region)
5989 (font-lock-unfontify-region (point-min) (point-max)))
5990 (cond
5991 ((eq org-edit-fixed-width-region-mode 'artist-mode)
5992 (fundamental-mode)
5993 (artist-mode 1))
5994 (t (funcall org-edit-fixed-width-region-mode)))
5995 (set (make-local-variable 'org-edit-src-force-single-line) nil)
5996 (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
5997 (set (make-local-variable 'org-edit-src-picture) t)
5998 (goto-char (point-min))
5999 (while (re-search-forward "^[ \t]*: ?" nil t)
6000 (replace-match ""))
6001 (goto-line line)
6002 (org-exit-edit-mode)
6003 (org-set-local 'header-line-format msg)
6004 (message "%s" msg)
6005 t)))
6006
6007
6008(defun org-edit-src-find-region-and-lang ()
6009 "Find the region and language for a local edit.
6010Return a list with beginning and end of the region, a string representing
6011the language, a switch telling of the content should be in a single line."
6012 (let ((re-list
6013 (append
6014 org-edit-src-region-extra
6015 '(
6016 ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang)
6017 ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style)
6018 ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental")
6019 ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp")
6020 ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl")
6021 ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python")
6022 ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby")
6023 ("^#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n#\\+end_src" 2)
6024 ("^#\\+begin_example.*\n" "\n#\\+end_example" "fundamental")
6025 ("^#\\+html:" "\n" "html" single-line)
6026 ("^#\\+begin_html.*\n" "\n#\\+end_html" "html")
6027 ("^#\\+begin_latex.*\n" "\n#\\+end_latex" "latex")
6028 ("^#\\+latex:" "\n" "latex" single-line)
6029 ("^#\\+begin_ascii.*\n" "\n#\\+end_ascii" "fundamental")
6030 ("^#\\+ascii:" "\n" "ascii" single-line)
6031 )))
6032 (pos (point))
6033 re1 re2 single beg end lang lfmt match-re1)
6034 (catch 'exit
6035 (while (setq entry (pop re-list))
6036 (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
6037 single (nth 3 entry))
6038 (save-excursion
6039 (if (or (looking-at re1)
6040 (re-search-backward re1 nil t))
6041 (progn
6042 (setq match-re1 (match-string 0))
6043 (setq beg (match-end 0)
6044 lang (org-edit-src-get-lang lang)
6045 lfmt (org-edit-src-get-label-format match-re1))
6046 (if (and (re-search-forward re2 nil t)
6047 (>= (match-end 0) pos))
6048 (throw 'exit (list beg (match-beginning 0)
6049 lang single lfmt))))
6050 (if (or (looking-at re2)
6051 (re-search-forward re2 nil t))
6052 (progn
6053 (setq end (match-beginning 0))
6054 (if (and (re-search-backward re1 nil t)
6055 (<= (match-beginning 0) pos))
6056 (progn
6057 (setq lfmt (org-edit-src-get-label-format
6058 (match-string 0)))
6059 (throw 'exit
6060 (list (match-end 0) end
6061 (org-edit-src-get-lang lang)
6062 single lfmt))))))))))))
6063
6064(defun org-edit-src-get-lang (lang)
6065 "Extract the src language."
6066 (let ((m (match-string 0)))
6067 (cond
6068 ((stringp lang) lang)
6069 ((integerp lang) (match-string lang))
6070 ((and (eq lang 'lang)
6071 (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m))
6072 (match-string 1 m))
6073 ((and (eq lang 'style)
6074 (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m))
6075 (match-string 1 m))
6076 (t "fundamental"))))
6077
6078(defun org-edit-src-get-label-format (s)
6079 "Extract the label format."
6080 (save-match-data
6081 (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s)
6082 (match-string 1 s))))
6083
6084(defun org-edit-src-exit ()
6085 "Exit special edit and protect problematic lines."
6086 (interactive)
6087 (unless (buffer-base-buffer (current-buffer))
6088 (error "This is not an indirect buffer, something is wrong..."))
6089 (unless (> (point-min) 1)
6090 (error "This buffer is not narrowed, something is wrong..."))
6091 (goto-char (point-min))
6092 (if (looking-at "[ \t\n]*\n") (replace-match ""))
6093 (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))
6094 (when (org-bound-and-true-p org-edit-src-force-single-line)
6095 (goto-char (point-min))
6096 (while (re-search-forward "\n" nil t)
6097 (replace-match " "))
6098 (goto-char (point-min))
6099 (if (looking-at "\\s-*") (replace-match " "))
6100 (if (re-search-forward "\\s-+\\'" nil t)
6101 (replace-match "")))
6102 (when (org-bound-and-true-p org-edit-src-from-org-mode)
6103 (goto-char (point-min))
6104 (while (re-search-forward (if (org-mode-p) "^\\(.\\)" "^\\([*#]\\)") nil t)
6105 (replace-match ",\\1"))
6106 (when font-lock-mode
6107 (font-lock-unfontify-region (point-min) (point-max)))
6108 (put-text-property (point-min) (point-max) 'font-lock-fontified t))
6109 (when (org-bound-and-true-p org-edit-src-picture)
6110 (untabify (point-min) (point-max))
6111 (goto-char (point-min))
6112 (while (re-search-forward "^" nil t)
6113 (replace-match ": "))
6114 (when font-lock-mode
6115 (font-lock-unfontify-region (point-min) (point-max)))
6116 (put-text-property (point-min) (point-max) 'font-lock-fontified t))
6117 (kill-buffer (current-buffer))
6118 (and (org-mode-p) (org-restart-font-lock)))
6119
6120 6707
6121;;; The orgstruct minor mode 6708;;; The orgstruct minor mode
6122 6709
@@ -6179,22 +6766,38 @@ C-c C-c Set tags / toggle checkbox"
6179 "Unconditionally turn on `orgstruct-mode'." 6766 "Unconditionally turn on `orgstruct-mode'."
6180 (orgstruct-mode 1)) 6767 (orgstruct-mode 1))
6181 6768
6769(defun orgstruct++-mode (&optional arg)
6770 "Toggle `orgstruct-mode', the enhanced version of it.
6771In addition to setting orgstruct-mode, this also exports all indentation
6772and autofilling variables from org-mode into the buffer. It will also
6773recognize item context in multiline items.
6774Note that turning off orgstruct-mode will *not* remove the
6775indentation/paragraph settings. This can only be done by refreshing the
6776major mode, for example with \\[normal-mode]."
6777 (interactive "P")
6778 (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
6779 (if (< arg 1)
6780 (orgstruct-mode -1)
6781 (orgstruct-mode 1)
6782 (let (var val)
6783 (mapc
6784 (lambda (x)
6785 (when (string-match
6786 "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)"
6787 (symbol-name (car x)))
6788 (setq var (car x) val (nth 1 x))
6789 (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
6790 org-local-vars)
6791 (org-set-local 'orgstruct-is-++ t))))
6792
6793(defvar orgstruct-is-++ nil
6794 "Is orgstruct-mode in ++ version in the current-buffer?")
6795(make-variable-buffer-local 'orgstruct-is-++)
6796
6182;;;###autoload 6797;;;###autoload
6183(defun turn-on-orgstruct++ () 6798(defun turn-on-orgstruct++ ()
6184 "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. 6799 "Unconditionally turn on `orgstruct++-mode'."
6185In addition to setting orgstruct-mode, this also exports all indentation and 6800 (orgstruct++-mode 1))
6186autofilling variables from org-mode into the buffer. Note that turning
6187off orgstruct-mode will *not* remove these additional settings."
6188 (orgstruct-mode 1)
6189 (let (var val)
6190 (mapc
6191 (lambda (x)
6192 (when (string-match
6193 "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)"
6194 (symbol-name (car x)))
6195 (setq var (car x) val (nth 1 x))
6196 (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
6197 org-local-vars)))
6198 6801
6199(defun orgstruct-error () 6802(defun orgstruct-error ()
6200 "Error when there is no default binding for a structure key." 6803 "Error when there is no default binding for a structure key."
@@ -6214,6 +6817,14 @@ off orgstruct-mode will *not* remove these additional settings."
6214 '([(meta shift down)] org-shiftmetadown) 6817 '([(meta shift down)] org-shiftmetadown)
6215 '([(meta shift left)] org-shiftmetaleft) 6818 '([(meta shift left)] org-shiftmetaleft)
6216 '([(meta shift right)] org-shiftmetaright) 6819 '([(meta shift right)] org-shiftmetaright)
6820 '([?\e (up)] org-metaup)
6821 '([?\e (down)] org-metadown)
6822 '([?\e (left)] org-metaleft)
6823 '([?\e (right)] org-metaright)
6824 '([?\e (shift up)] org-shiftmetaup)
6825 '([?\e (shift down)] org-shiftmetadown)
6826 '([?\e (shift left)] org-shiftmetaleft)
6827 '([?\e (shift right)] org-shiftmetaright)
6217 '([(shift up)] org-shiftup) 6828 '([(shift up)] org-shiftup)
6218 '([(shift down)] org-shiftdown) 6829 '([(shift down)] org-shiftdown)
6219 '([(shift left)] org-shiftleft) 6830 '([(shift left)] org-shiftleft)
@@ -6247,6 +6858,16 @@ off orgstruct-mode will *not* remove these additional settings."
6247 (orgstruct-make-binding 'org-insert-todo-heading 107 6858 (orgstruct-make-binding 'org-insert-todo-heading 107
6248 [(meta return)] "\M-\C-m")) 6859 [(meta return)] "\M-\C-m"))
6249 6860
6861 (org-defkey orgstruct-mode-map "\e\C-m"
6862 (orgstruct-make-binding 'org-insert-heading 108
6863 "\e\C-m" [?\e (return)]))
6864 (org-defkey orgstruct-mode-map [?\e (return)]
6865 (orgstruct-make-binding 'org-insert-heading 109
6866 [?\e (return)] "\e\C-m"))
6867 (org-defkey orgstruct-mode-map [?\e (shift return)]
6868 (orgstruct-make-binding 'org-insert-todo-heading 110
6869 [?\e (return)] "\e\C-m"))
6870
6250 (unless org-local-vars 6871 (unless org-local-vars
6251 (setq org-local-vars (org-get-local-variables))) 6872 (setq org-local-vars (org-get-local-variables)))
6252 6873
@@ -6267,7 +6888,10 @@ to execute outside of tables."
6267 "'.") 6888 "'.")
6268 '(interactive "p") 6889 '(interactive "p")
6269 (list 'if 6890 (list 'if
6270 '(org-context-p 'headline 'item) 6891 `(org-context-p 'headline 'item
6892 (and orgstruct-is-++
6893 ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t)
6894 'item-body))
6271 (list 'org-run-like-in-org-mode (list 'quote fun)) 6895 (list 'org-run-like-in-org-mode (list 'quote fun))
6272 (list 'let '(orgstruct-mode) 6896 (list 'let '(orgstruct-mode)
6273 (list 'call-interactively 6897 (list 'call-interactively
@@ -6288,7 +6912,9 @@ Possible values in the list of contexts are `table', `headline', and `item'."
6288;;????????? (looking-at "\\*+")) 6912;;????????? (looking-at "\\*+"))
6289 (looking-at outline-regexp)) 6913 (looking-at outline-regexp))
6290 (and (memq 'item contexts) 6914 (and (memq 'item contexts)
6291 (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))) 6915 (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))
6916 (and (memq 'item-body contexts)
6917 (org-in-item-p)))
6292 (goto-char pos)))) 6918 (goto-char pos))))
6293 6919
6294(defun org-get-local-variables () 6920(defun org-get-local-variables ()
@@ -6314,6 +6940,10 @@ Possible values in the list of contexts are `table', `headline', and `item'."
6314 6940
6315;;;###autoload 6941;;;###autoload
6316(defun org-run-like-in-org-mode (cmd) 6942(defun org-run-like-in-org-mode (cmd)
6943 "Run a command, pretending that the current buffer is in Org-mode.
6944This will temporarily bind local variables that are typically bound in
6945Org-mode to the values they have in Org-mode, and then interactively
6946call CMD."
6317 (org-load-modules-maybe) 6947 (org-load-modules-maybe)
6318 (unless org-local-vars 6948 (unless org-local-vars
6319 (setq org-local-vars (org-get-local-variables))) 6949 (setq org-local-vars (org-get-local-variables)))
@@ -6454,7 +7084,8 @@ For file links, arg negates `org-context-in-file-links'."
6454 (interactive "P") 7084 (interactive "P")
6455 (org-load-modules-maybe) 7085 (org-load-modules-maybe)
6456 (setq org-store-link-plist nil) ; reset 7086 (setq org-store-link-plist nil) ; reset
6457 (let (link cpltxt desc description search txt) 7087 (let ((outline-regexp (org-get-limited-outline-regexp))
7088 link cpltxt desc description search txt custom-id)
6458 (cond 7089 (cond
6459 7090
6460 ((run-hook-with-args-until-success 'org-store-link-functions) 7091 ((run-hook-with-args-until-success 'org-store-link-functions)
@@ -6491,8 +7122,11 @@ For file links, arg negates `org-context-in-file-links'."
6491 (org-store-link-props :type "calendar" :date cd))) 7122 (org-store-link-props :type "calendar" :date cd)))
6492 7123
6493 ((eq major-mode 'w3-mode) 7124 ((eq major-mode 'w3-mode)
6494 (setq cpltxt (url-view-url t) 7125 (setq cpltxt (if (and (buffer-name)
6495 link (org-make-link cpltxt)) 7126 (not (string-match "Untitled" (buffer-name))))
7127 (buffer-name)
7128 (url-view-url t))
7129 link (org-make-link (url-view-url t)))
6496 (org-store-link-props :type "w3" :url (url-view-url t))) 7130 (org-store-link-props :type "w3" :url (url-view-url t)))
6497 7131
6498 ((eq major-mode 'w3m-mode) 7132 ((eq major-mode 'w3m-mode)
@@ -6521,6 +7155,7 @@ For file links, arg negates `org-context-in-file-links'."
6521 link (org-make-link cpltxt))) 7155 link (org-make-link cpltxt)))
6522 7156
6523 ((and buffer-file-name (org-mode-p)) 7157 ((and buffer-file-name (org-mode-p))
7158 (setq custom-id (ignore-errors (org-entry-get nil "CUSTOM_ID")))
6524 (cond 7159 (cond
6525 ((org-in-regexp "<<\\(.*?\\)>>") 7160 ((org-in-regexp "<<\\(.*?\\)>>")
6526 (setq cpltxt 7161 (setq cpltxt
@@ -6532,6 +7167,9 @@ For file links, arg negates `org-context-in-file-links'."
6532 (or (eq org-link-to-org-use-id t) 7167 (or (eq org-link-to-org-use-id t)
6533 (and (eq org-link-to-org-use-id 'create-if-interactive) 7168 (and (eq org-link-to-org-use-id 'create-if-interactive)
6534 (interactive-p)) 7169 (interactive-p))
7170 (and (eq org-link-to-org-use-id 'create-if-interactive-and-no-custom-id)
7171 (interactive-p)
7172 (not custom-id))
6535 (and org-link-to-org-use-id 7173 (and org-link-to-org-use-id
6536 (condition-case nil 7174 (condition-case nil
6537 (org-entry-get nil "ID") 7175 (org-entry-get nil "ID")
@@ -6562,7 +7200,7 @@ For file links, arg negates `org-context-in-file-links'."
6562 (condition-case nil 7200 (condition-case nil
6563 (org-make-org-heading-search-string txt) 7201 (org-make-org-heading-search-string txt)
6564 (error ""))) 7202 (error "")))
6565 desc "NONE"))) 7203 desc (or (nth 4 (org-heading-components)) "NONE"))))
6566 (if (string-match "::\\'" cpltxt) 7204 (if (string-match "::\\'" cpltxt)
6567 (setq cpltxt (substring cpltxt 0 -2))) 7205 (setq cpltxt (substring cpltxt 0 -2)))
6568 (setq link (org-make-link cpltxt))))) 7206 (setq link (org-make-link cpltxt)))))
@@ -6594,11 +7232,16 @@ For file links, arg negates `org-context-in-file-links'."
6594 desc (or desc cpltxt)) 7232 desc (or desc cpltxt))
6595 (if (equal desc "NONE") (setq desc nil)) 7233 (if (equal desc "NONE") (setq desc nil))
6596 7234
6597 (if (and (interactive-p) link) 7235 (if (and (or (interactive-p) executing-kbd-macro) link)
6598 (progn 7236 (progn
6599 (setq org-stored-links 7237 (setq org-stored-links
6600 (cons (list link desc) org-stored-links)) 7238 (cons (list link desc) org-stored-links))
6601 (message "Stored: %s" (or desc link))) 7239 (message "Stored: %s" (or desc link))
7240 (when custom-id
7241 (setq link (concat "file:" (abbreviate-file-name (buffer-file-name))
7242 "::#" custom-id))
7243 (setq org-stored-links
7244 (cons (list link desc) org-stored-links))))
6602 (and link (org-make-link-string link desc))))) 7245 (and link (org-make-link-string link desc)))))
6603 7246
6604(defun org-store-link-props (&rest plist) 7247(defun org-store-link-props (&rest plist)
@@ -6722,6 +7365,8 @@ according to FMT (default from `org-email-link-description-format')."
6722 "Association list of escapes for some characters problematic in links. 7365 "Association list of escapes for some characters problematic in links.
6723This is the list that is used for internal purposes.") 7366This is the list that is used for internal purposes.")
6724 7367
7368(defvar org-url-encoding-use-url-hexify nil)
7369
6725(defconst org-link-escape-chars-browser 7370(defconst org-link-escape-chars-browser
6726 '((?\ . "%20")) ; 32 for the SPC char 7371 '((?\ . "%20")) ; 32 for the SPC char
6727 "Association list of escapes for some characters problematic in links. 7372 "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.")
6729 7374
6730(defun org-link-escape (text &optional table) 7375(defun org-link-escape (text &optional table)
6731 "Escape characters in TEXT that are problematic for links." 7376 "Escape characters in TEXT that are problematic for links."
6732 (setq table (or table org-link-escape-chars)) 7377 (if org-url-encoding-use-url-hexify
6733 (when text 7378 (url-hexify-string text)
6734 (let ((re (mapconcat (lambda (x) (regexp-quote 7379 (setq table (or table org-link-escape-chars))
6735 (char-to-string (car x)))) 7380 (when text
6736 table "\\|"))) 7381 (let ((re (mapconcat (lambda (x) (regexp-quote
6737 (while (string-match re text) 7382 (char-to-string (car x))))
6738 (setq text 7383 table "\\|")))
6739 (replace-match 7384 (while (string-match re text)
6740 (cdr (assoc (string-to-char (match-string 0 text)) 7385 (setq text
6741 table)) 7386 (replace-match
7387 (cdr (assoc (string-to-char (match-string 0 text))
7388 table))
6742 t t text))) 7389 t t text)))
6743 text))) 7390 text))))
6744 7391
6745(defun org-link-unescape (text &optional table) 7392(defun org-link-unescape (text &optional table)
6746 "Reverse the action of `org-link-escape'." 7393 "Reverse the action of `org-link-escape'."
6747 (setq table (or table org-link-escape-chars)) 7394 (if org-url-encoding-use-url-hexify
6748 (when text 7395 (url-unhex-string text)
6749 (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x))) 7396 (setq table (or table org-link-escape-chars))
6750 table "\\|"))) 7397 (when text
6751 (while (string-match re text) 7398 (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x)))
6752 (setq text 7399 table "\\|")))
6753 (replace-match 7400 (while (string-match re text)
6754 (char-to-string (car (rassoc (match-string 0 text) table))) 7401 (setq text
6755 t t text))) 7402 (replace-match
6756 text))) 7403 (char-to-string (car (rassoc (match-string 0 text) table)))
7404 t t text)))
7405 text))))
6757 7406
6758(defun org-xor (a b) 7407(defun org-xor (a b)
6759 "Exclusive or." 7408 "Exclusive or."
@@ -6822,7 +7471,7 @@ used as the link location instead of reading one interactively."
6822 (desc region) 7471 (desc region)
6823 tmphist ; byte-compile incorrectly complains about this 7472 tmphist ; byte-compile incorrectly complains about this
6824 (link link-location) 7473 (link link-location)
6825 entry file) 7474 entry file all-prefixes)
6826 (cond 7475 (cond
6827 (link-location) ; specified by arg, just use it. 7476 (link-location) ; specified by arg, just use it.
6828 ((org-in-regexp org-bracket-link-regexp 1) 7477 ((org-in-regexp org-bracket-link-regexp 1)
@@ -6840,26 +7489,12 @@ used as the link location instead of reading one interactively."
6840 (org-remove-angle-brackets (match-string 0))))) 7489 (org-remove-angle-brackets (match-string 0)))))
6841 ((member complete-file '((4) (16))) 7490 ((member complete-file '((4) (16)))
6842 ;; Completing read for file names. 7491 ;; Completing read for file names.
6843 (setq file (read-file-name "File: ")) 7492 (setq link (org-file-complete-link complete-file)))
6844 (let ((pwd (file-name-as-directory (expand-file-name ".")))
6845 (pwd1 (file-name-as-directory (abbreviate-file-name
6846 (expand-file-name ".")))))
6847 (cond
6848 ((equal complete-file '(16))
6849 (setq link (org-make-link
6850 "file:"
6851 (abbreviate-file-name (expand-file-name file)))))
6852 ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
6853 (setq link (org-make-link "file:" (match-string 1 file))))
6854 ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
6855 (expand-file-name file))
6856 (setq link (org-make-link
6857 "file:" (match-string 1 (expand-file-name file)))))
6858 (t (setq link (org-make-link "file:" file))))))
6859 (t 7493 (t
6860 ;; Read link, with completion for stored links. 7494 ;; Read link, with completion for stored links.
6861 (with-output-to-temp-buffer "*Org Links*" 7495 (with-output-to-temp-buffer "*Org Links*"
6862 (princ "Insert a link. Use TAB to complete valid link prefixes.\n") 7496 (princ "Insert a link.
7497Use TAB to complete link prefixes, then RET for type-specific completion support\n")
6863 (when org-stored-links 7498 (when org-stored-links
6864 (princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") 7499 (princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n")
6865 (princ (mapconcat 7500 (princ (mapconcat
@@ -6869,24 +7504,33 @@ used as the link location instead of reading one interactively."
6869 (let ((cw (selected-window))) 7504 (let ((cw (selected-window)))
6870 (select-window (get-buffer-window "*Org Links*")) 7505 (select-window (get-buffer-window "*Org Links*"))
6871 (setq truncate-lines t) 7506 (setq truncate-lines t)
6872 (org-fit-window-to-buffer) 7507 (unless (pos-visible-in-window-p (point-max))
6873 (select-window cw)) 7508 (org-fit-window-to-buffer))
7509 (and (window-live-p cw) (select-window cw)))
6874 ;; Fake a link history, containing the stored links. 7510 ;; Fake a link history, containing the stored links.
6875 (setq tmphist (append (mapcar 'car org-stored-links) 7511 (setq tmphist (append (mapcar 'car org-stored-links)
6876 org-insert-link-history)) 7512 org-insert-link-history))
7513 (setq all-prefixes (append (mapcar 'car org-link-abbrev-alist-local)
7514 (mapcar 'car org-link-abbrev-alist)
7515 org-link-types))
6877 (unwind-protect 7516 (unwind-protect
6878 (setq link 7517 (progn
6879 (let ((org-completion-use-ido nil)) 7518 (setq link
6880 (org-completing-read 7519 (let ((org-completion-use-ido nil))
6881 "Link: " 7520 (org-completing-read
6882 (append 7521 "Link: "
6883 (mapcar (lambda (x) (list (concat (car x) ":"))) 7522 (append
6884 (append org-link-abbrev-alist-local org-link-abbrev-alist)) 7523 (mapcar (lambda (x) (list (concat x ":")))
6885 (mapcar (lambda (x) (list (concat x ":"))) 7524 all-prefixes)
6886 org-link-types)) 7525 (mapcar 'car org-stored-links))
6887 nil nil nil 7526 nil nil nil
6888 'tmphist 7527 'tmphist
6889 (or (car (car org-stored-links)))))) 7528 (car (car org-stored-links)))))
7529 (if (or (member link all-prefixes)
7530 (and (equal ":" (substring link -1))
7531 (member (substring link 0 -1) all-prefixes)
7532 (setq link (substring link 0 -1))))
7533 (setq link (org-link-try-special-completion link))))
6890 (set-window-configuration wcf) 7534 (set-window-configuration wcf)
6891 (kill-buffer "*Org Links*")) 7535 (kill-buffer "*Org Links*"))
6892 (setq entry (assoc link org-stored-links)) 7536 (setq entry (assoc link org-stored-links))
@@ -6948,6 +7592,34 @@ used as the link location instead of reading one interactively."
6948 (if remove (apply 'delete-region remove)) 7592 (if remove (apply 'delete-region remove))
6949 (insert (org-make-link-string link desc)))) 7593 (insert (org-make-link-string link desc))))
6950 7594
7595(defun org-link-try-special-completion (type)
7596 "If there is completion support for link type TYPE, offer it."
7597 (let ((fun (intern (concat "org-" type "-complete-link"))))
7598 (if (functionp fun)
7599 (funcall fun)
7600 (read-string "Link (no completion support): " (concat type ":")))))
7601
7602(defun org-file-complete-link (&optional arg)
7603 "Create a file link using completion."
7604 (let (file link)
7605 (setq file (read-file-name "File: "))
7606 (let ((pwd (file-name-as-directory (expand-file-name ".")))
7607 (pwd1 (file-name-as-directory (abbreviate-file-name
7608 (expand-file-name ".")))))
7609 (cond
7610 ((equal arg '(16))
7611 (setq link (org-make-link
7612 "file:"
7613 (abbreviate-file-name (expand-file-name file)))))
7614 ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
7615 (setq link (org-make-link "file:" (match-string 1 file))))
7616 ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
7617 (expand-file-name file))
7618 (setq link (org-make-link
7619 "file:" (match-string 1 (expand-file-name file)))))
7620 (t (setq link (org-make-link "file:" file)))))
7621 link))
7622
6951(defun org-completing-read (&rest args) 7623(defun org-completing-read (&rest args)
6952 "Completing-read with SPACE being a normal character." 7624 "Completing-read with SPACE being a normal character."
6953 (let ((minibuffer-local-completion-map 7625 (let ((minibuffer-local-completion-map
@@ -6966,7 +7638,12 @@ used as the link location instead of reading one interactively."
6966 (fboundp 'ido-completing-read) 7638 (fboundp 'ido-completing-read)
6967 (boundp 'ido-mode) ido-mode 7639 (boundp 'ido-mode) ido-mode
6968 (listp (second args))) 7640 (listp (second args)))
6969 (apply 'ido-completing-read (concat (car args)) (cdr args)) 7641 (let ((ido-enter-matching-directory nil))
7642 (apply 'ido-completing-read (concat (car args))
7643 (if (consp (car (nth 1 args)))
7644 (mapcar (lambda (x) (car x)) (nth 1 args))
7645 (nth 1 args))
7646 (cddr args)))
6970 (apply 'completing-read args))) 7647 (apply 'completing-read args)))
6971 7648
6972(defun org-extract-attributes (s) 7649(defun org-extract-attributes (s)
@@ -6982,6 +7659,14 @@ used as the link location instead of reading one interactively."
6982 (org-add-props s nil 'org-attr attr)) 7659 (org-add-props s nil 'org-attr attr))
6983 s)) 7660 s))
6984 7661
7662(defun org-extract-attributes-from-string (tag)
7663 (let (key value attr)
7664 (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"\\s-?" tag)
7665 (setq key (match-string 1 tag) value (match-string 2 tag)
7666 tag (replace-match "" t t tag)
7667 attr (plist-put attr (intern key) value)))
7668 (cons tag attr)))
7669
6985(defun org-attributes-to-string (plist) 7670(defun org-attributes-to-string (plist)
6986 "Format a property list into an HTML attribute list." 7671 "Format a property list into an HTML attribute list."
6987 (let ((s "") key value) 7672 (let ((s "") key value)
@@ -7101,17 +7786,18 @@ Org-mode syntax."
7101(defun org-open-link-from-string (s &optional arg) 7786(defun org-open-link-from-string (s &optional arg)
7102 "Open a link in the string S, as if it was in Org-mode." 7787 "Open a link in the string S, as if it was in Org-mode."
7103 (interactive "sLink: \nP") 7788 (interactive "sLink: \nP")
7104 (with-temp-buffer 7789 (let ((reference-buffer (current-buffer)))
7105 (let ((org-inhibit-startup t)) 7790 (with-temp-buffer
7106 (org-mode) 7791 (let ((org-inhibit-startup t))
7107 (insert s) 7792 (org-mode)
7108 (goto-char (point-min)) 7793 (insert s)
7109 (org-open-at-point arg)))) 7794 (goto-char (point-min))
7795 (org-open-at-point arg reference-buffer)))))
7110 7796
7111(defun org-open-at-point (&optional in-emacs) 7797(defun org-open-at-point (&optional in-emacs reference-buffer)
7112 "Open link at or after point. 7798 "Open link at or after point.
7113If there is no link at point, this function will search forward up to 7799If there is no link at point, this function will search forward up to
7114the end of the current subtree. 7800the end of the current line.
7115Normally, files will be opened by an appropriate application. If the 7801Normally, files will be opened by an appropriate application. If the
7116optional argument IN-EMACS is non-nil, Emacs will visit the file. 7802optional argument IN-EMACS is non-nil, Emacs will visit the file.
7117With a double prefix argument, try to open outside of Emacs, in the 7803With a double prefix argument, try to open outside of Emacs, in the
@@ -7125,7 +7811,7 @@ application the system uses for this file type."
7125 ((org-at-timestamp-p t) (org-follow-timestamp-link)) 7811 ((org-at-timestamp-p t) (org-follow-timestamp-link))
7126 ((or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) 7812 ((or (org-footnote-at-reference-p) (org-footnote-at-definition-p))
7127 (org-footnote-action)) 7813 (org-footnote-action))
7128 (t 7814 (t
7129 (let (type path link line search (pos (point))) 7815 (let (type path link line search (pos (point)))
7130 (catch 'match 7816 (catch 'match
7131 (save-excursion 7817 (save-excursion
@@ -7159,19 +7845,25 @@ application the system uses for this file type."
7159 (org-in-regexp org-plain-link-re)) 7845 (org-in-regexp org-plain-link-re))
7160 (setq type (match-string 1) path (match-string 2)) 7846 (setq type (match-string 1) path (match-string 2))
7161 (throw 'match t))) 7847 (throw 'match t)))
7162 (when (org-in-regexp "\\<\\([^><\n]+\\)\\>")
7163 (setq type "tree-match"
7164 path (match-string 1))
7165 (throw 'match t))
7166 (save-excursion 7848 (save-excursion
7167 (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) 7849 (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$"))
7168 (setq type "tags" 7850 (setq type "tags"
7169 path (match-string 1)) 7851 path (match-string 1))
7170 (while (string-match ":" path) 7852 (while (string-match ":" path)
7171 (setq path (replace-match "+" t t path))) 7853 (setq path (replace-match "+" t t path)))
7172 (throw 'match t)))) 7854 (throw 'match t)))
7855 (when (org-in-regexp "<\\([^><\n]+\\)>")
7856 (setq type "tree-match"
7857 path (match-string 1))
7858 (throw 'match t)))
7173 (unless path 7859 (unless path
7174 (error "No link found")) 7860 (error "No link found"))
7861
7862 ;; switch back to reference buffer
7863 ;; needed when if called in a temporary buffer through
7864 ;; org-open-link-from-string
7865 (and reference-buffer (switch-to-buffer reference-buffer))
7866
7175 ;; Remove any trailing spaces in path 7867 ;; Remove any trailing spaces in path
7176 (if (string-match " +\\'" path) 7868 (if (string-match " +\\'" path)
7177 (setq path (replace-match "" t t path))) 7869 (setq path (replace-match "" t t path)))
@@ -7347,6 +8039,18 @@ in all files. If AVOID-POS is given, ignore matches near that position."
7347 ;; First check if there are any special 8039 ;; First check if there are any special
7348 ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) 8040 ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
7349 ;; Now try the builtin stuff 8041 ;; Now try the builtin stuff
8042 ((and (equal (string-to-char s0) ?#)
8043 (> (length s0) 1)
8044 (save-excursion
8045 (goto-char (point-min))
8046 (and
8047 (re-search-forward
8048 (concat "^[ \t]*:CUSTOM_ID:[ \t]+" (regexp-quote (substring s0 1)) "[ \t]*$") nil t)
8049 (setq type 'dedicated
8050 pos (match-beginning 0))))
8051 ;; There is an exact target for this
8052 (goto-char pos)
8053 (org-back-to-heading t)))
7350 ((save-excursion 8054 ((save-excursion
7351 (goto-char (point-min)) 8055 (goto-char (point-min))
7352 (and 8056 (and
@@ -7732,8 +8436,10 @@ on the system \"/user@host:\"."
7732 8436
7733(defun org-get-refile-targets (&optional default-buffer) 8437(defun org-get-refile-targets (&optional default-buffer)
7734 "Produce a table with refile targets." 8438 "Produce a table with refile targets."
7735 (let ((entries (or org-refile-targets '((nil . (:level . 1))))) 8439 (let ((case-fold-search nil)
7736 targets txt re files f desc descre fast-path-p level) 8440 ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
8441 (entries (or org-refile-targets '((nil . (:level . 1)))))
8442 targets txt re files f desc descre fast-path-p level pos0)
7737 (message "Getting targets...") 8443 (message "Getting targets...")
7738 (with-current-buffer (or default-buffer (current-buffer)) 8444 (with-current-buffer (or default-buffer (current-buffer))
7739 (while (setq entry (pop entries)) 8445 (while (setq entry (pop entries))
@@ -7774,37 +8480,46 @@ on the system \"/user@host:\"."
7774 (set-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))) 8480 (set-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)))
7775 (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f)))) 8481 (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f))))
7776 (setq f (expand-file-name f)) 8482 (setq f (expand-file-name f))
8483 (if (eq org-refile-use-outline-path 'file)
8484 (push (list (file-name-nondirectory f) f nil nil) targets))
7777 (save-excursion 8485 (save-excursion
7778 (save-restriction 8486 (save-restriction
7779 (widen) 8487 (widen)
7780 (goto-char (point-min)) 8488 (goto-char (point-min))
7781 (while (re-search-forward descre nil t) 8489 (while (re-search-forward descre nil t)
7782 (goto-char (point-at-bol)) 8490 (goto-char (setq pos0 (point-at-bol)))
7783 (when (looking-at org-complex-heading-regexp) 8491 (catch 'next
7784 (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) 8492 (when org-refile-target-verify-function
7785 txt (org-link-display-format (match-string 4)) 8493 (save-match-data
7786 re (concat "^" (regexp-quote 8494 (or (funcall org-refile-target-verify-function)
7787 (buffer-substring (match-beginning 1) 8495 (throw 'next t))))
7788 (match-end 4))))) 8496 (when (looking-at org-complex-heading-regexp)
7789 (if (match-end 5) (setq re (concat re "[ \t]+" 8497 (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))
7790 (regexp-quote 8498 txt (org-link-display-format (match-string 4))
7791 (match-string 5))))) 8499 re (concat "^" (regexp-quote
7792 (setq re (concat re "[ \t]*$")) 8500 (buffer-substring (match-beginning 1)
7793 (when org-refile-use-outline-path 8501 (match-end 4)))))
7794 (setq txt (mapconcat 'org-protect-slash 8502 (if (match-end 5) (setq re (concat re "[ \t]+"
7795 (append 8503 (regexp-quote
7796 (if (eq org-refile-use-outline-path 'file) 8504 (match-string 5)))))
7797 (list (file-name-nondirectory 8505 (setq re (concat re "[ \t]*$"))
7798 (buffer-file-name (buffer-base-buffer)))) 8506 (when org-refile-use-outline-path
7799 (if (eq org-refile-use-outline-path 'full-file-path) 8507 (setq txt (mapconcat 'org-protect-slash
7800 (list (buffer-file-name (buffer-base-buffer))))) 8508 (append
7801 (org-get-outline-path fast-path-p level txt) 8509 (if (eq org-refile-use-outline-path 'file)
7802 (list txt)) 8510 (list (file-name-nondirectory
7803 "/"))) 8511 (buffer-file-name (buffer-base-buffer))))
7804 (push (list txt f re (point)) targets)) 8512 (if (eq org-refile-use-outline-path 'full-file-path)
7805 (goto-char (point-at-eol)))))))) 8513 (list (buffer-file-name (buffer-base-buffer)))))
8514 (org-get-outline-path fast-path-p level txt)
8515 (list txt))
8516 "/")))
8517 (push (list txt f re (point)) targets)))
8518 (when (= (point) pos0)
8519 ;; verification function has not moved point
8520 (goto-char (point-at-eol))))))))))
7806 (message "Getting targets...done") 8521 (message "Getting targets...done")
7807 (nreverse targets)))) 8522 (nreverse targets)))
7808 8523
7809(defun org-protect-slash (s) 8524(defun org-protect-slash (s)
7810 (while (string-match "/" s) 8525 (while (string-match "/" s)
@@ -7834,7 +8549,12 @@ on the system \"/user@host:\"."
7834(defvar org-refile-history nil 8549(defvar org-refile-history nil
7835 "History for refiling operations.") 8550 "History for refiling operations.")
7836 8551
7837(defun org-refile (&optional goto default-buffer) 8552(defvar org-after-refile-insert-hook nil
8553 "Hook run after `org-refile' has inserted its stuff at the new location.
8554Note that this is still *before* the stuff will be removed from
8555the *old* location.")
8556
8557(defun org-refile (&optional goto default-buffer rfloc)
7838 "Move the entry at point to another heading. 8558 "Move the entry at point to another heading.
7839The list of target headings is compiled using the information in 8559The list of target headings is compiled using the information in
7840`org-refile-targets', which see. This list is created before each use 8560`org-refile-targets', which see. This list is created before each use
@@ -7852,7 +8572,11 @@ below it are allowed.
7852With prefix arg GOTO, the command will only visit the target location, 8572With prefix arg GOTO, the command will only visit the target location,
7853not actually move anything. 8573not actually move anything.
7854With a double prefix `C-u C-u', go to the location where the last refiling 8574With a double prefix `C-u C-u', go to the location where the last refiling
7855operation has put the subtree." 8575operation has put the subtree.
8576
8577RFLOC can be a refile location obtained in a different way.
8578
8579See also `org-refile-use-outline-path' and `org-completion-use-ido'"
7856 (interactive "P") 8580 (interactive "P")
7857 (let* ((cbuf (current-buffer)) 8581 (let* ((cbuf (current-buffer))
7858 (regionp (org-region-active-p)) 8582 (regionp (org-region-active-p))
@@ -7861,18 +8585,26 @@ operation has put the subtree."
7861 (region-length (and regionp (- region-end region-start))) 8585 (region-length (and regionp (- region-end region-start)))
7862 (filename (buffer-file-name (buffer-base-buffer cbuf))) 8586 (filename (buffer-file-name (buffer-base-buffer cbuf)))
7863 pos it nbuf file re level reversed) 8587 pos it nbuf file re level reversed)
7864 (when regionp (goto-char region-start) 8588 (when regionp
7865 (unless (org-kill-is-subtree-p 8589 (goto-char region-start)
7866 (buffer-substring region-start region-end)) 8590 (or (bolp) (goto-char (point-at-bol)))
7867 (error "The region is not a (sequence of) subtree(s)"))) 8591 (setq region-start (point))
8592 (unless (org-kill-is-subtree-p
8593 (buffer-substring region-start region-end))
8594 (error "The region is not a (sequence of) subtree(s)")))
7868 (if (equal goto '(16)) 8595 (if (equal goto '(16))
7869 (org-refile-goto-last-stored) 8596 (org-refile-goto-last-stored)
7870 (when (setq it (org-refile-get-location 8597 (when (setq it (or rfloc
7871 (if goto "Goto: " "Refile to: ") default-buffer)) 8598 (save-excursion
8599 (org-refile-get-location
8600 (if goto "Goto: " "Refile to: ") default-buffer
8601 org-refile-allow-creating-parent-nodes))))
7872 (setq file (nth 1 it) 8602 (setq file (nth 1 it)
7873 re (nth 2 it) 8603 re (nth 2 it)
7874 pos (nth 3 it)) 8604 pos (nth 3 it))
7875 (if (and (equal (buffer-file-name) file) 8605 (if (and (not goto)
8606 pos
8607 (equal (buffer-file-name) file)
7876 (if regionp 8608 (if regionp
7877 (and (>= pos region-start) 8609 (and (>= pos region-start)
7878 (<= pos region-end)) 8610 (<= pos region-end))
@@ -7880,7 +8612,7 @@ operation has put the subtree."
7880 (< pos (save-excursion 8612 (< pos (save-excursion
7881 (org-end-of-subtree t t)))))) 8613 (org-end-of-subtree t t))))))
7882 (error "Cannot refile to position inside the tree or region")) 8614 (error "Cannot refile to position inside the tree or region"))
7883 8615
7884 (setq nbuf (or (find-buffer-visiting file) 8616 (setq nbuf (or (find-buffer-visiting file)
7885 (find-file-noselect file))) 8617 (find-file-noselect file)))
7886 (if goto 8618 (if goto
@@ -7890,7 +8622,7 @@ operation has put the subtree."
7890 (org-show-context 'org-goto)) 8622 (org-show-context 'org-goto))
7891 (if regionp 8623 (if regionp
7892 (progn 8624 (progn
7893 (kill-new (buffer-substring region-start region-end)) 8625 (org-kill-new (buffer-substring region-start region-end))
7894 (org-save-markers-in-region region-start region-end)) 8626 (org-save-markers-in-region region-start region-end))
7895 (org-copy-subtree 1 nil t)) 8627 (org-copy-subtree 1 nil t))
7896 (save-excursion 8628 (save-excursion
@@ -7900,23 +8632,35 @@ operation has put the subtree."
7900 (save-excursion 8632 (save-excursion
7901 (save-restriction 8633 (save-restriction
7902 (widen) 8634 (widen)
7903 (goto-char pos) 8635 (if pos
7904 (looking-at outline-regexp) 8636 (progn
7905 (setq level (org-get-valid-level (funcall outline-level) 1)) 8637 (goto-char pos)
7906 (goto-char 8638 (looking-at outline-regexp)
7907 (if reversed 8639 (setq level (org-get-valid-level (funcall outline-level) 1))
7908 (or (outline-next-heading) (point-max)) 8640 (goto-char
7909 (or (save-excursion (outline-get-next-sibling)) 8641 (if reversed
7910 (org-end-of-subtree t t) 8642 (or (outline-next-heading) (point-max))
7911 (point-max)))) 8643 (or (save-excursion (outline-get-next-sibling))
8644 (org-end-of-subtree t t)
8645 (point-max)))))
8646 (setq level 1)
8647 (if (not reversed)
8648 (goto-char (point-max))
8649 (goto-char (point-min))
8650 (or (outline-next-heading) (goto-char (point-max)))))
7912 (if (not (bolp)) (newline)) 8651 (if (not (bolp)) (newline))
7913 (bookmark-set "org-refile-last-stored") 8652 (bookmark-set "org-refile-last-stored")
7914 (org-paste-subtree level)))) 8653 (org-paste-subtree level)
8654 (if (fboundp 'deactivate-mark) (deactivate-mark))
8655 (run-hooks 'org-after-refile-insert-hook))))
7915 (if regionp 8656 (if regionp
7916 (delete-region (point) (+ (point) region-length)) 8657 (delete-region (point) (+ (point) region-length))
7917 (org-cut-subtree)) 8658 (org-cut-subtree))
8659 (when (featurep 'org-inlinetask)
8660 (org-inlinetask-remove-END-maybe))
7918 (setq org-markers-to-move nil) 8661 (setq org-markers-to-move nil)
7919 (message "Refiled to \"%s\"" (car it))))))) 8662 (message "Refiled to \"%s\"" (car it))))))
8663 (org-reveal))
7920 8664
7921(defun org-refile-goto-last-stored () 8665(defun org-refile-goto-last-stored ()
7922 "Go to the location where the last refile was stored." 8666 "Go to the location where the last refile was stored."
@@ -7924,7 +8668,7 @@ operation has put the subtree."
7924 (bookmark-jump "org-refile-last-stored") 8668 (bookmark-jump "org-refile-last-stored")
7925 (message "This is the location of the last refile")) 8669 (message "This is the location of the last refile"))
7926 8670
7927(defun org-refile-get-location (&optional prompt default-buffer) 8671(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
7928 "Prompt the user for a refile location, using PROMPT." 8672 "Prompt the user for a refile location, using PROMPT."
7929 (let ((org-refile-targets org-refile-targets) 8673 (let ((org-refile-targets org-refile-targets)
7930 (org-refile-use-outline-path org-refile-use-outline-path)) 8674 (org-refile-use-outline-path org-refile-use-outline-path))
@@ -7932,6 +8676,7 @@ operation has put the subtree."
7932 (unless org-refile-target-table 8676 (unless org-refile-target-table
7933 (error "No refile targets")) 8677 (error "No refile targets"))
7934 (let* ((cbuf (current-buffer)) 8678 (let* ((cbuf (current-buffer))
8679 (partial-completion-mode nil)
7935 (cfn (buffer-file-name (buffer-base-buffer cbuf))) 8680 (cfn (buffer-file-name (buffer-base-buffer cbuf)))
7936 (cfunc (if (and org-refile-use-outline-path 8681 (cfunc (if (and org-refile-use-outline-path
7937 org-outline-path-complete-in-steps) 8682 org-outline-path-complete-in-steps)
@@ -7941,19 +8686,72 @@ operation has put the subtree."
7941 (filename (and cfn (expand-file-name cfn))) 8686 (filename (and cfn (expand-file-name cfn)))
7942 (tbl (mapcar 8687 (tbl (mapcar
7943 (lambda (x) 8688 (lambda (x)
7944 (if (not (equal filename (nth 1 x))) 8689 (if (and (not (member org-refile-use-outline-path
8690 '(file full-file-path)))
8691 (not (equal filename (nth 1 x))))
7945 (cons (concat (car x) extra " (" 8692 (cons (concat (car x) extra " ("
7946 (file-name-nondirectory (nth 1 x)) ")") 8693 (file-name-nondirectory (nth 1 x)) ")")
7947 (cdr x)) 8694 (cdr x))
7948 (cons (concat (car x) extra) (cdr x)))) 8695 (cons (concat (car x) extra) (cdr x))))
7949 org-refile-target-table)) 8696 org-refile-target-table))
7950 (completion-ignore-case t)) 8697 (completion-ignore-case t)
7951 (assoc (funcall cfunc prompt tbl nil t nil 'org-refile-history) 8698 pa answ parent-target child parent old-hist)
7952 tbl))) 8699 (setq old-hist org-refile-history)
8700 (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
8701 nil 'org-refile-history))
8702 (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl)))
8703 (if pa
8704 (progn
8705 (when (or (not org-refile-history)
8706 (not (eq old-hist org-refile-history))
8707 (not (equal (car pa) (car org-refile-history))))
8708 (setq org-refile-history
8709 (cons (car pa) (if (assoc (car org-refile-history) tbl)
8710 org-refile-history
8711 (cdr org-refile-history))))
8712 (if (equal (car org-refile-history) (nth 1 org-refile-history))
8713 (pop org-refile-history)))
8714 pa)
8715 (when (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
8716 (setq parent (match-string 1 answ)
8717 child (match-string 2 answ))
8718 (setq parent-target (or (assoc parent tbl) (assoc (concat parent "/") tbl)))
8719 (when (and parent-target
8720 (or (eq new-nodes t)
8721 (and (eq new-nodes 'confirm)
8722 (y-or-n-p (format "Create new node \"%s\"? " child)))))
8723 (org-refile-new-child parent-target child))))))
8724
8725(defun org-refile-new-child (parent-target child)
8726 "Use refile target PARENT-TARGET to add new CHILD below it."
8727 (unless parent-target
8728 (error "Cannot find parent for new node"))
8729 (let ((file (nth 1 parent-target))
8730 (pos (nth 3 parent-target))
8731 level)
8732 (with-current-buffer (or (find-buffer-visiting file)
8733 (find-file-noselect file))
8734 (save-excursion
8735 (save-restriction
8736 (widen)
8737 (if pos
8738 (goto-char pos)
8739 (goto-char (point-max))
8740 (if (not (bolp)) (newline)))
8741 (when (looking-at outline-regexp)
8742 (setq level (funcall outline-level))
8743 (org-end-of-subtree t t))
8744 (org-back-over-empty-lines)
8745 (insert "\n" (make-string
8746 (if pos (org-get-valid-level level 1) 1) ?*)
8747 " " child "\n")
8748 (beginning-of-line 0)
8749 (list (concat (car parent-target) "/" child) file "" (point)))))))
7953 8750
7954(defun org-olpath-completing-read (prompt collection &rest args) 8751(defun org-olpath-completing-read (prompt collection &rest args)
7955 "Read an outline path like a file name." 8752 "Read an outline path like a file name."
7956 (let ((thetable collection)) 8753 (let ((thetable collection)
8754 (org-completion-use-ido nil)) ; does not work with ido.
7957 (apply 8755 (apply
7958 'org-ido-completing-read prompt 8756 'org-ido-completing-read prompt
7959 (lambda (string predicate &optional flag) 8757 (lambda (string predicate &optional flag)
@@ -8102,13 +8900,19 @@ This function can be used in a hook."
8102;;;; Completion 8900;;;; Completion
8103 8901
8104(defconst org-additional-option-like-keywords 8902(defconst org-additional-option-like-keywords
8105 '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX" 8903 '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML"
8106 "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "TBLFM" 8904 "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook"
8905 "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:" "ATTR_LaTeX"
8906 "BEGIN:" "END:"
8907 "ORGTBL" "TBLFM:" "TBLNAME:"
8107 "BEGIN_EXAMPLE" "END_EXAMPLE" 8908 "BEGIN_EXAMPLE" "END_EXAMPLE"
8108 "BEGIN_QUOTE" "END_QUOTE" 8909 "BEGIN_QUOTE" "END_QUOTE"
8109 "BEGIN_VERSE" "END_VERSE" 8910 "BEGIN_VERSE" "END_VERSE"
8911 "BEGIN_CENTER" "END_CENTER"
8110 "BEGIN_SRC" "END_SRC" 8912 "BEGIN_SRC" "END_SRC"
8111 "CAPTION" "LABEL" "ATTR_HTML" "ATTR_LaTeX")) 8913 "CATEGORY" "COLUMNS"
8914 "CAPTION" "LABEL"
8915 "BIND"))
8112 8916
8113(defcustom org-structure-template-alist 8917(defcustom org-structure-template-alist
8114 '( 8918 '(
@@ -8120,6 +8924,8 @@ This function can be used in a hook."
8120 "<quote>\n?\n</quote>") 8924 "<quote>\n?\n</quote>")
8121 ("v" "#+begin_verse\n?\n#+end_verse" 8925 ("v" "#+begin_verse\n?\n#+end_verse"
8122 "<verse>\n?\n/verse>") 8926 "<verse>\n?\n/verse>")
8927 ("c" "#+begin_center\n?\n#+end_center"
8928 "<center>\n?\n/center>")
8123 ("l" "#+begin_latex\n?\n#+end_latex" 8929 ("l" "#+begin_latex\n?\n#+end_latex"
8124 "<literal style=\"latex\">\n?\n</literal>") 8930 "<literal style=\"latex\">\n?\n</literal>")
8125 ("L" "#+latex: " 8931 ("L" "#+latex: "
@@ -8165,13 +8971,14 @@ expands them."
8165(defun org-complete-expand-structure-template (start cell) 8971(defun org-complete-expand-structure-template (start cell)
8166 "Expand a structure template." 8972 "Expand a structure template."
8167 (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates)) 8973 (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates))
8168 (rpl (nth (if musep 2 1) cell))) 8974 (rpl (nth (if musep 2 1) cell))
8975 (ind ""))
8169 (delete-region start (point)) 8976 (delete-region start (point))
8170 (when (string-match "\\`#\\+" rpl) 8977 (when (string-match "\\`#\\+" rpl)
8171 (cond 8978 (cond
8172 ((bolp)) 8979 ((bolp))
8173 ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point)))) 8980 ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point))))
8174 (delete-region (point-at-bol) (point))) 8981 (setq ind (buffer-substring (point-at-bol) (point))))
8175 (t (newline)))) 8982 (t (newline))))
8176 (setq start (point)) 8983 (setq start (point))
8177 (if (string-match "%file" rpl) 8984 (if (string-match "%file" rpl)
@@ -8182,6 +8989,8 @@ expands them."
8182 (abbreviate-file-name (read-file-name "Include file: "))) 8989 (abbreviate-file-name (read-file-name "Include file: ")))
8183 "\"") 8990 "\"")
8184 t t rpl))) 8991 t t rpl)))
8992 (setq rpl (mapconcat 'identity (split-string rpl "\n")
8993 (concat "\n" ind)))
8185 (insert rpl) 8994 (insert rpl)
8186 (if (re-search-backward "\\?" start t) (delete-char 1)))) 8995 (if (re-search-backward "\\?" start t) (delete-char 1))))
8187 8996
@@ -8352,7 +9161,20 @@ this is nil.")
8352 (push (nth 2 e) rtn))) 9161 (push (nth 2 e) rtn)))
8353 rtn))))) 9162 rtn)))))
8354 9163
9164(defvar org-todo-setup-filter-hook nil
9165 "Hook for functions that pre-filter todo specs.
9166
9167Each function takes a todo spec and returns either `nil' or the spec
9168transformed into canonical form." )
9169
9170(defvar org-todo-get-default-hook nil
9171 "Hook for functions that get a default item for todo.
9172
9173Each function takes arguments (NEW-MARK OLD-MARK) and returns either
9174`nil' or a string to be used for the todo mark." )
9175
8355(defvar org-agenda-headline-snapshot-before-repeat) 9176(defvar org-agenda-headline-snapshot-before-repeat)
9177
8356(defun org-todo (&optional arg) 9178(defun org-todo (&optional arg)
8357 "Change the TODO state of an item. 9179 "Change the TODO state of an item.
8358The state of an item is given by a keyword at the start of the heading, 9180The 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:
8381 really is a member of `org-todo-keywords'." 9203 really is a member of `org-todo-keywords'."
8382 (interactive "P") 9204 (interactive "P")
8383 (if (equal arg '(16)) (setq arg 'nextset)) 9205 (if (equal arg '(16)) (setq arg 'nextset))
8384 (let ((org-blocker-hook org-blocker-hook)) 9206 (let ((org-blocker-hook org-blocker-hook)
9207 (case-fold-search nil))
8385 (when (equal arg '(64)) 9208 (when (equal arg '(64))
8386 (setq arg nil org-blocker-hook nil)) 9209 (setq arg nil org-blocker-hook nil))
9210 (when (and org-blocker-hook
9211 (or org-inhibit-blocking
9212 (org-entry-get nil "NOBLOCKING")))
9213 (setq org-blocker-hook nil))
8387 (save-excursion 9214 (save-excursion
8388 (catch 'exit 9215 (catch 'exit
8389 (org-back-to-heading) 9216 (org-back-to-heading)
8390 (if (looking-at outline-regexp) (goto-char (1- (match-end 0)))) 9217 (if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
8391 (or (looking-at (concat " +" org-todo-regexp " *")) 9218 (or (looking-at (concat " +" org-todo-regexp "\\( +\\|$\\)"))
8392 (looking-at " *")) 9219 (looking-at " *"))
8393 (let* ((match-data (match-data)) 9220 (let* ((match-data (match-data))
8394 (startpos (point-at-bol)) 9221 (startpos (point-at-bol))
@@ -8457,15 +9284,18 @@ For calling through lisp, arg is also interpreted in the following way:
8457 ((null member) (or head (car org-todo-keywords-1))) 9284 ((null member) (or head (car org-todo-keywords-1)))
8458 ((equal this final-done-word) nil) ;; -> make empty 9285 ((equal this final-done-word) nil) ;; -> make empty
8459 ((null tail) nil) ;; -> first entry 9286 ((null tail) nil) ;; -> first entry
8460 ((eq interpret 'sequence)
8461 (car tail))
8462 ((memq interpret '(type priority)) 9287 ((memq interpret '(type priority))
8463 (if (eq this-command last-command) 9288 (if (eq this-command last-command)
8464 (car tail) 9289 (car tail)
8465 (if (> (length tail) 0) 9290 (if (> (length tail) 0)
8466 (or done-word (car org-done-keywords)) 9291 (or done-word (car org-done-keywords))
8467 nil))) 9292 nil)))
8468 (t nil))) 9293 (t
9294 (car tail))))
9295 (state (or
9296 (run-hook-with-args-until-success
9297 'org-todo-get-default-hook state last-state)
9298 state))
8469 (next (if state (concat " " state " ") " ")) 9299 (next (if state (concat " " state " ") " "))
8470 (change-plist (list :type 'todo-state-change :from this :to state 9300 (change-plist (list :type 'todo-state-change :from this :to state
8471 :position startpos)) 9301 :position startpos))
@@ -8504,10 +9334,13 @@ For calling through lisp, arg is also interpreted in the following way:
8504 (not (member this org-done-keywords)))) 9334 (not (member this org-done-keywords))))
8505 (and logging (org-local-logging logging)) 9335 (and logging (org-local-logging logging))
8506 (when (and (or org-todo-log-states org-log-done) 9336 (when (and (or org-todo-log-states org-log-done)
9337 (not (eq org-inhibit-logging t))
8507 (not (memq arg '(nextset previousset)))) 9338 (not (memq arg '(nextset previousset))))
8508 ;; we need to look at recording a time and note 9339 ;; we need to look at recording a time and note
8509 (setq dolog (or (nth 1 (assoc state org-todo-log-states)) 9340 (setq dolog (or (nth 1 (assoc state org-todo-log-states))
8510 (nth 2 (assoc this org-todo-log-states)))) 9341 (nth 2 (assoc this org-todo-log-states))))
9342 (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
9343 (setq dolog 'time))
8511 (when (and state 9344 (when (and state
8512 (member state org-not-done-keywords) 9345 (member state org-not-done-keywords)
8513 (not (member this org-not-done-keywords))) 9346 (not (member this org-not-done-keywords)))
@@ -8518,10 +9351,10 @@ For calling through lisp, arg is also interpreted in the following way:
8518 ;; It is now done, and it was not done before 9351 ;; It is now done, and it was not done before
8519 (org-add-planning-info 'closed (org-current-time)) 9352 (org-add-planning-info 'closed (org-current-time))
8520 (if (and (not dolog) (eq 'note org-log-done)) 9353 (if (and (not dolog) (eq 'note org-log-done))
8521 (org-add-log-setup 'done state 'findpos 'note))) 9354 (org-add-log-setup 'done state this 'findpos 'note)))
8522 (when (and state dolog) 9355 (when (and state dolog)
8523 ;; This is a non-nil state, and we need to log it 9356 ;; This is a non-nil state, and we need to log it
8524 (org-add-log-setup 'state state 'findpos dolog))) 9357 (org-add-log-setup 'state state this 'findpos dolog)))
8525 ;; Fixup tag positioning 9358 ;; Fixup tag positioning
8526 (org-todo-trigger-tag-changes state) 9359 (org-todo-trigger-tag-changes state)
8527 (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) 9360 (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:
8547 (< (point) (+ 2 (or (match-end 2) (match-end 1))))) 9380 (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
8548 (progn 9381 (progn
8549 (goto-char (or (match-end 2) (match-end 1))) 9382 (goto-char (or (match-end 2) (match-end 1)))
8550 (just-one-space))) 9383 (and (looking-at " ") (just-one-space))))
8551 (when org-trigger-hook 9384 (when org-trigger-hook
8552 (save-excursion 9385 (save-excursion
8553 (run-hook-with-args 'org-trigger-hook change-plist)))))))) 9386 (run-hook-with-args 'org-trigger-hook change-plist))))))))
8554 9387
8555(defun org-block-todo-from-children-or-siblings (change-plist) 9388(defun org-block-todo-from-children-or-siblings-or-parent (change-plist)
8556 "Block turning an entry into a TODO, using the hierarchy. 9389 "Block turning an entry into a TODO, using the hierarchy.
8557This checks whether the current task should be blocked from state 9390This checks whether the current task should be blocked from state
8558changes. Such blocking occurs when: 9391changes. Such blocking occurs when:
@@ -8561,7 +9394,11 @@ changes. Such blocking occurs when:
8561 9394
8562 2. A task has a parent with the property :ORDERED:, and there 9395 2. A task has a parent with the property :ORDERED:, and there
8563 are siblings prior to the current task with incomplete 9396 are siblings prior to the current task with incomplete
8564 status." 9397 status.
9398
9399 3. The parent of the task is blocked because it has siblings that should
9400 be done first, or is child of a block grandparent TODO entry."
9401
8565 (catch 'dont-block 9402 (catch 'dont-block
8566 ;; If this is not a todo state change, or if this entry is already DONE, 9403 ;; If this is not a todo state change, or if this entry is already DONE,
8567 ;; do not block 9404 ;; do not block
@@ -8590,36 +9427,64 @@ changes. Such blocking occurs when:
8590 ;; any previous siblings are undone, it's blocked 9427 ;; any previous siblings are undone, it's blocked
8591 (save-excursion 9428 (save-excursion
8592 (org-back-to-heading t) 9429 (org-back-to-heading t)
8593 (when (save-excursion 9430 (let* ((pos (point))
8594 (ignore-errors 9431 (parent-pos (and (org-up-heading-safe) (point))))
8595 (org-up-heading-all 1) 9432 (if (not parent-pos) (throw 'dont-block t)) ; no parent
8596 (org-entry-get (point) "ORDERED"))) 9433 (when (and (org-entry-get (point) "ORDERED")
8597 (let* ((this-level (funcall outline-level)) 9434 (forward-line 1)
8598 (current-level this-level)) 9435 (re-search-forward org-not-done-heading-regexp pos t))
8599 (while (and (not (bobp)) 9436 (throw 'dont-block nil)) ; block, there is an older sibling not done.
8600 (= current-level this-level)) 9437 ;; Search further up the hierarchy, to see if an anchestor is blocked
8601 (outline-previous-heading) 9438 (while t
8602 (setq current-level (funcall outline-level)) 9439 (goto-char parent-pos)
8603 (if (= current-level this-level) 9440 (if (not (looking-at org-not-done-heading-regexp))
8604 ;; this todo has children, check whether they are all 9441 (throw 'dont-block t)) ; do not block, parent is not a TODO
8605 ;; completed 9442 (setq pos (point))
8606 (if (and (not (org-entry-is-done-p)) 9443 (setq parent-pos (and (org-up-heading-safe) (point)))
8607 (org-entry-is-todo-p)) 9444 (if (not parent-pos) (throw 'dont-block t)) ; no parent
8608 (throw 'dont-block nil))))))) 9445 (when (and (org-entry-get (point) "ORDERED")
8609 t)) ; don't block 9446 (forward-line 1)
9447 (re-search-forward org-not-done-heading-regexp pos t))
9448 (throw 'dont-block nil))))))) ; block, older sibling not done.
9449
9450(defcustom org-track-ordered-property-with-tag nil
9451 "Should the ORDERED property also be shown as a tag?
9452The ORDERED property decides if an entry should require subtasks to be
9453completed in sequence. Since a property is not very visible, setting
9454this option means that toggling the ORDERED property with the command
9455`org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is
9456not relevant for the behavior, but it makes things more visible.
9457
9458Note that toggling the tag with tags commands will not change the property
9459and therefore not influence behavior!
9460
9461This can be t, meaning the tag ORDERED should be used, It can also be a
9462string to select a different tag for this task."
9463 :group 'org-todo
9464 :type '(choice
9465 (const :tag "No tracking" nil)
9466 (const :tag "Track with ORDERED tag" t)
9467 (string :tag "Use other tag")))
8610 9468
8611(defun org-toggle-ordered-property () 9469(defun org-toggle-ordered-property ()
8612 "Toggle the ORDERED property of the current entry." 9470 "Toggle the ORDERED property of the current entry.
9471For better visibility, you can track the value of this property with a tag.
9472See variable `org-track-ordered-property-with-tag'."
8613 (interactive) 9473 (interactive)
8614 (save-excursion 9474 (let* ((t1 org-track-ordered-property-with-tag)
8615 (org-back-to-heading) 9475 (tag (and t1 (if (stringp t1) t1 "ORDERED"))))
8616 (if (org-entry-get nil "ORDERED") 9476 (save-excursion
8617 (progn 9477 (org-back-to-heading)
8618 (org-delete-property "ORDERED") 9478 (if (org-entry-get nil "ORDERED")
8619 (message "Subtasks can be completed in arbitrary order or parallel")) 9479 (progn
8620 (org-entry-put nil "ORDERED" "t") 9480 (org-delete-property "ORDERED")
8621 (message "Subtasks must be completed in sequence")))) 9481 (and tag (org-toggle-tag tag 'off))
8622 9482 (message "Subtasks can be completed in arbitrary order"))
9483 (org-entry-put nil "ORDERED" "t")
9484 (and tag (org-toggle-tag tag 'on))
9485 (message "Subtasks must be completed in sequence")))))
9486
9487(defvar org-blocked-by-checkboxes) ; dynamically scoped
8623(defun org-block-todo-from-checkboxes (change-plist) 9488(defun org-block-todo-from-checkboxes (change-plist)
8624 "Block turning an entry into a TODO, using checkboxes. 9489 "Block turning an entry into a TODO, using checkboxes.
8625This checks whether the current task should be blocked from state 9490This checks whether the current task should be blocked from state
@@ -8642,39 +9507,77 @@ changes because there are uncheckd boxes in this entry."
8642 (goto-char beg) 9507 (goto-char beg)
8643 (if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]" 9508 (if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]"
8644 end t) 9509 end t)
8645 (throw 'dont-block nil)))) 9510 (progn
9511 (if (boundp 'org-blocked-by-checkboxes)
9512 (setq org-blocked-by-checkboxes t))
9513 (throw 'dont-block nil)))))
8646 t)) ; do not block 9514 t)) ; do not block
8647 9515
9516(defvar org-entry-property-inherited-from) ;; defined below
8648(defun org-update-parent-todo-statistics () 9517(defun org-update-parent-todo-statistics ()
8649 "Update any statistics cookie in the parent of the current headline." 9518 "Update any statistics cookie in the parent of the current headline.
9519When `org-hierarchical-todo-statistics' is nil, statistics will cover
9520the entire subtree and this will travel up the hierarchy and update
9521statistics everywhere."
8650 (interactive) 9522 (interactive)
8651 (let ((box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") 9523 (let* ((lim 0) prop
8652 level (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present) 9524 (recursive (or (not org-hierarchical-todo-statistics)
9525 (string-match
9526 "\\<recursive\\>"
9527 (or (setq prop (org-entry-get
9528 nil "COOKIE_DATA" 'inherit)) ""))))
9529 (lim (or (and prop (marker-position
9530 org-entry-property-inherited-from))
9531 lim))
9532 (first t)
9533 (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
9534 level ltoggle l1
9535 (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present)
8653 (catch 'exit 9536 (catch 'exit
8654 (save-excursion 9537 (save-excursion
8655 (setq level (org-up-heading-safe)) 9538 (beginning-of-line 1)
8656 (unless level 9539 (if (org-at-heading-p)
8657 (throw 'exit nil)) 9540 (setq ltoggle (funcall outline-level))
8658 (while (re-search-forward box-re (point-at-eol) t) 9541 (error "This should not happen"))
8659 (setq cnt-all 0 cnt-done 0 cookie-present t) 9542 (while (and (setq level (org-up-heading-safe))
8660 (setq is-percent (match-end 2)) 9543 (or recursive first)
8661 (save-match-data 9544 (>= (point) lim))
8662 (unless (outline-next-heading) (throw 'exit nil)) 9545 (setq first nil)
8663 (while (looking-at org-todo-line-regexp) 9546 (unless (and level
8664 (setq kwd (match-string 2)) 9547 (not (string-match
8665 (and kwd (setq cnt-all (1+ cnt-all))) 9548 "\\<checkbox\\>"
8666 (and (member kwd org-done-keywords) 9549 (downcase
8667 (setq cnt-done (1+ cnt-done))) 9550 (or (org-entry-get
8668 (condition-case nil 9551 nil "COOKIE_DATA")
8669 (org-forward-same-level 1) 9552 "")))))
8670 (error (end-of-line 1))))) 9553 (throw 'exit nil))
8671 (replace-match 9554 (while (re-search-forward box-re (point-at-eol) t)
8672 (if is-percent 9555 (setq cnt-all 0 cnt-done 0 cookie-present t)
8673 (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) 9556 (setq is-percent (match-end 2))
8674 (format "[%d/%d]" cnt-done cnt-all)))) 9557 (save-match-data
9558 (unless (outline-next-heading) (throw 'exit nil))
9559 (while (and (looking-at org-complex-heading-regexp)
9560 (> (setq l1 (length (match-string 1))) level))
9561 (setq kwd (and (or recursive (= l1 ltoggle))
9562 (match-string 2)))
9563 (if (or (eq org-provide-todo-statistics 'all-headlines)
9564 (and (listp org-provide-todo-statistics)
9565 (or (member kwd org-provide-todo-statistics)
9566 (member kwd org-done-keywords))))
9567 (setq cnt-all (1+ cnt-all))
9568 (if (eq org-provide-todo-statistics t)
9569 (and kwd (setq cnt-all (1+ cnt-all)))))
9570 (and (member kwd org-done-keywords)
9571 (setq cnt-done (1+ cnt-done)))
9572 (outline-next-heading)))
9573 (replace-match
9574 (if is-percent
9575 (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
9576 (format "[%d/%d]" cnt-done cnt-all)))))
8675 (when cookie-present 9577 (when cookie-present
8676 (run-hook-with-args 'org-after-todo-statistics-hook 9578 (run-hook-with-args 'org-after-todo-statistics-hook
8677 cnt-done (- cnt-all cnt-done))))))) 9579 cnt-done (- cnt-all cnt-done)))))
9580 (run-hooks 'org-todo-statistics-hook)))
8678 9581
8679(defvar org-after-todo-statistics-hook nil 9582(defvar org-after-todo-statistics-hook nil
8680 "Hook that is called after a TODO statistics cookie has been updated. 9583 "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!
8692 (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\")))) 9595 (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\"))))
8693") 9596")
8694 9597
9598(defvar org-todo-statistics-hook nil
9599 "Hook that is run whenever Org thinks TODO statistics should be updated.
9600This hook runs even if there is no statisics cookie present, in which case
9601`org-after-todo-statistics-hook' would not run.")
9602
8695(defun org-todo-trigger-tag-changes (state) 9603(defun org-todo-trigger-tag-changes (state)
8696 "Apply the changes defined in `org-todo-state-tags-triggers'." 9604 "Apply the changes defined in `org-todo-state-tags-triggers'."
8697 (let ((l org-todo-state-tags-triggers) 9605 (let ((l org-todo-state-tags-triggers)
@@ -8773,6 +9681,14 @@ Returns the new TODO keyword, or nil if no state change should occur."
8773 ((equal e '(:endgroup)) 9681 ((equal e '(:endgroup))
8774 (setq ingroup nil cnt 0) 9682 (setq ingroup nil cnt 0)
8775 (insert "}\n")) 9683 (insert "}\n"))
9684 ((equal e '(:newline))
9685 (when (not (= cnt 0))
9686 (setq cnt 0)
9687 (insert "\n")
9688 (setq e (car tbl))
9689 (while (equal (car tbl) '(:newline))
9690 (insert "\n")
9691 (setq tbl (cdr tbl)))))
8776 (t 9692 (t
8777 (setq tg (car e) c (cdr e)) 9693 (setq tg (car e) c (cdr e))
8778 (if ingroup (push tg (car groups))) 9694 (if ingroup (push tg (car groups)))
@@ -8864,6 +9780,8 @@ This function is run automatically after each state change to a DONE state."
8864 (when repeat 9780 (when repeat
8865 (if (eq org-log-repeat t) (setq org-log-repeat 'state)) 9781 (if (eq org-log-repeat t) (setq org-log-repeat 'state))
8866 (org-todo (if (eq interpret 'type) last-state head)) 9782 (org-todo (if (eq interpret 'type) last-state head))
9783 (org-entry-put nil "LAST_REPEAT" (format-time-string
9784 (org-time-stamp-format t t)))
8867 (when org-log-repeat 9785 (when org-log-repeat
8868 (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) 9786 (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
8869 (memq 'org-add-log-note post-command-hook)) 9787 (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."
8873 (setq org-log-note-how 'note)) 9791 (setq org-log-note-how 'note))
8874 ;; Set up for taking a record 9792 ;; Set up for taking a record
8875 (org-add-log-setup 'state (or done-word (car org-done-keywords)) 9793 (org-add-log-setup 'state (or done-word (car org-done-keywords))
9794 last-state
8876 'findpos org-log-repeat))) 9795 'findpos org-log-repeat)))
8877 (org-back-to-heading t) 9796 (org-back-to-heading t)
8878 (org-add-planning-info nil nil 'closed) 9797 (org-add-planning-info nil nil 'closed)
@@ -8921,7 +9840,7 @@ This function is run automatically after each state change to a DONE state."
8921 "Make a compact tree which shows all headlines marked with TODO. 9840 "Make a compact tree which shows all headlines marked with TODO.
8922The tree will show the lines where the regexp matches, and all higher 9841The tree will show the lines where the regexp matches, and all higher
8923headlines above the match. 9842headlines above the match.
8924With a \\[universal-argument] prefix, also show the DONE entries. 9843With a \\[universal-argument] prefix, prompt for a regexp to match.
8925With a numeric prefix N, construct a sparse tree for the Nth element 9844With a numeric prefix N, construct a sparse tree for the Nth element
8926of `org-todo-keywords-1'." 9845of `org-todo-keywords-1'."
8927 (interactive "P") 9846 (interactive "P")
@@ -8971,6 +9890,22 @@ scheduling will use the corresponding date."
8971 (org-add-planning-info 'scheduled time 'closed) 9890 (org-add-planning-info 'scheduled time 'closed)
8972 (message "Scheduled to %s" org-last-inserted-timestamp)))) 9891 (message "Scheduled to %s" org-last-inserted-timestamp))))
8973 9892
9893(defun org-get-scheduled-time (pom &optional inherit)
9894 "Get the scheduled time as a time tuple, of a format suitable
9895for calling org-schedule with, or if there is no scheduling,
9896returns nil."
9897 (let ((time (org-entry-get pom "SCHEDULED" inherit)))
9898 (when time
9899 (apply 'encode-time (org-parse-time-string time)))))
9900
9901(defun org-get-deadline-time (pom &optional inherit)
9902 "Get the deadine as a time tuple, of a format suitable for
9903calling org-deadlin with, or if there is no scheduling, returns
9904nil."
9905 (let ((time (org-entry-get pom "DEADLINE" inherit)))
9906 (when time
9907 (apply 'encode-time (org-parse-time-string time)))))
9908
8974(defun org-remove-timestamp-with-keyword (keyword) 9909(defun org-remove-timestamp-with-keyword (keyword)
8975 "Remove all time stamps with KEYWORD in the current entry." 9910 "Remove all time stamps with KEYWORD in the current entry."
8976 (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*")) 9911 (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*"))
@@ -8999,88 +9934,96 @@ be removed."
8999 (let (org-time-was-given org-end-time-was-given ts 9934 (let (org-time-was-given org-end-time-was-given ts
9000 end default-time default-input) 9935 end default-time default-input)
9001 9936
9002 (when (and (not time) (memq what '(scheduled deadline))) 9937 (catch 'exit
9003 ;; Try to get a default date/time from existing timestamp 9938 (when (and (not time) (memq what '(scheduled deadline)))
9004 (save-excursion 9939 ;; Try to get a default date/time from existing timestamp
9005 (org-back-to-heading t) 9940 (save-excursion
9006 (setq end (save-excursion (outline-next-heading) (point)))
9007 (when (re-search-forward (if (eq what 'scheduled)
9008 org-scheduled-time-regexp
9009 org-deadline-time-regexp)
9010 end t)
9011 (setq ts (match-string 1)
9012 default-time
9013 (apply 'encode-time (org-parse-time-string ts))
9014 default-input (and ts (org-get-compact-tod ts))))))
9015 (when what
9016 ;; If necessary, get the time from the user
9017 (setq time (or time (org-read-date nil 'to-time nil nil
9018 default-time default-input))))
9019
9020 (when (and org-insert-labeled-timestamps-at-point
9021 (member what '(scheduled deadline)))
9022 (insert
9023 (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
9024 (org-insert-time-stamp time org-time-was-given
9025 nil nil nil (list org-end-time-was-given))
9026 (setq what nil))
9027 (save-excursion
9028 (save-restriction
9029 (let (col list elt ts buffer-invisibility-spec)
9030 (org-back-to-heading t) 9941 (org-back-to-heading t)
9031 (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) 9942 (setq end (save-excursion (outline-next-heading) (point)))
9032 (goto-char (match-end 1)) 9943 (when (re-search-forward (if (eq what 'scheduled)
9033 (setq col (current-column)) 9944 org-scheduled-time-regexp
9034 (goto-char (match-end 0)) 9945 org-deadline-time-regexp)
9035 (if (eobp) (insert "\n") (forward-char 1)) 9946 end t)
9036 (if (and (not (looking-at outline-regexp)) 9947 (setq ts (match-string 1)
9037 (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp 9948 default-time
9038 "[^\r\n]*")) 9949 (apply 'encode-time (org-parse-time-string ts))
9039 (not (equal (match-string 1) org-clock-string))) 9950 default-input (and ts (org-get-compact-tod ts))))))
9040 (narrow-to-region (match-beginning 0) (match-end 0)) 9951 (when what
9041 (insert-before-markers "\n") 9952 ;; If necessary, get the time from the user
9042 (backward-char 1) 9953 (setq time (or time (org-read-date nil 'to-time nil nil
9043 (narrow-to-region (point) (point)) 9954 default-time default-input))))
9044 (and org-adapt-indentation (org-indent-to-column col))) 9955
9045 ;; Check if we have to remove something. 9956 (when (and org-insert-labeled-timestamps-at-point
9046 (setq list (cons what remove)) 9957 (member what '(scheduled deadline)))
9047 (while list 9958 (insert
9048 (setq elt (pop list)) 9959 (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
9960 (org-insert-time-stamp time org-time-was-given
9961 nil nil nil (list org-end-time-was-given))
9962 (setq what nil))
9963 (save-excursion
9964 (save-restriction
9965 (let (col list elt ts buffer-invisibility-spec)
9966 (org-back-to-heading t)
9967 (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"))
9968 (goto-char (match-end 1))
9969 (setq col (current-column))
9970 (goto-char (match-end 0))
9971 (if (eobp) (insert "\n") (forward-char 1))
9972 (when (and (not what)
9973 (not (looking-at
9974 (concat "[ \t]*"
9975 org-keyword-time-not-clock-regexp))))
9976 ;; Nothing to add, nothing to remove...... :-)
9977 (throw 'exit nil))
9978 (if (and (not (looking-at outline-regexp))
9979 (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
9980 "[^\r\n]*"))
9981 (not (equal (match-string 1) org-clock-string)))
9982 (narrow-to-region (match-beginning 0) (match-end 0))
9983 (insert-before-markers "\n")
9984 (backward-char 1)
9985 (narrow-to-region (point) (point))
9986 (and org-adapt-indentation (org-indent-to-column col)))
9987 ;; Check if we have to remove something.
9988 (setq list (cons what remove))
9989 (while list
9990 (setq elt (pop list))
9991 (goto-char (point-min))
9992 (when (or (and (eq elt 'scheduled)
9993 (re-search-forward org-scheduled-time-regexp nil t))
9994 (and (eq elt 'deadline)
9995 (re-search-forward org-deadline-time-regexp nil t))
9996 (and (eq elt 'closed)
9997 (re-search-forward org-closed-time-regexp nil t)))
9998 (replace-match "")
9999 (if (looking-at "--+<[^>]+>") (replace-match ""))
10000 (if (looking-at " +") (replace-match ""))))
10001 (goto-char (point-max))
10002 (when what
10003 (insert
10004 (if (not (or (bolp) (eq (char-before) ?\ ))) " " "")
10005 (cond ((eq what 'scheduled) org-scheduled-string)
10006 ((eq what 'deadline) org-deadline-string)
10007 ((eq what 'closed) org-closed-string))
10008 " ")
10009 (setq ts (org-insert-time-stamp
10010 time
10011 (or org-time-was-given
10012 (and (eq what 'closed) org-log-done-with-time))
10013 (eq what 'closed)
10014 nil nil (list org-end-time-was-given)))
10015 (end-of-line 1))
9049 (goto-char (point-min)) 10016 (goto-char (point-min))
9050 (when (or (and (eq elt 'scheduled) 10017 (widen)
9051 (re-search-forward org-scheduled-time-regexp nil t)) 10018 (if (and (looking-at "[ \t]+\n")
9052 (and (eq elt 'deadline) 10019 (equal (char-before) ?\n))
9053 (re-search-forward org-deadline-time-regexp nil t)) 10020 (delete-region (1- (point)) (point-at-eol)))
9054 (and (eq elt 'closed) 10021 ts))))))
9055 (re-search-forward org-closed-time-regexp nil t)))
9056 (replace-match "")
9057 (if (looking-at "--+<[^>]+>") (replace-match ""))
9058 (if (looking-at " +") (replace-match ""))))
9059 (goto-char (point-max))
9060 (when what
9061 (insert
9062 (if (not (or (bolp) (eq (char-before) ?\ ))) " " "")
9063 (cond ((eq what 'scheduled) org-scheduled-string)
9064 ((eq what 'deadline) org-deadline-string)
9065 ((eq what 'closed) org-closed-string))
9066 " ")
9067 (setq ts (org-insert-time-stamp
9068 time
9069 (or org-time-was-given
9070 (and (eq what 'closed) org-log-done-with-time))
9071 (eq what 'closed)
9072 nil nil (list org-end-time-was-given)))
9073 (end-of-line 1))
9074 (goto-char (point-min))
9075 (widen)
9076 (if (and (looking-at "[ \t]+\n")
9077 (equal (char-before) ?\n))
9078 (delete-region (1- (point)) (point-at-eol)))
9079 ts)))))
9080 10022
9081(defvar org-log-note-marker (make-marker)) 10023(defvar org-log-note-marker (make-marker))
9082(defvar org-log-note-purpose nil) 10024(defvar org-log-note-purpose nil)
9083(defvar org-log-note-state nil) 10025(defvar org-log-note-state nil)
10026(defvar org-log-note-previous-state nil)
9084(defvar org-log-note-how nil) 10027(defvar org-log-note-how nil)
9085(defvar org-log-note-extra nil) 10028(defvar org-log-note-extra nil)
9086(defvar org-log-note-window-configuration nil) 10029(defvar org-log-note-window-configuration nil)
@@ -9093,45 +10036,67 @@ The auto-repeater uses this.")
9093 "Add a note to the current entry. 10036 "Add a note to the current entry.
9094This is done in the same way as adding a state change note." 10037This is done in the same way as adding a state change note."
9095 (interactive) 10038 (interactive)
9096 (org-add-log-setup 'note nil 'findpos nil)) 10039 (org-add-log-setup 'note nil nil 'findpos nil))
9097 10040
9098(defvar org-property-end-re) 10041(defvar org-property-end-re)
9099(defun org-add-log-setup (&optional purpose state findpos how &optional extra) 10042(defun org-add-log-setup (&optional purpose state prev-state
10043 findpos how &optional extra)
9100 "Set up the post command hook to take a note. 10044 "Set up the post command hook to take a note.
9101If this is about to TODO state change, the new state is expected in STATE. 10045If this is about to TODO state change, the new state is expected in STATE.
9102When FINDPOS is non-nil, find the correct position for the note in 10046When FINDPOS is non-nil, find the correct position for the note in
9103the current entry. If not, assume that it can be inserted at point. 10047the current entry. If not, assume that it can be inserted at point.
9104HOW is an indicator what kind of note should be created. 10048HOW is an indicator what kind of note should be created.
9105EXTRA is additional text that will be inserted into the notes buffer." 10049EXTRA is additional text that will be inserted into the notes buffer."
9106 (save-restriction 10050 (let* ((org-log-into-drawer (org-log-into-drawer))
9107 (save-excursion 10051 (drawer (cond ((stringp org-log-into-drawer)
9108 (when findpos 10052 org-log-into-drawer)
9109 (org-back-to-heading t) 10053 (org-log-into-drawer "LOGBOOK")
9110 (narrow-to-region (point) (save-excursion 10054 (t nil))))
9111 (outline-next-heading) (point))) 10055 (save-restriction
9112 (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*" 10056 (save-excursion
9113 "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp 10057 (when findpos
9114 "[^\r\n]*\\)?")) 10058 (org-back-to-heading t)
9115 (goto-char (match-end 0)) 10059 (narrow-to-region (point) (save-excursion
9116 (when (and org-log-state-notes-insert-after-drawers 10060 (outline-next-heading) (point)))
9117 (save-excursion 10061 (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"
9118 (forward-line) (looking-at org-drawer-regexp))) 10062 "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
9119 (progn (forward-line) 10063 "[^\r\n]*\\)?"))
9120 (while (looking-at org-drawer-regexp) 10064 (goto-char (match-end 0))
9121 (goto-char (match-end 0)) 10065 (cond
9122 (re-search-forward org-property-end-re (point-max) t) 10066 (drawer
9123 (forward-line)) 10067 (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$")
9124 (forward-line -1))) 10068 nil t)
9125 (unless org-log-states-order-reversed 10069 (progn
9126 (and (= (char-after) ?\n) (forward-char 1)) 10070 (goto-char (match-end 0))
9127 (org-skip-over-state-notes) 10071 (or org-log-states-order-reversed
9128 (skip-chars-backward " \t\n\r"))) 10072 (and (re-search-forward org-property-end-re nil t)
9129 (move-marker org-log-note-marker (point)) 10073 (goto-char (1- (match-beginning 0))))))
9130 (setq org-log-note-purpose purpose 10074 (insert "\n:" drawer ":\n:END:")
9131 org-log-note-state state 10075 (beginning-of-line 0)
9132 org-log-note-how how 10076 (org-indent-line-function)
9133 org-log-note-extra extra) 10077 (beginning-of-line 2)
9134 (add-hook 'post-command-hook 'org-add-log-note 'append)))) 10078 (org-indent-line-function)
10079 (end-of-line 0)))
10080 ((and org-log-state-notes-insert-after-drawers
10081 (save-excursion
10082 (forward-line) (looking-at org-drawer-regexp)))
10083 (forward-line)
10084 (while (looking-at org-drawer-regexp)
10085 (goto-char (match-end 0))
10086 (re-search-forward org-property-end-re (point-max) t)
10087 (forward-line))
10088 (forward-line -1)))
10089 (unless org-log-states-order-reversed
10090 (and (= (char-after) ?\n) (forward-char 1))
10091 (org-skip-over-state-notes)
10092 (skip-chars-backward " \t\n\r")))
10093 (move-marker org-log-note-marker (point))
10094 (setq org-log-note-purpose purpose
10095 org-log-note-state state
10096 org-log-note-previous-state prev-state
10097 org-log-note-how how
10098 org-log-note-extra extra)
10099 (add-hook 'post-command-hook 'org-add-log-note 'append)))))
9135 10100
9136(defun org-skip-over-state-notes () 10101(defun org-skip-over-state-notes ()
9137 "Skip past the list of State notes in an entry." 10102 "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."
9160 ((eq org-log-note-purpose 'clock-out) "stopped clock") 10125 ((eq org-log-note-purpose 'clock-out) "stopped clock")
9161 ((eq org-log-note-purpose 'done) "closed todo item") 10126 ((eq org-log-note-purpose 'done) "closed todo item")
9162 ((eq org-log-note-purpose 'state) 10127 ((eq org-log-note-purpose 'state)
9163 (format "state change to \"%s\"" org-log-note-state)) 10128 (format "state change from \"%s\" to \"%s\""
10129 (or org-log-note-previous-state "")
10130 (or org-log-note-state "")))
9164 ((eq org-log-note-purpose 'note) 10131 ((eq org-log-note-purpose 'note)
9165 "this entry") 10132 "this entry")
9166 (t (error "This should not happen"))))) 10133 (t (error "This should not happen")))))
@@ -9190,10 +10157,18 @@ EXTRA is additional text that will be inserted into the notes buffer."
9190 (current-time))) 10157 (current-time)))
9191 (cons "%s" (if org-log-note-state 10158 (cons "%s" (if org-log-note-state
9192 (concat "\"" org-log-note-state "\"") 10159 (concat "\"" org-log-note-state "\"")
9193 ""))))) 10160 ""))
10161 (cons "%S" (if org-log-note-previous-state
10162 (concat "\"" org-log-note-previous-state "\"")
10163 "\"\"")))))
9194 (if lines (setq note (concat note " \\\\"))) 10164 (if lines (setq note (concat note " \\\\")))
9195 (push note lines)) 10165 (push note lines))
9196 (when (or current-prefix-arg org-note-abort) (setq lines nil)) 10166 (when (or current-prefix-arg org-note-abort)
10167 (when org-log-into-drawer
10168 (org-remove-empty-drawer-at
10169 (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK")
10170 org-log-note-marker))
10171 (setq lines nil))
9197 (when lines 10172 (when lines
9198 (save-excursion 10173 (save-excursion
9199 (set-buffer (marker-buffer org-log-note-marker)) 10174 (set-buffer (marker-buffer org-log-note-marker))
@@ -9202,44 +10177,62 @@ EXTRA is additional text that will be inserted into the notes buffer."
9202 (move-marker org-log-note-marker nil) 10177 (move-marker org-log-note-marker nil)
9203 (end-of-line 1) 10178 (end-of-line 1)
9204 (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) 10179 (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
9205 (indent-relative nil)
9206 (insert "- " (pop lines)) 10180 (insert "- " (pop lines))
9207 (org-indent-line-function) 10181 (org-indent-line-function)
9208 (beginning-of-line 1) 10182 (beginning-of-line 1)
9209 (looking-at "[ \t]*") 10183 (looking-at "[ \t]*")
9210 (setq ind (concat (match-string 0) " ")) 10184 (setq ind (concat (match-string 0) " "))
9211 (end-of-line 1) 10185 (end-of-line 1)
9212 (while lines (insert "\n" ind (pop lines))))))) 10186 (while lines (insert "\n" ind (pop lines)))
10187 (message "Note stored")
10188 (org-back-to-heading t)
10189 (org-cycle-hide-drawers 'children)))))
9213 (set-window-configuration org-log-note-window-configuration) 10190 (set-window-configuration org-log-note-window-configuration)
9214 (with-current-buffer (marker-buffer org-log-note-return-to) 10191 (with-current-buffer (marker-buffer org-log-note-return-to)
9215 (goto-char org-log-note-return-to)) 10192 (goto-char org-log-note-return-to))
9216 (move-marker org-log-note-return-to nil) 10193 (move-marker org-log-note-return-to nil)
9217 (and org-log-post-message (message "%s" org-log-post-message))) 10194 (and org-log-post-message (message "%s" org-log-post-message)))
9218 10195
10196(defun org-remove-empty-drawer-at (drawer pos)
10197 "Remove an emptyr DARWER drawer at position POS.
10198POS may also be a marker."
10199 (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
10200 (save-excursion
10201 (save-restriction
10202 (widen)
10203 (goto-char pos)
10204 (if (org-in-regexp
10205 (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2)
10206 (replace-match ""))))))
10207
9219(defun org-sparse-tree (&optional arg) 10208(defun org-sparse-tree (&optional arg)
9220 "Create a sparse tree, prompt for the details. 10209 "Create a sparse tree, prompt for the details.
9221This command can create sparse trees. You first need to select the type 10210This command can create sparse trees. You first need to select the type
9222of match used to create the tree: 10211of match used to create the tree:
9223 10212
9224t Show entries with a specific TODO keyword. 10213t Show entries with a specific TODO keyword.
9225T Show entries selected by a tags match. 10214m Show entries selected by a tags/property match.
9226p Enter a property name and its value (both with completion on existing 10215p Enter a property name and its value (both with completion on existing
9227 names/values) and show entries with that property. 10216 names/values) and show entries with that property.
9228r Show entries matching a regular expression 10217r Show entries matching a regular expression.
9229d Show deadlines due within `org-deadline-warning-days'." 10218d Show deadlines due within `org-deadline-warning-days'.
10219b Show deadlines and scheduled items before a date.
10220a Show deadlines and scheduled items after a date."
9230 (interactive "P") 10221 (interactive "P")
9231 (let (ans kwd value) 10222 (let (ans kwd value)
9232 (message "Sparse tree: [/]regexp [t]odo-kwd [T]ag [p]roperty [d]eadlines [b]efore-date") 10223 (message "Sparse tree: [/]regexp [t]odo-kwd [m]atch [p]roperty [d]eadlines [b]efore-date [a]fter-date")
9233 (setq ans (read-char-exclusive)) 10224 (setq ans (read-char-exclusive))
9234 (cond 10225 (cond
9235 ((equal ans ?d) 10226 ((equal ans ?d)
9236 (call-interactively 'org-check-deadlines)) 10227 (call-interactively 'org-check-deadlines))
9237 ((equal ans ?b) 10228 ((equal ans ?b)
9238 (call-interactively 'org-check-before-date)) 10229 (call-interactively 'org-check-before-date))
10230 ((equal ans ?a)
10231 (call-interactively 'org-check-after-date))
9239 ((equal ans ?t) 10232 ((equal ans ?t)
9240 (org-show-todo-tree '(4))) 10233 (org-show-todo-tree '(4)))
9241 ((equal ans ?T) 10234 ((member ans '(?T ?m))
9242 (call-interactively 'org-tags-sparse-tree)) 10235 (call-interactively 'org-match-sparse-tree))
9243 ((member ans '(?p ?P)) 10236 ((member ans '(?p ?P))
9244 (setq kwd (org-ido-completing-read "Property: " 10237 (setq kwd (org-ido-completing-read "Property: "
9245 (mapcar 'list (org-buffer-property-keys)))) 10238 (mapcar 'list (org-buffer-property-keys))))
@@ -9247,7 +10240,7 @@ d Show deadlines due within `org-deadline-warning-days'."
9247 (mapcar 'list (org-property-values kwd)))) 10240 (mapcar 'list (org-property-values kwd))))
9248 (unless (string-match "\\`{.*}\\'" value) 10241 (unless (string-match "\\`{.*}\\'" value)
9249 (setq value (concat "\"" value "\""))) 10242 (setq value (concat "\"" value "\"")))
9250 (org-tags-sparse-tree arg (concat kwd "=" value))) 10243 (org-match-sparse-tree arg (concat kwd "=" value)))
9251 ((member ans '(?r ?R ?/)) 10244 ((member ans '(?r ?R ?/))
9252 (call-interactively 'org-occur)) 10245 (call-interactively 'org-occur))
9253 (t (error "No such sparse tree command \"%c\"" ans))))) 10246 (t (error "No such sparse tree command \"%c\"" ans)))))
@@ -9278,6 +10271,8 @@ command.
9278If CALLBACK is non-nil, it is a function which is called to confirm 10271If CALLBACK is non-nil, it is a function which is called to confirm
9279that the match should indeed be shown." 10272that the match should indeed be shown."
9280 (interactive "sRegexp: \nP") 10273 (interactive "sRegexp: \nP")
10274 (when (equal regexp "")
10275 (error "Regexp cannot be empty"))
9281 (unless keep-previous 10276 (unless keep-previous
9282 (org-remove-occur-highlights nil nil t)) 10277 (org-remove-occur-highlights nil nil t))
9283 (push (cons regexp callback) org-occur-parameters) 10278 (push (cons regexp callback) org-occur-parameters)
@@ -9392,6 +10387,8 @@ from the `before-change-functions' in the current buffer."
9392 "Change the priority of an item by ARG. 10387 "Change the priority of an item by ARG.
9393ACTION can be `set', `up', `down', or a character." 10388ACTION can be `set', `up', `down', or a character."
9394 (interactive) 10389 (interactive)
10390 (unless org-enable-priority-commands
10391 (error "Priority commands are disabled"))
9395 (setq action (or action 'set)) 10392 (setq action (or action 'set))
9396 (let (current new news have remove) 10393 (let (current new news have remove)
9397 (save-excursion 10394 (save-excursion
@@ -9436,19 +10433,19 @@ ACTION can be `set', `up', `down', or a character."
9436 (replace-match news t t nil 2)) 10433 (replace-match news t t nil 2))
9437 (if remove 10434 (if remove
9438 (error "No priority cookie found in line") 10435 (error "No priority cookie found in line")
9439 (looking-at org-todo-line-regexp) 10436 (let ((case-fold-search nil))
10437 (looking-at org-todo-line-regexp))
9440 (if (match-end 2) 10438 (if (match-end 2)
9441 (progn 10439 (progn
9442 (goto-char (match-end 2)) 10440 (goto-char (match-end 2))
9443 (insert " [#" news "]")) 10441 (insert " [#" news "]"))
9444 (goto-char (match-beginning 3)) 10442 (goto-char (match-beginning 3))
9445 (insert "[#" news "] "))))) 10443 (insert "[#" news "] "))))
9446 (org-preserve-lc (org-set-tags nil 'align)) 10444 (org-preserve-lc (org-set-tags nil 'align)))
9447 (if remove 10445 (if remove
9448 (message "Priority removed") 10446 (message "Priority removed")
9449 (message "Priority of current item set to %s" news)))) 10447 (message "Priority of current item set to %s" news))))
9450 10448
9451
9452(defun org-get-priority (s) 10449(defun org-get-priority (s)
9453 "Find priority cookie and return priority." 10450 "Find priority cookie and return priority."
9454 (save-match-data 10451 (save-match-data
@@ -9460,6 +10457,23 @@ ACTION can be `set', `up', `down', or a character."
9460;;;; Tags 10457;;;; Tags
9461 10458
9462(defvar org-agenda-archives-mode) 10459(defvar org-agenda-archives-mode)
10460(defvar org-map-continue-from nil
10461 "Position from where mapping should continue.
10462Can be set byt the action argument to `org-scan-tag's and `org-map-entries'.")
10463
10464(defvar org-scanner-tags nil
10465 "The current tag list while the tags scanner is running.")
10466(defvar org-trust-scanner-tags nil
10467 "Should `org-get-tags-at' use the tags fro the scanner.
10468This is for internal dynamical scoping only.
10469When this is non-nil, the function `org-get-tags-at' will return the value
10470of `org-scanner-tags' instead of building the list by itself. This
10471can lead to large speed-ups when the tags scanner is used in a file with
10472many entries, and when the list of tags is retrieved, for example to
10473obtain a list of properties. Building the tags list for each entry in such
10474a file becomes an N^2 operation - but with this variable set, it scales
10475as N.")
10476
9463(defun org-scan-tags (action matcher &optional todo-only) 10477(defun org-scan-tags (action matcher &optional todo-only)
9464 "Scan headline tags with inheritance and produce output ACTION. 10478 "Scan headline tags with inheritance and produce output ACTION.
9465 10479
@@ -9472,12 +10486,12 @@ MATCHER is a Lisp form to be evaluated, testing if a given set of tags
9472qualifies a headline for inclusion. When TODO-ONLY is non-nil, 10486qualifies a headline for inclusion. When TODO-ONLY is non-nil,
9473only lines with a TODO keyword are included in the output." 10487only lines with a TODO keyword are included in the output."
9474 (require 'org-agenda) 10488 (require 'org-agenda)
9475 (let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\(" 10489 (let* ((re (concat "^" outline-regexp " *\\(\\<\\("
9476 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") 10490 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
9477 (org-re 10491 (org-re
9478 "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$"))) 10492 "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$")))
9479 (props (list 'face 'default 10493 (props (list 'face 'default
9480 'done-face 'org-done 10494 'done-face 'org-agenda-done
9481 'undone-face 'default 10495 'undone-face 'default
9482 'mouse-face 'highlight 10496 'mouse-face 'highlight
9483 'org-not-done-regexp org-not-done-regexp 10497 'org-not-done-regexp org-not-done-regexp
@@ -9489,8 +10503,9 @@ only lines with a TODO keyword are included in the output."
9489 (or (buffer-file-name (buffer-base-buffer)) 10503 (or (buffer-file-name (buffer-base-buffer))
9490 (buffer-name (buffer-base-buffer))))))) 10504 (buffer-name (buffer-base-buffer)))))))
9491 (case-fold-search nil) 10505 (case-fold-search nil)
10506 (org-map-continue-from nil)
9492 lspos tags tags-list 10507 lspos tags tags-list
9493 (tags-alist (list (cons 0 (mapcar 'downcase org-file-tags)))) 10508 (tags-alist (list (cons 0 org-file-tags)))
9494 (llast 0) rtn rtn1 level category i txt 10509 (llast 0) rtn rtn1 level category i txt
9495 todo marker entry priority) 10510 todo marker entry priority)
9496 (when (not (or (member action '(agenda sparse-tree)) (functionp action))) 10511 (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."
9502 (org-remove-occur-highlights)) 10517 (org-remove-occur-highlights))
9503 (while (re-search-forward re nil t) 10518 (while (re-search-forward re nil t)
9504 (catch :skip 10519 (catch :skip
9505 (setq todo (if (match-end 1) (match-string 2)) 10520 (setq todo (if (match-end 1) (org-match-string-no-properties 2))
9506 tags (if (match-end 4) (match-string 4))) 10521 tags (if (match-end 4) (org-match-string-no-properties 4)))
9507 (goto-char (setq lspos (1+ (match-beginning 0)))) 10522 (goto-char (setq lspos (match-beginning 0)))
9508 (setq level (org-reduced-level (funcall outline-level)) 10523 (setq level (org-reduced-level (funcall outline-level))
9509 category (org-get-category)) 10524 category (org-get-category))
9510 (setq i llast llast level) 10525 (setq i llast llast level)
@@ -9515,14 +10530,15 @@ only lines with a TODO keyword are included in the output."
9515 (setq i (1- i))) 10530 (setq i (1- i)))
9516 ;; add the next tags 10531 ;; add the next tags
9517 (when tags 10532 (when tags
9518 (setq tags (mapcar 'downcase (org-split-string tags ":")) 10533 (setq tags (org-split-string tags ":")
9519 tags-alist 10534 tags-alist
9520 (cons (cons level tags) tags-alist))) 10535 (cons (cons level tags) tags-alist)))
9521 ;; compile tags for current headline 10536 ;; compile tags for current headline
9522 (setq tags-list 10537 (setq tags-list
9523 (if org-use-tag-inheritance 10538 (if org-use-tag-inheritance
9524 (apply 'append (mapcar 'cdr (reverse tags-alist))) 10539 (apply 'append (mapcar 'cdr (reverse tags-alist)))
9525 tags)) 10540 tags)
10541 org-scanner-tags tags-list)
9526 (when org-use-tag-inheritance 10542 (when org-use-tag-inheritance
9527 (setcdr (car tags-alist) 10543 (setcdr (car tags-alist)
9528 (mapcar (lambda (x) 10544 (mapcar (lambda (x)
@@ -9530,7 +10546,8 @@ only lines with a TODO keyword are included in the output."
9530 (org-add-prop-inherited x)) 10546 (org-add-prop-inherited x))
9531 (cdar tags-alist)))) 10547 (cdar tags-alist))))
9532 (when (and tags org-use-tag-inheritance 10548 (when (and tags org-use-tag-inheritance
9533 (not (eq t org-use-tag-inheritance))) 10549 (or (not (eq t org-use-tag-inheritance))
10550 org-tags-exclude-from-inheritance))
9534 ;; selective inheritance, remove uninherited ones 10551 ;; selective inheritance, remove uninherited ones
9535 (setcdr (car tags-alist) 10552 (setcdr (car tags-alist)
9536 (org-remove-uniherited-tags (cdar tags-alist)))) 10553 (org-remove-uniherited-tags (cdar tags-alist))))
@@ -9559,26 +10576,35 @@ only lines with a TODO keyword are included in the output."
9559 (setq txt (org-format-agenda-item 10576 (setq txt (org-format-agenda-item
9560 "" 10577 ""
9561 (concat 10578 (concat
9562 (if org-tags-match-list-sublevels 10579 (if (eq org-tags-match-list-sublevels 'indented)
9563 (make-string (1- level) ?.) "") 10580 (make-string (1- level) ?.) "")
9564 (org-get-heading)) 10581 (org-get-heading))
9565 category (org-get-tags-at)) 10582 category
10583 tags-list
10584 )
9566 priority (org-get-priority txt)) 10585 priority (org-get-priority txt))
9567 (goto-char lspos) 10586 (goto-char lspos)
9568 (setq marker (org-agenda-new-marker)) 10587 (setq marker (org-agenda-new-marker))
9569 (org-add-props txt props 10588 (org-add-props txt props
9570 'org-marker marker 'org-hd-marker marker 'org-category category 10589 'org-marker marker 'org-hd-marker marker 'org-category category
10590 'todo-state todo
9571 'priority priority 'type "tagsmatch") 10591 'priority priority 'type "tagsmatch")
9572 (push txt rtn)) 10592 (push txt rtn))
9573 ((functionp action) 10593 ((functionp action)
10594 (setq org-map-continue-from nil)
9574 (save-excursion 10595 (save-excursion
9575 (setq rtn1 (funcall action)) 10596 (setq rtn1 (funcall action))
9576 (push rtn1 rtn)) 10597 (push rtn1 rtn)))
9577 (goto-char (point-at-eol)))
9578 (t (error "Invalid action"))) 10598 (t (error "Invalid action")))
9579 10599
9580 ;; if we are to skip sublevels, jump to end of subtree 10600 ;; if we are to skip sublevels, jump to end of subtree
9581 (or org-tags-match-list-sublevels (org-end-of-subtree t)))))) 10601 (unless org-tags-match-list-sublevels
10602 (org-end-of-subtree t)
10603 (backward-char 1))))
10604 ;; Get the correct position from where to continue
10605 (if org-map-continue-from
10606 (goto-char org-map-continue-from)
10607 (and (= (point) lspos) (end-of-line 1)))))
9582 (when (and (eq action 'sparse-tree) 10608 (when (and (eq action 'sparse-tree)
9583 (not org-sparse-tree-open-archived-trees)) 10609 (not org-sparse-tree-open-archived-trees))
9584 (org-hide-archived-subtrees (point-min) (point-max))) 10610 (org-hide-archived-subtrees (point-min) (point-max)))
@@ -9607,7 +10633,7 @@ only lines with a TODO keyword are included in the output."
9607 10633
9608(defvar todo-only) ;; dynamically scoped 10634(defvar todo-only) ;; dynamically scoped
9609 10635
9610(defun org-tags-sparse-tree (&optional todo-only match) 10636(defun org-match-sparse-tree (&optional todo-only match)
9611 "Create a sparse tree according to tags string MATCH. 10637 "Create a sparse tree according to tags string MATCH.
9612MATCH can contain positive and negative selection of tags, like 10638MATCH can contain positive and negative selection of tags, like
9613\"+WORK+URGENT-WITHBOSS\". 10639\"+WORK+URGENT-WITHBOSS\".
@@ -9617,6 +10643,8 @@ also TODO lines."
9617 (org-prepare-agenda-buffers (list (current-buffer))) 10643 (org-prepare-agenda-buffers (list (current-buffer)))
9618 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) 10644 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
9619 10645
10646(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
10647
9620(defvar org-cached-props nil) 10648(defvar org-cached-props nil)
9621(defun org-cached-entry-get (pom property) 10649(defun org-cached-entry-get (pom property)
9622 (if (or (eq t org-use-property-inheritance) 10650 (if (or (eq t org-use-property-inheritance)
@@ -9727,7 +10755,7 @@ also TODO lines."
9727 `(,po (or ,gv "") ,pv) 10755 `(,po (or ,gv "") ,pv)
9728 `(,po (string-to-number (or ,gv "")) 10756 `(,po (string-to-number (or ,gv ""))
9729 ,(string-to-number pv) )))) 10757 ,(string-to-number pv) ))))
9730 (t `(member ,(downcase tag) tags-list))) 10758 (t `(member ,tag tags-list)))
9731 mm (if minus (list 'not mm) mm) 10759 mm (if minus (list 'not mm) mm)
9732 term rest) 10760 term rest)
9733 (push mm tagsmatcher)) 10761 (push mm tagsmatcher))
@@ -9852,34 +10880,39 @@ the tags of the current headline come last.
9852When LOCAL is non-nil, only return tags from the current headline, 10880When LOCAL is non-nil, only return tags from the current headline,
9853ignore inherited ones." 10881ignore inherited ones."
9854 (interactive) 10882 (interactive)
9855 (let (tags ltags lastpos parent) 10883 (if (and org-trust-scanner-tags
9856 (save-excursion 10884 (or (not pos) (equal pos (point)))
9857 (save-restriction 10885 (not local))
9858 (widen) 10886 org-scanner-tags
9859 (goto-char (or pos (point))) 10887 (let (tags ltags lastpos parent)
9860 (save-match-data 10888 (save-excursion
9861 (catch 'done 10889 (save-restriction
9862 (condition-case nil 10890 (widen)
9863 (progn 10891 (goto-char (or pos (point)))
9864 (org-back-to-heading t) 10892 (save-match-data
9865 (while (not (equal lastpos (point))) 10893 (catch 'done
9866 (setq lastpos (point)) 10894 (condition-case nil
9867 (when (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) 10895 (progn
9868 (setq ltags (org-split-string 10896 (org-back-to-heading t)
9869 (org-match-string-no-properties 1) ":")) 10897 (while (not (equal lastpos (point)))
9870 (when parent 10898 (setq lastpos (point))
9871 (setq ltags (mapcar 'org-add-prop-inherited ltags))) 10899 (when (looking-at
9872 (setq tags (append 10900 (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$"))
9873 (if parent 10901 (setq ltags (org-split-string
9874 (org-remove-uniherited-tags ltags) 10902 (org-match-string-no-properties 1) ":"))
9875 ltags) 10903 (when parent
9876 tags))) 10904 (setq ltags (mapcar 'org-add-prop-inherited ltags)))
9877 (or org-use-tag-inheritance (throw 'done t)) 10905 (setq tags (append
9878 (if local (throw 'done t)) 10906 (if parent
9879 (org-up-heading-all 1) 10907 (org-remove-uniherited-tags ltags)
9880 (setq parent t))) 10908 ltags)
9881 (error nil))))) 10909 tags)))
9882 (append (org-remove-uniherited-tags org-file-tags) tags)))) 10910 (or org-use-tag-inheritance (throw 'done t))
10911 (if local (throw 'done t))
10912 (or (org-up-heading-safe) (error nil))
10913 (setq parent t)))
10914 (error nil)))))
10915 (append (org-remove-uniherited-tags org-file-tags) tags)))))
9883 10916
9884(defun org-add-prop-inherited (s) 10917(defun org-add-prop-inherited (s)
9885 (add-text-properties 0 (length s) '(inherited t) s) 10918 (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."
9971 (setq tags current) 11004 (setq tags current)
9972 ;; Get a new set of tags from the user 11005 ;; Get a new set of tags from the user
9973 (save-excursion 11006 (save-excursion
9974 (setq table (or org-tag-alist (org-get-buffer-tags)) 11007 (setq table (append org-tag-persistent-alist
11008 (or org-tag-alist (org-get-buffer-tags)))
9975 org-last-tags-completion-table table 11009 org-last-tags-completion-table table
9976 current-tags (org-split-string current ":") 11010 current-tags (org-split-string current ":")
9977 inherited-tags (nreverse 11011 inherited-tags (nreverse
@@ -9993,8 +11027,13 @@ With prefix ARG, realign all tags in headings in the current buffer."
9993 ;; No boolean logic, just a list 11027 ;; No boolean logic, just a list
9994 (setq tags (replace-match ":" t t tags)))) 11028 (setq tags (replace-match ":" t t tags))))
9995 11029
11030 (if org-tags-sort-function
11031 (setq tags (mapconcat 'identity
11032 (sort (org-split-string tags (org-re "[^[:alnum:]_@]+"))
11033 org-tags-sort-function) ":")))
11034
9996 (if (string-match "\\`[\t ]*\\'" tags) 11035 (if (string-match "\\`[\t ]*\\'" tags)
9997 (setq tags "") 11036 (setq tags "")
9998 (unless (string-match ":$" tags) (setq tags (concat tags ":"))) 11037 (unless (string-match ":$" tags) (setq tags (concat tags ":")))
9999 (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) 11038 (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
10000 11039
@@ -10177,6 +11216,14 @@ Returns the new tags string, or nil to not change the current settings."
10177 ((equal e '(:endgroup)) 11216 ((equal e '(:endgroup))
10178 (setq ingroup nil cnt 0) 11217 (setq ingroup nil cnt 0)
10179 (insert "}\n")) 11218 (insert "}\n"))
11219 ((equal e '(:newline))
11220 (when (not (= cnt 0))
11221 (setq cnt 0)
11222 (insert "\n")
11223 (setq e (car tbl))
11224 (while (equal (car tbl) '(:newline))
11225 (insert "\n")
11226 (setq tbl (cdr tbl)))))
10180 (t 11227 (t
10181 (setq tg (car e) c2 nil) 11228 (setq tg (car e) c2 nil)
10182 (if (cdr e) 11229 (if (cdr e)
@@ -10332,6 +11379,17 @@ arguments, with the cursor positioned at the beginning of the headline.
10332The return values of all calls to the function will be collected and 11379The return values of all calls to the function will be collected and
10333returned as a list. 11380returned as a list.
10334 11381
11382The call to FUNC will be wrapped into a save-excursion form, so FUNC
11383does not need to preserve point. After evaluation, the cursor will be
11384moved to the end of the line (presumably of the headline of the
11385processed entry) and search continues from there. Under some
11386circumstances, this may not produce the wanted results. For example,
11387if you have removed (e.g. archived) the current (sub)tree it could
11388mean that the next entry will be skipped entirely. In such cases, you
11389can specify the position from where search should continue by making
11390FUNC set the variable `org-map-continue-from' to the desired buffer
11391position.
11392
10335MATCH is a tags/property/todo match as it is used in the agenda tags view. 11393MATCH is a tags/property/todo match as it is used in the agenda tags view.
10336Only headlines that are matched by this query will be considered during 11394Only headlines that are matched by this query will be considered during
10337the iteration. When MATCH is nil or t, all headlines will be 11395the iteration. When MATCH is nil or t, all headlines will be
@@ -10359,7 +11417,16 @@ the scanner. The following items can be given here:
10359 will be used as value for `org-agenda-skip-function', so whenever 11417 will be used as value for `org-agenda-skip-function', so whenever
10360 the the function returns t, FUNC will not be called for that 11418 the the function returns t, FUNC will not be called for that
10361 entry and search will continue from the point where the 11419 entry and search will continue from the point where the
10362 function leaves it." 11420 function leaves it.
11421
11422If your function needs to retrieve the tags including inherited tags
11423at the *current* entry, you can use the value of the variable
11424`org-scanner-tags' which will be much faster than getting the value
11425with `org-get-tags-at'. If your function gets properties with
11426`org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags'
11427to t around the call to `org-entry-properties' to get the same speedup.
11428Note that if your function moves around to retrieve tags and properties at
11429a *different* entry, you cannot use these techniques."
10363 (let* ((org-agenda-archives-mode nil) ; just to make sure 11430 (let* ((org-agenda-archives-mode nil) ; just to make sure
10364 (org-agenda-skip-archived-trees (memq 'archive skip)) 11431 (org-agenda-skip-archived-trees (memq 'archive skip))
10365 (org-agenda-skip-comment-trees (memq 'comment skip)) 11432 (org-agenda-skip-comment-trees (memq 'comment skip))
@@ -10425,10 +11492,12 @@ These are properties that are not defined in the property drawer,
10425but in some other way.") 11492but in some other way.")
10426 11493
10427(defconst org-default-properties 11494(defconst org-default-properties
10428 '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" 11495 '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID"
10429 "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" 11496 "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
10430 "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" 11497 "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
10431 "EXPORT_FILE_NAME" "EXPORT_TITLE" "ORDERED") 11498 "EXPORT_FILE_NAME" "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE"
11499 "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER"
11500 "CLOCK_MODELINE_TOTAL")
10432 "Some properties that are used by Org-mode for various purposes. 11501 "Some properties that are used by Org-mode for various purposes.
10433Being in this list makes sure that they are offered for completion.") 11502Being in this list makes sure that they are offered for completion.")
10434 11503
@@ -10564,7 +11633,7 @@ If WHICH is nil or `all', get all properties. If WHICH is
10564 ) 11633 )
10565 11634
10566 (when (memq which '(all standard)) 11635 (when (memq which '(all standard))
10567 ;; Get the standard properties, like :PORP: ... 11636 ;; Get the standard properties, like :PROP: ...
10568 (setq range (org-get-property-block beg end)) 11637 (setq range (org-get-property-block beg end))
10569 (when range 11638 (when range
10570 (goto-char (car range)) 11639 (goto-char (car range))
@@ -10805,7 +11874,8 @@ formats in the current buffer."
10805 (setq rtn (append org-special-properties rtn))) 11874 (setq rtn (append org-special-properties rtn)))
10806 11875
10807 (when include-defaults 11876 (when include-defaults
10808 (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties)) 11877 (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties)
11878 (add-to-list 'rtn org-effort-property))
10809 11879
10810 (when include-columns 11880 (when include-columns
10811 (save-excursion 11881 (save-excursion
@@ -10843,7 +11913,9 @@ formats in the current buffer."
10843 (interactive) 11913 (interactive)
10844 (org-back-to-heading t) 11914 (org-back-to-heading t)
10845 (looking-at outline-regexp) 11915 (looking-at outline-regexp)
10846 (let ((indent (- (match-end 0)(match-beginning 0))) 11916 (let ((indent (if org-adapt-indentation
11917 (- (match-end 0)(match-beginning 0))
11918 0))
10847 (beg (point)) 11919 (beg (point))
10848 (re (concat "^[ \t]*" org-keyword-time-regexp)) 11920 (re (concat "^[ \t]*" org-keyword-time-regexp))
10849 end hiddenp) 11921 end hiddenp)
@@ -10854,8 +11926,13 @@ formats in the current buffer."
10854 (setq hiddenp (org-invisible-p)) 11926 (setq hiddenp (org-invisible-p))
10855 (end-of-line 1) 11927 (end-of-line 1)
10856 (and (equal (char-after) ?\n) (forward-char 1)) 11928 (and (equal (char-after) ?\n) (forward-char 1))
10857 (while (looking-at "^[ \t]*\\(:CLOCK:\\|CLOCK\\|:END:\\)") 11929 (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)")
10858 (beginning-of-line 2)) 11930 (if (member (match-string 1) '("CLOCK:" ":END:"))
11931 ;; just skip this line
11932 (beginning-of-line 2)
11933 ;; Drawer start, find the end
11934 (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t)
11935 (beginning-of-line 1)))
10859 (org-skip-over-state-notes) 11936 (org-skip-over-state-notes)
10860 (skip-chars-backward " \t\n\r") 11937 (skip-chars-backward " \t\n\r")
10861 (if (eq (char-before) ?*) (forward-char 1)) 11938 (if (eq (char-before) ?*) (forward-char 1))
@@ -10893,11 +11970,12 @@ in the current file."
10893 (existing (mapcar 'list (org-property-values prop))) 11970 (existing (mapcar 'list (org-property-values prop)))
10894 (val (if allowed 11971 (val (if allowed
10895 (org-completing-read "Value: " allowed nil 'req-match) 11972 (org-completing-read "Value: " allowed nil 'req-match)
10896 (org-completing-read-no-ido 11973 (let (org-completion-use-ido)
10897 (concat "Value" (if (and cur (string-match "\\S-" cur)) 11974 (org-completing-read
10898 (concat "[" cur "]") "") 11975 (concat "Value" (if (and cur (string-match "\\S-" cur))
10899 ": ") 11976 (concat "[" cur "]") "")
10900 existing nil nil "" nil cur)))) 11977 ": ")
11978 existing nil nil "" nil cur)))))
10901 (list prop (if (equal val "") cur val)))) 11979 (list prop (if (equal val "") cur val))))
10902 (unless (equal (org-entry-get nil property) value) 11980 (unless (equal (org-entry-get nil property) value)
10903 (org-entry-put nil property value))) 11981 (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."
11026 (when (re-search-forward 12104 (when (re-search-forward
11027 (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$") 12105 (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$")
11028 nil t) 12106 nil t)
11029 (org-back-to-heading) 12107 (org-back-to-heading t)
11030 (point)))))) 12108 (point))))))
11031 12109
11032;;;; Timestamps 12110;;;; Timestamps
@@ -11125,6 +12203,8 @@ So these are more for recording a certain time/date."
11125(defvar org-overriding-default-time nil) ; dynamically scoped 12203(defvar org-overriding-default-time nil) ; dynamically scoped
11126(defvar org-read-date-overlay nil) 12204(defvar org-read-date-overlay nil)
11127(defvar org-dcst nil) ; dynamically scoped 12205(defvar org-dcst nil) ; dynamically scoped
12206(defvar org-read-date-history nil)
12207(defvar org-read-date-final-answer nil)
11128 12208
11129(defun org-read-date (&optional with-time to-time from-string prompt 12209(defun org-read-date (&optional with-time to-time from-string prompt
11130 default-time default-input) 12210 default-time default-input)
@@ -11188,6 +12268,7 @@ user."
11188 (setcar (nthcdr 1 defdecode) 59) 12268 (setcar (nthcdr 1 defdecode) 59)
11189 (setq def (apply 'encode-time defdecode) 12269 (setq def (apply 'encode-time defdecode)
11190 defdecode (decode-time def))))) 12270 defdecode (decode-time def)))))
12271 (calendar-frame-setup nil)
11191 (calendar-move-hook nil) 12272 (calendar-move-hook nil)
11192 (calendar-view-diary-initially-flag nil) 12273 (calendar-view-diary-initially-flag nil)
11193 (view-diary-entries-initially nil) 12274 (view-diary-entries-initially nil)
@@ -11214,44 +12295,58 @@ user."
11214 (minibuffer-local-map (copy-keymap minibuffer-local-map))) 12295 (minibuffer-local-map (copy-keymap minibuffer-local-map)))
11215 (org-defkey map (kbd "RET") 'org-calendar-select) 12296 (org-defkey map (kbd "RET") 'org-calendar-select)
11216 (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1]) 12297 (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1])
11217 'org-calendar-select-mouse) 12298 'org-calendar-select-mouse)
11218 (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2]) 12299 (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2])
11219 'org-calendar-select-mouse) 12300 'org-calendar-select-mouse)
11220 (org-defkey minibuffer-local-map [(meta shift left)] 12301 (org-defkey minibuffer-local-map [(meta shift left)]
11221 (lambda () (interactive) 12302 (lambda () (interactive)
11222 (org-eval-in-calendar '(calendar-backward-month 1)))) 12303 (org-eval-in-calendar '(calendar-backward-month 1))))
11223 (org-defkey minibuffer-local-map [(meta shift right)] 12304 (org-defkey minibuffer-local-map [(meta shift right)]
11224 (lambda () (interactive) 12305 (lambda () (interactive)
11225 (org-eval-in-calendar '(calendar-forward-month 1)))) 12306 (org-eval-in-calendar '(calendar-forward-month 1))))
11226 (org-defkey minibuffer-local-map [(meta shift up)] 12307 (org-defkey minibuffer-local-map [(meta shift up)]
11227 (lambda () (interactive) 12308 (lambda () (interactive)
11228 (org-eval-in-calendar '(calendar-backward-year 1)))) 12309 (org-eval-in-calendar '(calendar-backward-year 1))))
11229 (org-defkey minibuffer-local-map [(meta shift down)] 12310 (org-defkey minibuffer-local-map [(meta shift down)]
11230 (lambda () (interactive) 12311 (lambda () (interactive)
11231 (org-eval-in-calendar '(calendar-forward-year 1)))) 12312 (org-eval-in-calendar '(calendar-forward-year 1))))
12313 (org-defkey minibuffer-local-map [?\e (shift left)]
12314 (lambda () (interactive)
12315 (org-eval-in-calendar '(calendar-backward-month 1))))
12316 (org-defkey minibuffer-local-map [?\e (shift right)]
12317 (lambda () (interactive)
12318 (org-eval-in-calendar '(calendar-forward-month 1))))
12319 (org-defkey minibuffer-local-map [?\e (shift up)]
12320 (lambda () (interactive)
12321 (org-eval-in-calendar '(calendar-backward-year 1))))
12322 (org-defkey minibuffer-local-map [?\e (shift down)]
12323 (lambda () (interactive)
12324 (org-eval-in-calendar '(calendar-forward-year 1))))
11232 (org-defkey minibuffer-local-map [(shift up)] 12325 (org-defkey minibuffer-local-map [(shift up)]
11233 (lambda () (interactive) 12326 (lambda () (interactive)
11234 (org-eval-in-calendar '(calendar-backward-week 1)))) 12327 (org-eval-in-calendar '(calendar-backward-week 1))))
11235 (org-defkey minibuffer-local-map [(shift down)] 12328 (org-defkey minibuffer-local-map [(shift down)]
11236 (lambda () (interactive) 12329 (lambda () (interactive)
11237 (org-eval-in-calendar '(calendar-forward-week 1)))) 12330 (org-eval-in-calendar '(calendar-forward-week 1))))
11238 (org-defkey minibuffer-local-map [(shift left)] 12331 (org-defkey minibuffer-local-map [(shift left)]
11239 (lambda () (interactive) 12332 (lambda () (interactive)
11240 (org-eval-in-calendar '(calendar-backward-day 1)))) 12333 (org-eval-in-calendar '(calendar-backward-day 1))))
11241 (org-defkey minibuffer-local-map [(shift right)] 12334 (org-defkey minibuffer-local-map [(shift right)]
11242 (lambda () (interactive) 12335 (lambda () (interactive)
11243 (org-eval-in-calendar '(calendar-forward-day 1)))) 12336 (org-eval-in-calendar '(calendar-forward-day 1))))
11244 (org-defkey minibuffer-local-map ">" 12337 (org-defkey minibuffer-local-map ">"
11245 (lambda () (interactive) 12338 (lambda () (interactive)
11246 (org-eval-in-calendar '(scroll-calendar-left 1)))) 12339 (org-eval-in-calendar '(scroll-calendar-left 1))))
11247 (org-defkey minibuffer-local-map "<" 12340 (org-defkey minibuffer-local-map "<"
11248 (lambda () (interactive) 12341 (lambda () (interactive)
11249 (org-eval-in-calendar '(scroll-calendar-right 1)))) 12342 (org-eval-in-calendar '(scroll-calendar-right 1))))
12343 (run-hooks 'org-read-date-minibuffer-setup-hook)
11250 (unwind-protect 12344 (unwind-protect
11251 (progn 12345 (progn
11252 (use-local-map map) 12346 (use-local-map map)
11253 (add-hook 'post-command-hook 'org-read-date-display) 12347 (add-hook 'post-command-hook 'org-read-date-display)
11254 (setq org-ans0 (read-string prompt default-input nil nil)) 12348 (setq org-ans0 (read-string prompt default-input
12349 'org-read-date-history nil))
11255 ;; org-ans0: from prompt 12350 ;; org-ans0: from prompt
11256 ;; org-ans1: from mouse click 12351 ;; org-ans1: from mouse click
11257 ;; org-ans2: from calendar motion 12352 ;; org-ans2: from calendar motion
@@ -11264,12 +12359,14 @@ user."
11264 12359
11265 (t ; Naked prompt only 12360 (t ; Naked prompt only
11266 (unwind-protect 12361 (unwind-protect
11267 (setq ans (read-string prompt default-input nil timestr)) 12362 (setq ans (read-string prompt default-input
12363 'org-read-date-history timestr))
11268 (when org-read-date-overlay 12364 (when org-read-date-overlay
11269 (org-delete-overlay org-read-date-overlay) 12365 (org-delete-overlay org-read-date-overlay)
11270 (setq org-read-date-overlay nil))))) 12366 (setq org-read-date-overlay nil)))))
11271 12367
11272 (setq final (org-read-date-analyze ans def defdecode)) 12368 (setq final (org-read-date-analyze ans def defdecode))
12369 (setq org-read-date-final-answer ans)
11273 12370
11274 (if to-time 12371 (if to-time
11275 (apply 'encode-time final) 12372 (apply 'encode-time final)
@@ -11278,6 +12375,7 @@ user."
11278 (nth 5 final) (nth 4 final) (nth 3 final) 12375 (nth 5 final) (nth 4 final) (nth 3 final)
11279 (nth 2 final) (nth 1 final)) 12376 (nth 2 final) (nth 1 final))
11280 (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) 12377 (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
12378
11281(defvar def) 12379(defvar def)
11282(defvar defdecode) 12380(defvar defdecode)
11283(defvar with-time) 12381(defvar with-time)
@@ -11487,15 +12585,17 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to
11487(defun org-eval-in-calendar (form &optional keepdate) 12585(defun org-eval-in-calendar (form &optional keepdate)
11488 "Eval FORM in the calendar window and return to current window. 12586 "Eval FORM in the calendar window and return to current window.
11489Also, store the cursor date in variable org-ans2." 12587Also, store the cursor date in variable org-ans2."
11490 (let ((sw (selected-window))) 12588 (let ((sf (selected-frame))
11491 (select-window (get-buffer-window "*Calendar*")) 12589 (sw (selected-window)))
12590 (select-window (get-buffer-window "*Calendar*" t))
11492 (eval form) 12591 (eval form)
11493 (when (and (not keepdate) (calendar-cursor-to-date)) 12592 (when (and (not keepdate) (calendar-cursor-to-date))
11494 (let* ((date (calendar-cursor-to-date)) 12593 (let* ((date (calendar-cursor-to-date))
11495 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 12594 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
11496 (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) 12595 (setq org-ans2 (format-time-string "%Y-%m-%d" time))))
11497 (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) 12596 (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
11498 (select-window sw))) 12597 (select-window sw)
12598 (select-frame-set-input-focus sf)))
11499 12599
11500(defun org-calendar-select () 12600(defun org-calendar-select ()
11501 "Return to `org-read-date' with the date currently selected. 12601 "Return to `org-read-date' with the date currently selected.
@@ -11633,7 +12733,7 @@ Don't touch the rest."
11633 ((<= org-deadline-warning-days 0) 12733 ((<= org-deadline-warning-days 0)
11634 ;; 0 or negative, enforce this value no matter what 12734 ;; 0 or negative, enforce this value no matter what
11635 (- org-deadline-warning-days)) 12735 (- org-deadline-warning-days))
11636 ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\)" ts) 12736 ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\| \\)" ts)
11637 ;; lead time is specified. 12737 ;; lead time is specified.
11638 (floor (* (string-to-number (match-string 1 ts)) 12738 (floor (* (string-to-number (match-string 1 ts))
11639 (cdr (assoc (match-string 2 ts) 12739 (cdr (assoc (match-string 2 ts)
@@ -11688,6 +12788,21 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
11688 (message "%d entries before %s" 12788 (message "%d entries before %s"
11689 (org-occur regexp nil callback) date))) 12789 (org-occur regexp nil callback) date)))
11690 12790
12791(defun org-check-after-date (date)
12792 "Check if there are deadlines or scheduled entries after DATE."
12793 (interactive (list (org-read-date)))
12794 (let ((case-fold-search nil)
12795 (regexp (concat "\\<\\(" org-deadline-string
12796 "\\|" org-scheduled-string
12797 "\\) *<\\([^>]+\\)>"))
12798 (callback
12799 (lambda () (not
12800 (time-less-p
12801 (org-time-string-to-time (match-string 2))
12802 (org-time-string-to-time date))))))
12803 (message "%d entries after %s"
12804 (org-occur regexp nil callback) date)))
12805
11691(defun org-evaluate-time-range (&optional to-buffer) 12806(defun org-evaluate-time-range (&optional to-buffer)
11692 "Evaluate a time range by computing the difference between start and end. 12807 "Evaluate a time range by computing the difference between start and end.
11693Normally the result is just printed in the echo area, but with prefix arg 12808Normally the result is just printed in the echo area, but with prefix arg
@@ -11767,12 +12882,15 @@ days in order to avoid rounding problems."
11767 12882
11768(defun org-time-string-to-time (s) 12883(defun org-time-string-to-time (s)
11769 (apply 'encode-time (org-parse-time-string s))) 12884 (apply 'encode-time (org-parse-time-string s)))
12885(defun org-time-string-to-seconds (s)
12886 (time-to-seconds (org-time-string-to-time s)))
11770 12887
11771(defun org-time-string-to-absolute (s &optional daynr prefer show-all) 12888(defun org-time-string-to-absolute (s &optional daynr prefer show-all)
11772 "Convert a time stamp to an absolute day number. 12889 "Convert a time stamp to an absolute day number.
11773If there is a specifyer for a cyclic time stamp, get the closest date to 12890If there is a specifyer for a cyclic time stamp, get the closest date to
11774DAYNR. 12891DAYNR.
11775PREFER and SHOW-ALL are passed through to `org-closest-date'." 12892PREFER and SHOW-ALL are passed through to `org-closest-date'.
12893the variable date is bound by the calendar when this is called."
11776 (cond 12894 (cond
11777 ((and daynr (string-match "\\`%%\\((.*)\\)" s)) 12895 ((and daynr (string-match "\\`%%\\((.*)\\)" s))
11778 (if (org-diary-sexp-entry (match-string 1 s) "" date) 12896 (if (org-diary-sexp-entry (match-string 1 s) "" date)
@@ -12077,6 +13195,13 @@ in the timestamp determines what will be changed."
12077 (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) 13195 (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
12078 (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) 13196 (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
12079 (nthcdr 6 time0))) 13197 (nthcdr 6 time0)))
13198 (when (and (member org-ts-what '(hour minute))
13199 extra
13200 (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
13201 (setq extra (org-modify-ts-extra
13202 extra
13203 (if (eq org-ts-what 'hour) 2 5)
13204 n dm)))
12080 (when (integerp org-ts-what) 13205 (when (integerp org-ts-what)
12081 (setq extra (org-modify-ts-extra extra org-ts-what n dm))) 13206 (setq extra (org-modify-ts-extra extra org-ts-what n dm)))
12082 (if (eq what 'calendar) 13207 (if (eq what 'calendar)
@@ -12192,11 +13317,56 @@ If there is already a time stamp at the cursor position, update it."
12192 (format org-time-clocksum-format h m))) 13317 (format org-time-clocksum-format h m)))
12193 13318
12194(defun org-hh:mm-string-to-minutes (s) 13319(defun org-hh:mm-string-to-minutes (s)
12195 "Convert a string H:MM to a number of minutes." 13320 "Convert a string H:MM to a number of minutes.
12196 (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s) 13321If the string is just a number, interprete it as minutes.
12197 (+ (* (string-to-number (match-string 1 s)) 60) 13322In fact, the first hh:mm or number in the string will be taken,
12198 (string-to-number (match-string 2 s))) 13323there can be extra stuff in the string.
12199 0)) 13324If no number is found, the return value is 0."
13325 (cond
13326 ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
13327 (+ (* (string-to-number (match-string 1 s)) 60)
13328 (string-to-number (match-string 2 s))))
13329 ((string-match "\\([0-9]+\\)" s)
13330 (string-to-number (match-string 1 s)))
13331 (t 0)))
13332
13333;;;; Files
13334
13335(defun org-save-all-org-buffers ()
13336 "Save all Org-mode buffers without user confirmation."
13337 (interactive)
13338 (message "Saving all Org-mode buffers...")
13339 (save-some-buffers t 'org-mode-p)
13340 (when (featurep 'org-id) (org-id-locations-save))
13341 (message "Saving all Org-mode buffers... done"))
13342
13343(defun org-revert-all-org-buffers ()
13344 "Revert all Org-mode buffers.
13345Prompt for confirmation when there are unsaved changes.
13346Be sure you know what you are doing before letting this function
13347overwrite your changes.
13348
13349This function is useful in a setup where one tracks org files
13350with a version control system, to revert on one machine after pulling
13351changes from another. I believe the procedure must be like this:
13352
133531. M-x org-save-all-org-buffers
133542. Pull changes from the other machine, resolve conflicts
133553. M-x org-revert-all-org-buffers"
13356 (interactive)
13357 (unless (yes-or-no-p "Revert all Org buffers from their files? ")
13358 (error "Abort"))
13359 (save-excursion
13360 (save-window-excursion
13361 (mapc
13362 (lambda (b)
13363 (when (and (with-current-buffer b (org-mode-p))
13364 (with-current-buffer b buffer-file-name))
13365 (switch-to-buffer b)
13366 (revert-buffer t 'no-confirm)))
13367 (buffer-list))
13368 (when (and (featurep 'org-id) org-id-track-globally)
13369 (org-id-locations-load)))))
12200 13370
12201;;;; Agenda files 13371;;;; Agenda files
12202 13372
@@ -12236,7 +13406,7 @@ With two prefix arguments, restrict available buffers to agenda files."
12236 (t (org-buffer-list))))) 13406 (t (org-buffer-list)))))
12237 (switch-to-buffer 13407 (switch-to-buffer
12238 (org-ido-completing-read "Org buffer: " 13408 (org-ido-completing-read "Org buffer: "
12239 (mapcar 'buffer-name blist) 13409 (mapcar 'list (mapcar 'buffer-name blist))
12240 nil t)))) 13410 nil t))))
12241 13411
12242(defun org-buffer-list (&optional predicate exclude-tmp) 13412(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
12468 (save-excursion 13638 (save-excursion
12469 (save-restriction 13639 (save-restriction
12470 (while (setq file (pop files)) 13640 (while (setq file (pop files))
12471 (if (bufferp file) 13641 (catch 'nextfile
12472 (set-buffer file) 13642 (if (bufferp file)
12473 (org-check-agenda-file file) 13643 (set-buffer file)
12474 (set-buffer (org-get-agenda-file-buffer file))) 13644 (org-check-agenda-file file)
12475 (widen) 13645 (set-buffer (org-get-agenda-file-buffer file)))
12476 (setq bmp (buffer-modified-p)) 13646 (widen)
12477 (org-refresh-category-properties) 13647 (setq bmp (buffer-modified-p))
12478 (setq org-todo-keywords-for-agenda 13648 (org-refresh-category-properties)
12479 (append org-todo-keywords-for-agenda org-todo-keywords-1)) 13649 (setq org-todo-keywords-for-agenda
12480 (setq org-done-keywords-for-agenda 13650 (append org-todo-keywords-for-agenda org-todo-keywords-1))
12481 (append org-done-keywords-for-agenda org-done-keywords)) 13651 (setq org-done-keywords-for-agenda
12482 (setq org-todo-keyword-alist-for-agenda 13652 (append org-done-keywords-for-agenda org-done-keywords))
12483 (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) 13653 (setq org-todo-keyword-alist-for-agenda
12484 (setq org-tag-alist-for-agenda 13654 (append org-todo-keyword-alist-for-agenda org-todo-key-alist))
12485 (append org-tag-alist-for-agenda org-tag-alist)) 13655 (setq org-tag-alist-for-agenda
13656 (append org-tag-alist-for-agenda org-tag-alist))
12486 13657
12487 (save-excursion 13658 (save-excursion
12488 (remove-text-properties (point-min) (point-max) pall) 13659 (remove-text-properties (point-min) (point-max) pall)
12489 (when org-agenda-skip-archived-trees 13660 (when org-agenda-skip-archived-trees
13661 (goto-char (point-min))
13662 (while (re-search-forward rea nil t)
13663 (if (org-on-heading-p t)
13664 (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
12490 (goto-char (point-min)) 13665 (goto-char (point-min))
12491 (while (re-search-forward rea nil t) 13666 (setq re (concat "^\\*+ +" org-comment-string "\\>"))
12492 (if (org-on-heading-p t) 13667 (while (re-search-forward re nil t)
12493 (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) 13668 (add-text-properties
12494 (goto-char (point-min)) 13669 (match-beginning 0) (org-end-of-subtree t) pc)))
12495 (setq re (concat "^\\*+ +" org-comment-string "\\>")) 13670 (set-buffer-modified-p bmp)))))
12496 (while (re-search-forward re nil t)
12497 (add-text-properties
12498 (match-beginning 0) (org-end-of-subtree t) pc)))
12499 (set-buffer-modified-p bmp))))
12500 (setq org-todo-keyword-alist-for-agenda 13671 (setq org-todo-keyword-alist-for-agenda
12501 (org-uniquify org-todo-keyword-alist-for-agenda) 13672 (org-uniquify org-todo-keyword-alist-for-agenda)
12502 org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda)))) 13673 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]."
12699 (matchers (plist-get opt :matchers)) 13870 (matchers (plist-get opt :matchers))
12700 (re-list org-latex-regexps) 13871 (re-list org-latex-regexps)
12701 (cnt 0) txt link beg end re e checkdir 13872 (cnt 0) txt link beg end re e checkdir
13873 executables-checked
12702 m n block linkfile movefile ov) 13874 m n block linkfile movefile ov)
12703 ;; Check if there are old images files with this prefix, and remove them 13875 ;; Check if there are old images files with this prefix, and remove them
12704 (when (file-directory-p todir) 13876 (when (file-directory-p todir)
@@ -12727,6 +13899,14 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
12727 (unless checkdir ; make sure the directory exists 13899 (unless checkdir ; make sure the directory exists
12728 (setq checkdir t) 13900 (setq checkdir t)
12729 (or (file-directory-p todir) (make-directory todir))) 13901 (or (file-directory-p todir) (make-directory todir)))
13902
13903 (unless executables-checked
13904 (org-check-external-command
13905 "latex" "needed to convert LaTeX fragments to images")
13906 (org-check-external-command
13907 "dvipng" "needed to convert LaTeX fragments to images")
13908 (setq executables-checked t))
13909
12730 (org-create-formula-image 13910 (org-create-formula-image
12731 txt movefile opt forbuffer) 13911 txt movefile opt forbuffer)
12732 (if overlays 13912 (if overlays
@@ -12781,7 +13961,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
12781 (progn (message "Failed to create dvi file from %s" texfile) nil) 13961 (progn (message "Failed to create dvi file from %s" texfile) nil)
12782 (condition-case nil 13962 (condition-case nil
12783 (call-process "dvipng" nil nil nil 13963 (call-process "dvipng" nil nil nil
12784 "-E" "-fg" fg "-bg" bg 13964 "-fg" fg "-bg" bg
12785 "-D" dpi 13965 "-D" dpi
12786 ;;"-x" scale "-y" scale 13966 ;;"-x" scale "-y" scale
12787 "-T" "tight" 13967 "-T" "tight"
@@ -12875,7 +14055,13 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
12875 (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft) 14055 (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft)
12876 (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) 14056 (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright)
12877 (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) 14057 (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright)
12878 (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)) 14058 (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)
14059 (org-defkey org-mode-map [?\e (tab)] 'org-complete)
14060 (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading)
14061 (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft)
14062 (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright)
14063 (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup)
14064 (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown))
12879 14065
12880 ;; All the other keys 14066 ;; All the other keys
12881 14067
@@ -12884,6 +14070,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
12884(if (boundp 'narrow-map) 14070(if (boundp 'narrow-map)
12885 (org-defkey narrow-map "s" 'org-narrow-to-subtree) 14071 (org-defkey narrow-map "s" 'org-narrow-to-subtree)
12886 (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)) 14072 (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree))
14073(org-defkey org-mode-map "\C-c\C-f" 'org-forward-same-level)
14074(org-defkey org-mode-map "\C-c\C-b" 'org-backward-same-level)
12887(org-defkey org-mode-map "\C-c$" 'org-archive-subtree) 14075(org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
12888(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) 14076(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree)
12889(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) 14077(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]."
12899(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) 14087(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree)
12900(org-defkey org-mode-map "\C-c\C-w" 'org-refile) 14088(org-defkey org-mode-map "\C-c\C-w" 'org-refile)
12901(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved 14089(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
12902(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. 14090(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res.
12903(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) 14091(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
12904(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) 14092(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
14093(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift)
12905(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content) 14094(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content)
12906(org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content) 14095(org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content)
12907(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) 14096(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]."
12946(org-defkey org-mode-map "\C-c\C-e" 'org-export) 14135(org-defkey org-mode-map "\C-c\C-e" 'org-export)
12947(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) 14136(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
12948(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) 14137(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
12949(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) 14138(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
14139(org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree)
14140;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree)
12950 14141
12951(org-defkey org-mode-map "\C-c\C-x\C-k" 'org-mark-entry-for-agenda-action) 14142(org-defkey org-mode-map "\C-c\C-x\C-k" 'org-mark-entry-for-agenda-action)
12952(org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special) 14143(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]."
12966(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) 14157(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
12967(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) 14158(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
12968(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) 14159(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock)
14160(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer)
12969 14161
12970(org-defkey org-mode-map "\C-c\C-x." 'org-timer) 14162(org-defkey org-mode-map "\C-c\C-x." 'org-timer)
12971(org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) 14163(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]."
12974 14166
12975(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) 14167(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns)
12976 14168
14169(define-key org-mode-map "\C-c\C-x!" 'org-reload)
14170
14171(define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all)
14172(define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox)
14173
14174(define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation)
14175
14176
12977(when (featurep 'xemacs) 14177(when (featurep 'xemacs)
12978 (org-defkey org-mode-map 'button3 'popup-mode-menu)) 14178 (org-defkey org-mode-map 'button3 'popup-mode-menu))
12979 14179
14180
14181(defvar org-self-insert-command-undo-counter 0)
14182
12980(defvar org-table-auto-blank-field) ; defined in org-table.el 14183(defvar org-table-auto-blank-field) ; defined in org-table.el
12981(defun org-self-insert-command (N) 14184(defun org-self-insert-command (N)
12982 "Like `self-insert-command', use overwrite-mode for whitespace in tables. 14185 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
12983If the cursor is in a table looking at whitespace, the whitespace is 14186If the cursor is in a table looking at whitespace, the whitespace is
12984overwritten, and the table is not marked as requiring realignment." 14187overwritten, and the table is not marked as requiring realignment."
12985 (interactive "p") 14188 (interactive "p")
12986 (if (and (org-table-p) 14189 (if (and
12987 (progn 14190 (org-table-p)
12988 ;; check if we blank the field, and if that triggers align 14191 (progn
12989 (and (featurep 'org-table) org-table-auto-blank-field 14192 ;; check if we blank the field, and if that triggers align
12990 (member last-command 14193 (and (featurep 'org-table) org-table-auto-blank-field
12991 '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) 14194 (member last-command
12992 (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) 14195 '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand))
12993 ;; got extra space, this field does not determine column width 14196 (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |"))
12994 (let (org-table-may-need-update) (org-table-blank-field)) 14197 ;; got extra space, this field does not determine column width
12995 ;; no extra space, this field may determine column width 14198 (let (org-table-may-need-update) (org-table-blank-field))
12996 (org-table-blank-field))) 14199 ;; no extra space, this field may determine column width
12997 t) 14200 (org-table-blank-field)))
12998 (eq N 1) 14201 t)
12999 (looking-at "[^|\n]* |")) 14202 (eq N 1)
14203 (looking-at "[^|\n]* |"))
13000 (let (org-table-may-need-update) 14204 (let (org-table-may-need-update)
13001 (goto-char (1- (match-end 0))) 14205 (goto-char (1- (match-end 0)))
13002 (delete-backward-char 1) 14206 (delete-backward-char 1)
@@ -13004,7 +14208,18 @@ overwritten, and the table is not marked as requiring realignment."
13004 (self-insert-command N)) 14208 (self-insert-command N))
13005 (setq org-table-may-need-update t) 14209 (setq org-table-may-need-update t)
13006 (self-insert-command N) 14210 (self-insert-command N)
13007 (org-fix-tags-on-the-fly))) 14211 (org-fix-tags-on-the-fly)
14212 (if org-self-insert-cluster-for-undo
14213 (if (not (eq last-command 'org-self-insert-command))
14214 (setq org-self-insert-command-undo-counter 1)
14215 (if (>= org-self-insert-command-undo-counter 20)
14216 (setq org-self-insert-command-undo-counter 1)
14217 (and (> org-self-insert-command-undo-counter 0)
14218 buffer-undo-list
14219 (not (cadr buffer-undo-list)) ; remove nil entry
14220 (setcdr buffer-undo-list (cddr buffer-undo-list)))
14221 (setq org-self-insert-command-undo-counter
14222 (1+ org-self-insert-command-undo-counter)))))))
13008 14223
13009(defun org-fix-tags-on-the-fly () 14224(defun org-fix-tags-on-the-fly ()
13010 (when (and (equal (char-after (point-at-bol)) ?*) 14225 (when (and (equal (char-after (point-at-bol)) ?*)
@@ -13100,6 +14315,68 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
13100 'delete-backward-char 'org-delete-backward-char) 14315 'delete-backward-char 'org-delete-backward-char)
13101 (org-defkey org-mode-map "|" 'org-force-self-insert)) 14316 (org-defkey org-mode-map "|" 'org-force-self-insert))
13102 14317
14318(defvar org-ctrl-c-ctrl-c-hook nil
14319 "Hook for functions attaching themselves to `C-c C-c'.
14320This can be used to add additional functionality to the C-c C-c key which
14321executes context-dependent commands.
14322Each function will be called with no arguments. The function must check
14323if the context is appropriate for it to act. If yes, it should do its
14324thing and then return a non-nil value. If the context is wrong,
14325just do nothing and return nil.")
14326
14327(defvar org-tab-first-hook nil
14328 "Hook for functions to attach themselves to TAB.
14329See `org-ctrl-c-ctrl-c-hook' for more information.
14330This hook runs as the first action when TAB is pressed, even before
14331`org-cycle' messes around with the `outline-regexp' to cater for
14332inline tasks and plain list item folding.
14333If any function in this hook returns t, not other actions like table
14334field motion visibility cycling will be done.")
14335
14336(defvar org-tab-after-check-for-table-hook nil
14337 "Hook for functions to attach themselves to TAB.
14338See `org-ctrl-c-ctrl-c-hook' for more information.
14339This hook runs after it has been established that the cursor is not in a
14340table, but before checking if the cursor is in a headline or if global cycling
14341should be done.
14342If any function in this hook returns t, not other actions like visibility
14343cycling will be done.")
14344
14345(defvar org-tab-after-check-for-cycling-hook nil
14346 "Hook for functions to attach themselves to TAB.
14347See `org-ctrl-c-ctrl-c-hook' for more information.
14348This hook runs after it has been established that not table field motion and
14349not visibility should be done because of current context. This is probably
14350the place where a package like yasnippets can hook in.")
14351
14352(defvar org-metaleft-hook nil
14353 "Hook for functions attaching themselves to `M-left'.
14354See `org-ctrl-c-ctrl-c-hook' for more information.")
14355(defvar org-metaright-hook nil
14356 "Hook for functions attaching themselves to `M-right'.
14357See `org-ctrl-c-ctrl-c-hook' for more information.")
14358(defvar org-metaup-hook nil
14359 "Hook for functions attaching themselves to `M-up'.
14360See `org-ctrl-c-ctrl-c-hook' for more information.")
14361(defvar org-metadown-hook nil
14362 "Hook for functions attaching themselves to `M-down'.
14363See `org-ctrl-c-ctrl-c-hook' for more information.")
14364(defvar org-shiftmetaleft-hook nil
14365 "Hook for functions attaching themselves to `M-S-left'.
14366See `org-ctrl-c-ctrl-c-hook' for more information.")
14367(defvar org-shiftmetaright-hook nil
14368 "Hook for functions attaching themselves to `M-S-right'.
14369See `org-ctrl-c-ctrl-c-hook' for more information.")
14370(defvar org-shiftmetaup-hook nil
14371 "Hook for functions attaching themselves to `M-S-up'.
14372See `org-ctrl-c-ctrl-c-hook' for more information.")
14373(defvar org-shiftmetadown-hook nil
14374 "Hook for functions attaching themselves to `M-S-down'.
14375See `org-ctrl-c-ctrl-c-hook' for more information.")
14376(defvar org-metareturn-hook nil
14377 "Hook for functions attaching themselves to `M-RET'.
14378See `org-ctrl-c-ctrl-c-hook' for more information.")
14379
13103(defun org-modifier-cursor-error () 14380(defun org-modifier-cursor-error ()
13104 "Throw an error, a modified cursor command was applied in wrong context." 14381 "Throw an error, a modified cursor command was applied in wrong context."
13105 (error "This command is active in special context like tables, headlines or items")) 14382 (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.
13135See the individual commands for more information." 14412See the individual commands for more information."
13136 (interactive) 14413 (interactive)
13137 (cond 14414 (cond
14415 ((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
13138 ((org-at-table-p) (call-interactively 'org-table-delete-column)) 14416 ((org-at-table-p) (call-interactively 'org-table-delete-column))
13139 ((org-on-heading-p) (call-interactively 'org-promote-subtree)) 14417 ((org-on-heading-p) (call-interactively 'org-promote-subtree))
13140 ((org-at-item-p) (call-interactively 'org-outdent-item)) 14418 ((org-at-item-p) (call-interactively 'org-outdent-item))
@@ -13147,6 +14425,7 @@ or `org-table-insert-column', depending on context.
13147See the individual commands for more information." 14425See the individual commands for more information."
13148 (interactive) 14426 (interactive)
13149 (cond 14427 (cond
14428 ((run-hook-with-args-until-success 'org-shiftmetaright-hook))
13150 ((org-at-table-p) (call-interactively 'org-table-insert-column)) 14429 ((org-at-table-p) (call-interactively 'org-table-insert-column))
13151 ((org-on-heading-p) (call-interactively 'org-demote-subtree)) 14430 ((org-on-heading-p) (call-interactively 'org-demote-subtree))
13152 ((org-at-item-p) (call-interactively 'org-indent-item)) 14431 ((org-at-item-p) (call-interactively 'org-indent-item))
@@ -13159,10 +14438,12 @@ Calls `org-move-subtree-up' or `org-table-kill-row' or
13159for more information." 14438for more information."
13160 (interactive "P") 14439 (interactive "P")
13161 (cond 14440 (cond
14441 ((run-hook-with-args-until-success 'org-shiftmetaup-hook))
13162 ((org-at-table-p) (call-interactively 'org-table-kill-row)) 14442 ((org-at-table-p) (call-interactively 'org-table-kill-row))
13163 ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) 14443 ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
13164 ((org-at-item-p) (call-interactively 'org-move-item-up)) 14444 ((org-at-item-p) (call-interactively 'org-move-item-up))
13165 (t (org-modifier-cursor-error)))) 14445 (t (org-modifier-cursor-error))))
14446
13166(defun org-shiftmetadown (&optional arg) 14447(defun org-shiftmetadown (&optional arg)
13167 "Move subtree down or insert table row. 14448 "Move subtree down or insert table row.
13168Calls `org-move-subtree-down' or `org-table-insert-row' or 14449Calls `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
13170commands for more information." 14451commands for more information."
13171 (interactive "P") 14452 (interactive "P")
13172 (cond 14453 (cond
14454 ((run-hook-with-args-until-success 'org-shiftmetadown-hook))
13173 ((org-at-table-p) (call-interactively 'org-table-insert-row)) 14455 ((org-at-table-p) (call-interactively 'org-table-insert-row))
13174 ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) 14456 ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
13175 ((org-at-item-p) (call-interactively 'org-move-item-down)) 14457 ((org-at-item-p) (call-interactively 'org-move-item-down))
@@ -13182,10 +14464,20 @@ With no specific context, calls the Emacs default `backward-word'.
13182See the individual commands for more information." 14464See the individual commands for more information."
13183 (interactive "P") 14465 (interactive "P")
13184 (cond 14466 (cond
14467 ((run-hook-with-args-until-success 'org-metaleft-hook))
13185 ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) 14468 ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
13186 ((or (org-on-heading-p) (org-region-active-p)) 14469 ((or (org-on-heading-p)
14470 (and (org-region-active-p)
14471 (save-excursion
14472 (goto-char (region-beginning))
14473 (org-on-heading-p))))
13187 (call-interactively 'org-do-promote)) 14474 (call-interactively 'org-do-promote))
13188 ((org-at-item-p) (call-interactively 'org-outdent-item)) 14475 ((or (org-at-item-p)
14476 (and (org-region-active-p)
14477 (save-excursion
14478 (goto-char (region-beginning))
14479 (org-at-item-p))))
14480 (call-interactively 'org-outdent-item))
13189 (t (call-interactively 'backward-word)))) 14481 (t (call-interactively 'backward-word))))
13190 14482
13191(defun org-metaright (&optional arg) 14483(defun org-metaright (&optional arg)
@@ -13195,10 +14487,20 @@ With no specific context, calls the Emacs default `forward-word'.
13195See the individual commands for more information." 14487See the individual commands for more information."
13196 (interactive "P") 14488 (interactive "P")
13197 (cond 14489 (cond
14490 ((run-hook-with-args-until-success 'org-metaright-hook))
13198 ((org-at-table-p) (call-interactively 'org-table-move-column)) 14491 ((org-at-table-p) (call-interactively 'org-table-move-column))
13199 ((or (org-on-heading-p) (org-region-active-p)) 14492 ((or (org-on-heading-p)
14493 (and (org-region-active-p)
14494 (save-excursion
14495 (goto-char (region-beginning))
14496 (org-on-heading-p))))
13200 (call-interactively 'org-do-demote)) 14497 (call-interactively 'org-do-demote))
13201 ((org-at-item-p) (call-interactively 'org-indent-item)) 14498 ((or (org-at-item-p)
14499 (and (org-region-active-p)
14500 (save-excursion
14501 (goto-char (region-beginning))
14502 (org-at-item-p))))
14503 (call-interactively 'org-indent-item))
13202 (t (call-interactively 'forward-word)))) 14504 (t (call-interactively 'forward-word))))
13203 14505
13204(defun org-metaup (&optional arg) 14506(defun org-metaup (&optional arg)
@@ -13208,6 +14510,7 @@ Calls `org-move-subtree-up' or `org-table-move-row' or
13208for more information." 14510for more information."
13209 (interactive "P") 14511 (interactive "P")
13210 (cond 14512 (cond
14513 ((run-hook-with-args-until-success 'org-metaup-hook))
13211 ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) 14514 ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
13212 ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) 14515 ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
13213 ((org-at-item-p) (call-interactively 'org-move-item-up)) 14516 ((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
13220commands for more information." 14523commands for more information."
13221 (interactive "P") 14524 (interactive "P")
13222 (cond 14525 (cond
14526 ((run-hook-with-args-until-success 'org-metadown-hook))
13223 ((org-at-table-p) (call-interactively 'org-table-move-row)) 14527 ((org-at-table-p) (call-interactively 'org-table-move-row))
13224 ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) 14528 ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
13225 ((org-at-item-p) (call-interactively 'org-move-item-down)) 14529 ((org-at-item-p) (call-interactively 'org-move-item-down))
@@ -13237,6 +14541,7 @@ depending on context. See the individual commands for more information."
13237 (call-interactively (if org-edit-timestamp-down-means-later 14541 (call-interactively (if org-edit-timestamp-down-means-later
13238 'org-timestamp-down 'org-timestamp-up))) 14542 'org-timestamp-down 'org-timestamp-up)))
13239 ((and (not (eq org-support-shift-select 'always)) 14543 ((and (not (eq org-support-shift-select 'always))
14544 org-enable-priority-commands
13240 (org-on-heading-p)) 14545 (org-on-heading-p))
13241 (call-interactively 'org-priority-up)) 14546 (call-interactively 'org-priority-up))
13242 ((and (not org-support-shift-select) (org-at-item-p)) 14547 ((and (not org-support-shift-select) (org-at-item-p))
@@ -13258,12 +14563,13 @@ depending on context. See the individual commands for more information."
13258 (call-interactively (if org-edit-timestamp-down-means-later 14563 (call-interactively (if org-edit-timestamp-down-means-later
13259 'org-timestamp-up 'org-timestamp-down))) 14564 'org-timestamp-up 'org-timestamp-down)))
13260 ((and (not (eq org-support-shift-select 'always)) 14565 ((and (not (eq org-support-shift-select 'always))
14566 org-enable-priority-commands
13261 (org-on-heading-p)) 14567 (org-on-heading-p))
13262 (call-interactively 'org-priority-down)) 14568 (call-interactively 'org-priority-down))
13263 ((and (not org-support-shift-select) (org-at-item-p)) 14569 ((and (not org-support-shift-select) (org-at-item-p))
13264 (call-interactively 'org-next-item)) 14570 (call-interactively 'org-next-item))
13265 ((org-clocktable-try-shift 'down arg)) 14571 ((org-clocktable-try-shift 'down arg))
13266 (org-support-shift-select 14572 (org-support-shift-select
13267 (org-call-for-shift-select 'next-line)) 14573 (org-call-for-shift-select 'next-line))
13268 (t (org-shiftselect-error)))) 14574 (t (org-shiftselect-error))))
13269 14575
@@ -13283,7 +14589,11 @@ Depending on context, this does one of the following:
13283 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) 14589 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
13284 ((and (not (eq org-support-shift-select 'always)) 14590 ((and (not (eq org-support-shift-select 'always))
13285 (org-on-heading-p)) 14591 (org-on-heading-p))
13286 (org-call-with-arg 'org-todo 'right)) 14592 (let ((org-inhibit-logging
14593 (not org-treat-S-cursor-todo-selection-as-state-change))
14594 (org-inhibit-blocking
14595 (not org-treat-S-cursor-todo-selection-as-state-change)))
14596 (org-call-with-arg 'org-todo 'right)))
13287 ((or (and org-support-shift-select 14597 ((or (and org-support-shift-select
13288 (not (eq org-support-shift-select 'always)) 14598 (not (eq org-support-shift-select 'always))
13289 (org-at-item-bullet-p)) 14599 (org-at-item-bullet-p))
@@ -13293,7 +14603,7 @@ Depending on context, this does one of the following:
13293 (org-at-property-p)) 14603 (org-at-property-p))
13294 (call-interactively 'org-property-next-allowed-value)) 14604 (call-interactively 'org-property-next-allowed-value))
13295 ((org-clocktable-try-shift 'right arg)) 14605 ((org-clocktable-try-shift 'right arg))
13296 (org-support-shift-select 14606 (org-support-shift-select
13297 (org-call-for-shift-select 'forward-char)) 14607 (org-call-for-shift-select 'forward-char))
13298 (t (org-shiftselect-error)))) 14608 (t (org-shiftselect-error))))
13299 14609
@@ -13313,7 +14623,11 @@ Depending on context, this does one of the following:
13313 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) 14623 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
13314 ((and (not (eq org-support-shift-select 'always)) 14624 ((and (not (eq org-support-shift-select 'always))
13315 (org-on-heading-p)) 14625 (org-on-heading-p))
13316 (org-call-with-arg 'org-todo 'left)) 14626 (let ((org-inhibit-logging
14627 (not org-treat-S-cursor-todo-selection-as-state-change))
14628 (org-inhibit-blocking
14629 (not org-treat-S-cursor-todo-selection-as-state-change)))
14630 (org-call-with-arg 'org-todo 'left)))
13317 ((or (and org-support-shift-select 14631 ((or (and org-support-shift-select
13318 (not (eq org-support-shift-select 'always)) 14632 (not (eq org-support-shift-select 'always))
13319 (org-at-item-bullet-p)) 14633 (org-at-item-bullet-p))
@@ -13323,7 +14637,7 @@ Depending on context, this does one of the following:
13323 (org-at-property-p)) 14637 (org-at-property-p))
13324 (call-interactively 'org-property-previous-allowed-value)) 14638 (call-interactively 'org-property-previous-allowed-value))
13325 ((org-clocktable-try-shift 'left arg)) 14639 ((org-clocktable-try-shift 'left arg))
13326 (org-support-shift-select 14640 (org-support-shift-select
13327 (org-call-for-shift-select 'backward-char)) 14641 (org-call-for-shift-select 'backward-char))
13328 (t (org-shiftselect-error)))) 14642 (t (org-shiftselect-error))))
13329 14643
@@ -13403,11 +14717,15 @@ When in an #+include line, visit the include file. Otherwise call
13403 ((org-edit-fixed-width-region)) 14717 ((org-edit-fixed-width-region))
13404 (t (call-interactively 'ffap)))) 14718 (t (call-interactively 'ffap))))
13405 14719
14720
13406(defun org-ctrl-c-ctrl-c (&optional arg) 14721(defun org-ctrl-c-ctrl-c (&optional arg)
13407 "Set tags in headline, or update according to changed information at point. 14722 "Set tags in headline, or update according to changed information at point.
13408 14723
13409This command does many different things, depending on context: 14724This command does many different things, depending on context:
13410 14725
14726- If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location,
14727 this is what we do.
14728
13411- If the cursor is in a headline, prompt for tags and insert them 14729- If the cursor is in a headline, prompt for tags and insert them
13412 into the current line, aligned to `org-tags-column'. When called 14730 into the current line, aligned to `org-tags-column'. When called
13413 with prefix arg, realign all tags in the current buffer. 14731 with prefix arg, realign all tags in the current buffer.
@@ -13455,6 +14773,7 @@ This command does many different things, depending on context:
13455 ((and (local-variable-p 'org-finish-function (current-buffer)) 14773 ((and (local-variable-p 'org-finish-function (current-buffer))
13456 (fboundp org-finish-function)) 14774 (fboundp org-finish-function))
13457 (funcall org-finish-function)) 14775 (funcall org-finish-function))
14776 ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
13458 ((org-at-property-p) 14777 ((org-at-property-p)
13459 (call-interactively 'org-property-action)) 14778 (call-interactively 'org-property-action))
13460 ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) 14779 ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
@@ -13476,12 +14795,16 @@ This command does many different things, depending on context:
13476 ((org-at-item-checkbox-p) 14795 ((org-at-item-checkbox-p)
13477 (call-interactively 'org-toggle-checkbox)) 14796 (call-interactively 'org-toggle-checkbox))
13478 ((org-at-item-p) 14797 ((org-at-item-p)
13479 (call-interactively 'org-maybe-renumber-ordered-list)) 14798 (if arg
14799 (call-interactively 'org-toggle-checkbox)
14800 (call-interactively 'org-maybe-renumber-ordered-list)))
13480 ((save-excursion (beginning-of-line 1) (looking-at "#\\+BEGIN:")) 14801 ((save-excursion (beginning-of-line 1) (looking-at "#\\+BEGIN:"))
13481 ;; Dynamic block 14802 ;; Dynamic block
13482 (beginning-of-line 1) 14803 (beginning-of-line 1)
13483 (save-excursion (org-update-dblock))) 14804 (save-excursion (org-update-dblock)))
13484 ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) 14805 ((save-excursion
14806 (beginning-of-line 1)
14807 (looking-at "[ \t]*#\\+\\([A-Z]+\\)"))
13485 (cond 14808 (cond
13486 ((equal (match-string 1) "TBLFM") 14809 ((equal (match-string 1) "TBLFM")
13487 ;; Recalculate the table before this line 14810 ;; Recalculate the table before this line
@@ -13495,6 +14818,7 @@ This command does many different things, depending on context:
13495; (org-restart-font-lock) 14818; (org-restart-font-lock)
13496 (let ((org-inhibit-startup t)) (org-mode-restart)) 14819 (let ((org-inhibit-startup t)) (org-mode-restart))
13497 (message "Local setup has been refreshed")))) 14820 (message "Local setup has been refreshed"))))
14821 ((org-clock-update-time-maybe))
13498 (t (error "C-c C-c can do nothing useful at this location."))))) 14822 (t (error "C-c C-c can do nothing useful at this location.")))))
13499 14823
13500(defun org-mode-restart () 14824(defun org-mode-restart ()
@@ -13519,15 +14843,18 @@ See the individual commands for more information."
13519 (interactive) 14843 (interactive)
13520 (cond 14844 (cond
13521 ((bobp) (if indent (newline-and-indent) (newline))) 14845 ((bobp) (if indent (newline-and-indent) (newline)))
14846 ((org-at-table-p)
14847 (org-table-justify-field-maybe)
14848 (call-interactively 'org-table-next-row))
14849 ((and org-return-follows-link
14850 (eq (get-text-property (point) 'face) 'org-link))
14851 (call-interactively 'org-open-at-point))
13522 ((and (org-at-heading-p) 14852 ((and (org-at-heading-p)
13523 (looking-at 14853 (looking-at
13524 (org-re "\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$"))) 14854 (org-re "\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$")))
13525 (org-show-entry) 14855 (org-show-entry)
13526 (end-of-line 1) 14856 (end-of-line 1)
13527 (newline)) 14857 (newline))
13528 ((org-at-table-p)
13529 (org-table-justify-field-maybe)
13530 (call-interactively 'org-table-next-row))
13531 (t (if indent (newline-and-indent) (newline))))) 14858 (t (if indent (newline-and-indent) (newline)))))
13532 14859
13533(defun org-return-indent () 14860(defun org-return-indent ()
@@ -13614,15 +14941,16 @@ If there is no active region, only the current line is considered.
13614If the first line is a heading, remove the stars from all headlines 14941If the first line is a heading, remove the stars from all headlines
13615in the region. 14942in the region.
13616 14943
13617If the first line is a plain list item, turn all plain list items into 14944If the first line is a plain list item, turn all plain list items
13618headings. 14945into headings.
13619 14946
13620If the first line is a normal line, turn each and every line in the region 14947If the first line is a normal line, turn each and every line in the
13621into a heading. 14948region into a heading.
13622 14949
13623When converting a line into a heading, the number of stars is chosen 14950When converting a line into a heading, the number of stars is chosen
13624such that the lines become children of the current entry. However, when 14951such that the lines become children of the current entry. However,
13625a prefix argument is given, its value determines the number of stars to add." 14952when a prefix argument is given, its value determines the number of
14953stars to add."
13626 (interactive "P") 14954 (interactive "P")
13627 (let (l2 l itemp beg end) 14955 (let (l2 l itemp beg end)
13628 (if (org-region-active-p) 14956 (if (org-region-active-p)
@@ -13647,9 +14975,12 @@ a prefix argument is given, its value determines the number of stars to add."
13647 (make-string (prefix-numeric-value current-prefix-arg) 14975 (make-string (prefix-numeric-value current-prefix-arg)
13648 ?*) 14976 ?*)
13649 (save-excursion 14977 (save-excursion
13650 (re-search-backward org-complex-heading-regexp nil t) 14978 (if (re-search-backward org-complex-heading-regexp nil t)
13651 (or (match-string 1) "*")))) 14979 (match-string 1) ""))))
13652 (add-stars (if nstars "" (if org-odd-levels-only "**" "*"))) 14980 (add-stars (cond (nstars "")
14981 ((equal stars "") "*")
14982 (org-odd-levels-only "**")
14983 (t "*")))
13653 (rpl (concat stars add-stars " "))) 14984 (rpl (concat stars add-stars " ")))
13654 (while (< (setq l (1+ l)) l2) 14985 (while (< (setq l (1+ l)) l2)
13655 (if itemp 14986 (if itemp
@@ -13665,6 +14996,7 @@ Calls `org-insert-heading' or `org-table-wrap-region', depending on context.
13665See the individual commands for more information." 14996See the individual commands for more information."
13666 (interactive "P") 14997 (interactive "P")
13667 (cond 14998 (cond
14999 ((run-hook-with-args-until-success 'org-metareturn-hook))
13668 ((org-at-table-p) 15000 ((org-at-table-p)
13669 (call-interactively 'org-table-wrap-region)) 15001 (call-interactively 'org-table-wrap-region))
13670 (t (call-interactively 'org-insert-heading)))) 15002 (t (call-interactively 'org-insert-heading))))
@@ -13760,6 +15092,8 @@ See the individual commands for more information."
13760 ["Cut Subtree" org-cut-special (not (org-at-table-p))] 15092 ["Cut Subtree" org-cut-special (not (org-at-table-p))]
13761 ["Paste Subtree" org-paste-special (not (org-at-table-p))] 15093 ["Paste Subtree" org-paste-special (not (org-at-table-p))]
13762 "--" 15094 "--"
15095 ["Clone subtree, shift time" org-clone-subtree-with-time-shift t]
15096 "--"
13763 ["Promote Heading" org-metaleft (not (org-at-table-p))] 15097 ["Promote Heading" org-metaleft (not (org-at-table-p))]
13764 ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] 15098 ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))]
13765 ["Demote Heading" org-metaright (not (org-at-table-p))] 15099 ["Demote Heading" org-metaright (not (org-at-table-p))]
@@ -13793,6 +15127,25 @@ See the individual commands for more information."
13793 ; :active t :keys "C-u C-c C-x C-s"] 15127 ; :active t :keys "C-u C-c C-x C-s"]
13794 ) 15128 )
13795 "--" 15129 "--"
15130 ("Hyperlinks"
15131 ["Store Link (Global)" org-store-link t]
15132 ["Find existing link to here" org-occur-link-in-agenda-files t]
15133 ["Insert Link" org-insert-link t]
15134 ["Follow Link" org-open-at-point t]
15135 "--"
15136 ["Next link" org-next-link t]
15137 ["Previous link" org-previous-link t]
15138 "--"
15139 ["Descriptive Links"
15140 (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock))
15141 :style radio
15142 :selected (member '(org-link) buffer-invisibility-spec)]
15143 ["Literal Links"
15144 (progn
15145 (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock))
15146 :style radio
15147 :selected (not (member '(org-link) buffer-invisibility-spec))])
15148 "--"
13796 ("TODO Lists" 15149 ("TODO Lists"
13797 ["TODO/DONE/-" org-todo t] 15150 ["TODO/DONE/-" org-todo t]
13798 ("Select keyword" 15151 ("Select keyword"
@@ -13816,7 +15169,11 @@ See the individual commands for more information."
13816 "--" 15169 "--"
13817 ["Set Priority" org-priority t] 15170 ["Set Priority" org-priority t]
13818 ["Priority Up" org-shiftup t] 15171 ["Priority Up" org-shiftup t]
13819 ["Priority Down" org-shiftdown t]) 15172 ["Priority Down" org-shiftdown t]
15173 "--"
15174 ["Get news from all feeds" org-feed-update-all t]
15175 ["Go to the inbox of a feed..." org-feed-goto-inbox t]
15176 ["Customize feeds" (customize-variable 'org-feed-alist) t])
13820 ("TAGS and Properties" 15177 ("TAGS and Properties"
13821 ["Set Tags" org-set-tags-command t] 15178 ["Set Tags" org-set-tags-command t]
13822 ["Change tag in region" org-change-tag-in-region (org-region-active-p)] 15179 ["Change tag in region" org-change-tag-in-region (org-region-active-p)]
@@ -13848,10 +15205,15 @@ See the individual commands for more information."
13848 ["Insert Timer String" org-timer t] 15205 ["Insert Timer String" org-timer t]
13849 ["Insert Timer Item" org-timer-item t]) 15206 ["Insert Timer Item" org-timer-item t])
13850 ("Logging work" 15207 ("Logging work"
13851 ["Clock in" org-clock-in t] 15208 ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"]
15209 ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]
13852 ["Clock out" org-clock-out t] 15210 ["Clock out" org-clock-out t]
13853 ["Clock cancel" org-clock-cancel t] 15211 ["Clock cancel" org-clock-cancel t]
15212 "--"
15213 ["Mark as default task" org-clock-mark-default-task t]
15214 ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"]
13854 ["Goto running clock" org-clock-goto t] 15215 ["Goto running clock" org-clock-goto t]
15216 "--"
13855 ["Display times" org-clock-display t] 15217 ["Display times" org-clock-display t]
13856 ["Create clock table" org-clock-report t] 15218 ["Create clock table" org-clock-report t]
13857 "--" 15219 "--"
@@ -13869,25 +15231,7 @@ See the individual commands for more information."
13869 ["TODO Tree" org-show-todo-tree t] 15231 ["TODO Tree" org-show-todo-tree t]
13870 ["Check Deadlines" org-check-deadlines t] 15232 ["Check Deadlines" org-check-deadlines t]
13871 ["Timeline" org-timeline t] 15233 ["Timeline" org-timeline t]
13872 ["Tags Tree" org-tags-sparse-tree t]) 15234 ["Tags/Property tree" org-match-sparse-tree t])
13873 "--"
13874 ("Hyperlinks"
13875 ["Store Link (Global)" org-store-link t]
13876 ["Insert Link" org-insert-link t]
13877 ["Follow Link" org-open-at-point t]
13878 "--"
13879 ["Next link" org-next-link t]
13880 ["Previous link" org-previous-link t]
13881 "--"
13882 ["Descriptive Links"
13883 (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock))
13884 :style radio
13885 :selected (member '(org-link) buffer-invisibility-spec)]
13886 ["Literal Links"
13887 (progn
13888 (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock))
13889 :style radio
13890 :selected (not (member '(org-link) buffer-invisibility-spec))])
13891 "--" 15235 "--"
13892 ["Export/Publish..." org-export t] 15236 ["Export/Publish..." org-export t]
13893 ("LaTeX" 15237 ("LaTeX"
@@ -13897,6 +15241,8 @@ See the individual commands for more information."
13897 ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] 15241 ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
13898 ["Modify math symbol" org-cdlatex-math-modify 15242 ["Modify math symbol" org-cdlatex-math-modify
13899 (org-inside-LaTeX-fragment-p)] 15243 (org-inside-LaTeX-fragment-p)]
15244 ["Insert citation" org-reftex-citation t]
15245 "--"
13900 ["Export LaTeX fragments as images" 15246 ["Export LaTeX fragments as images"
13901 (if (featurep 'org-exp) 15247 (if (featurep 'org-exp)
13902 (setq org-export-with-LaTeX-fragments 15248 (setq org-export-with-LaTeX-fragments
@@ -13914,7 +15260,10 @@ See the individual commands for more information."
13914 ["Expand This Menu" org-create-customize-menu 15260 ["Expand This Menu" org-create-customize-menu
13915 (fboundp 'customize-menu-create)]) 15261 (fboundp 'customize-menu-create)])
13916 "--" 15262 "--"
13917 ["Refresh setup" org-mode-restart t] 15263 ("Refresh/Reload"
15264 ["Refresh setup current buffer" org-mode-restart t]
15265 ["Reload Org (after update)" org-reload t]
15266 ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x r"])
13918 )) 15267 ))
13919 15268
13920(defun org-info (&optional node) 15269(defun org-info (&optional node)
@@ -13948,9 +15297,44 @@ With optional NODE, go directly to that node."
13948(defun org-require-autoloaded-modules () 15297(defun org-require-autoloaded-modules ()
13949 (interactive) 15298 (interactive)
13950 (mapc 'require 15299 (mapc 'require
13951 '(org-agenda org-archive org-attach org-clock org-colview 15300 '(org-agenda org-archive org-ascii org-attach org-clock org-colview
13952 org-exp org-id org-export-latex org-publish 15301 org-docbook org-exp org-html org-icalendar
13953 org-remember org-table org-timer))) 15302 org-id org-latex
15303 org-publish org-remember org-table
15304 org-timer org-xoxo)))
15305
15306;;;###autoload
15307(defun org-reload (&optional uncompiled)
15308 "Reload all org lisp files.
15309With prefix arg UNCOMPILED, load the uncompiled versions."
15310 (interactive "P")
15311 (require 'find-func)
15312 (let* ((file-re "^\\(org\\|orgtbl\\)\\(\\.el\\|-.*\\.el\\)")
15313 (dir-org (file-name-directory (org-find-library-name "org")))
15314 (dir-org-contrib (ignore-errors
15315 (file-name-directory
15316 (org-find-library-name "org-contribdir"))))
15317 (files
15318 (append (directory-files dir-org t file-re)
15319 (and dir-org-contrib
15320 (directory-files dir-org-contrib t file-re))))
15321 (remove-re (concat (if (featurep 'xemacs)
15322 "org-colview" "org-colview-xemacs")
15323 "\\'")))
15324 (setq files (mapcar 'file-name-sans-extension files))
15325 (setq files (mapcar
15326 (lambda (x) (if (string-match remove-re x) nil x))
15327 files))
15328 (setq files (delq nil files))
15329 (mapc
15330 (lambda (f)
15331 (when (featurep (intern (file-name-nondirectory f)))
15332 (if (and (not uncompiled)
15333 (file-exists-p (concat f ".elc")))
15334 (load (concat f ".elc") nil nil t)
15335 (load (concat f ".el") nil nil t))))
15336 files))
15337 (org-version))
13954 15338
13955;;;###autoload 15339;;;###autoload
13956(defun org-customize () 15340(defun org-customize ()
@@ -14099,6 +15483,31 @@ leave it alone. If it is larger than ind, set it to the target."
14099 (concat (make-string i1 ?\ ) l) 15483 (concat (make-string i1 ?\ ) l)
14100 l))) 15484 l)))
14101 15485
15486(defun org-remove-indentation (code &optional n)
15487 "Remove the maximum common indentation from the lines in CODE.
15488N may optionally be the number of spaces to remove."
15489 (with-temp-buffer
15490 (insert code)
15491 (org-do-remove-indentation n)
15492 (buffer-string)))
15493
15494(defun org-do-remove-indentation (&optional n)
15495 "Remove the maximum common indentation from the buffer."
15496 (untabify (point-min) (point-max))
15497 (let ((min 10000) re)
15498 (if n
15499 (setq min n)
15500 (goto-char (point-min))
15501 (while (re-search-forward "^ *[^ \n]" nil t)
15502 (setq min (min min (1- (- (match-end 0) (match-beginning 0)))))))
15503 (unless (or (= min 0) (= min 10000))
15504 (setq re (format "^ \\{%d\\}" min))
15505 (goto-char (point-min))
15506 (while (re-search-forward re nil t)
15507 (replace-match "")
15508 (end-of-line 1))
15509 min)))
15510
14102(defun org-base-buffer (buffer) 15511(defun org-base-buffer (buffer)
14103 "Return the base buffer of BUFFER, if it has one. Else return the buffer." 15512 "Return the base buffer of BUFFER, if it has one. Else return the buffer."
14104 (if (not buffer) 15513 (if (not buffer)
@@ -14175,6 +15584,16 @@ and end of string."
14175 list))) 15584 list)))
14176 (nreverse list))) 15585 (nreverse list)))
14177 15586
15587(defun org-quote-vert (s)
15588 "Replace \"|\" with \"\\vert\"."
15589 (while (string-match "|" s)
15590 (setq s (replace-match "\\vert" t t s)))
15591 s)
15592
15593(defun org-uuidgen-p (s)
15594 "Is S an ID created by UUIDGEN?"
15595 (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s)))
15596
14178(defun org-context () 15597(defun org-context ()
14179 "Return a list of contexts of the current cursor position. 15598 "Return a list of contexts of the current cursor position.
14180If several contexts apply, all are returned. 15599If several contexts apply, all are returned.
@@ -14343,6 +15762,16 @@ really on, so that the block visually is on the match."
14343 (goto-char pos) 15762 (goto-char pos)
14344 (org-reveal))))))) 15763 (org-reveal)))))))
14345 15764
15765(defun org-occur-link-in-agenda-files ()
15766 "Create a link and search for it in the agendas.
15767The link is not stored in `org-stored-links', it is just created
15768for the search purpose."
15769 (interactive)
15770 (let ((link (condition-case nil
15771 (org-store-link nil)
15772 (error "Unable to create a link to here"))))
15773 (org-occur-in-agenda-files (regexp-quote link))))
15774
14346(defun org-uniquify (list) 15775(defun org-uniquify (list)
14347 "Remove duplicate elements from LIST." 15776 "Remove duplicate elements from LIST."
14348 (let (res) 15777 (let (res)
@@ -14454,9 +15883,10 @@ Counting starts at 1."
14454 (nreverse rtn))) 15883 (nreverse rtn)))
14455 15884
14456(defun org-find-base-buffer-visiting (file) 15885(defun org-find-base-buffer-visiting (file)
14457 "Like `find-buffer-visiting' but alway return the base buffer and 15886 "Like `find-buffer-visiting' but always return the base buffer and
14458not an indirect buffer." 15887not an indirect buffer."
14459 (let ((buf (find-buffer-visiting file))) 15888 (let ((buf (or (get-file-buffer file)
15889 (find-buffer-visiting file))))
14460 (if buf 15890 (if buf
14461 (or (buffer-base-buffer buf) buf) 15891 (or (buffer-base-buffer buf) buf)
14462 nil))) 15892 nil)))
@@ -14521,15 +15951,29 @@ which make use of the date at the cursor."
14521 (interactive) 15951 (interactive)
14522 (let* ((pos (point)) 15952 (let* ((pos (point))
14523 (itemp (org-at-item-p)) 15953 (itemp (org-at-item-p))
15954 (case-fold-search t)
15955 (org-drawer-regexp (or org-drawer-regexp "\000"))
14524 column bpos bcol tpos tcol bullet btype bullet-type) 15956 column bpos bcol tpos tcol bullet btype bullet-type)
14525 ;; Find the previous relevant line 15957 ;; Find the previous relevant line
14526 (beginning-of-line 1) 15958 (beginning-of-line 1)
14527 (cond 15959 (cond
14528 ((looking-at "#") (setq column 0)) 15960 ((looking-at "#") (setq column 0))
14529 ((looking-at "\\*+ ") (setq column 0)) 15961 ((looking-at "\\*+ ") (setq column 0))
15962 ((and (looking-at "[ \t]*:END:")
15963 (save-excursion (re-search-backward org-drawer-regexp nil t)))
15964 (save-excursion
15965 (goto-char (1- (match-beginning 1)))
15966 (setq column (current-column))))
15967 ((and (looking-at "[ \t]+#\\+end_\\([a-z]+\\)")
15968 (save-excursion
15969 (re-search-backward
15970 (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
15971 (setq column (org-get-indentation (match-string 0))))
14530 (t 15972 (t
14531 (beginning-of-line 0) 15973 (beginning-of-line 0)
14532 (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]")) 15974 (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]")
15975 (not (looking-at "[ \t]*:END:"))
15976 (not (looking-at org-drawer-regexp)))
14533 (beginning-of-line 0)) 15977 (beginning-of-line 0))
14534 (cond 15978 (cond
14535 ((looking-at "\\*+[ \t]+") 15979 ((looking-at "\\*+[ \t]+")
@@ -14537,6 +15981,12 @@ which make use of the date at the cursor."
14537 (setq column 0) 15981 (setq column 0)
14538 (goto-char (match-end 0)) 15982 (goto-char (match-end 0))
14539 (setq column (current-column)))) 15983 (setq column (current-column))))
15984 ((looking-at org-drawer-regexp)
15985 (goto-char (1- (match-beginning 1)))
15986 (setq column (current-column)))
15987 ((looking-at "\\([ \t]*\\):END:")
15988 (goto-char (match-end 1))
15989 (setq column (current-column)))
14540 ((org-in-item-p) 15990 ((org-in-item-p)
14541 (org-beginning-of-item) 15991 (org-beginning-of-item)
14542 (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?") 15992 (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?")
@@ -14580,8 +16030,16 @@ which make use of the date at the cursor."
14580 (org-set-local 'comment-start-skip "^#+[ \t]*") 16030 (org-set-local 'comment-start-skip "^#+[ \t]*")
14581 (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]") 16031 (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]")
14582 ;; The paragraph starter includes hand-formatted lists. 16032 ;; The paragraph starter includes hand-formatted lists.
14583 (org-set-local 'paragraph-start 16033 (org-set-local
14584 "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") 16034 'paragraph-start
16035 (concat
16036 "\f" "\\|"
16037 "[ ]*$" "\\|"
16038 "\\*+ " "\\|"
16039 "[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)" "\\|"
16040 "[ \t]*[:|]" "\\|"
16041 "\\$\\$" "\\|"
16042 "\\\\\\(begin\\|end\\|[][]\\)"))
14585 ;; Inhibit auto-fill for headers, tables and fixed-width lines. 16043 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
14586 ;; But only if the user has not turned off tables or fixed-width regions 16044 ;; But only if the user has not turned off tables or fixed-width regions
14587 (org-set-local 16045 (org-set-local
@@ -14660,7 +16118,7 @@ this line is also exported in fixed-width font."
14660 (end (if regionp (region-end))) 16118 (end (if regionp (region-end)))
14661 (nlines (or arg (if (and beg end) (count-lines beg end) 1))) 16119 (nlines (or arg (if (and beg end) (count-lines beg end) 1)))
14662 (case-fold-search nil) 16120 (case-fold-search nil)
14663 (re "[ \t]*\\(:\\)") 16121 (re "[ \t]*\\(: \\)")
14664 off) 16122 off)
14665 (if regionp 16123 (if regionp
14666 (save-excursion 16124 (save-excursion
@@ -14674,11 +16132,11 @@ this line is also exported in fixed-width font."
14674 (cond 16132 (cond
14675 (arg 16133 (arg
14676 (org-move-to-column cc t) 16134 (org-move-to-column cc t)
14677 (insert ":\n") 16135 (insert ": \n")
14678 (forward-line -1)) 16136 (forward-line -1))
14679 ((and off (looking-at re)) 16137 ((and off (looking-at re))
14680 (replace-match "" t t nil 1)) 16138 (replace-match "" t t nil 1))
14681 ((not off) (org-move-to-column cc t) (insert ":"))) 16139 ((not off) (org-move-to-column cc t) (insert ": ")))
14682 (forward-line 1))) 16140 (forward-line 1)))
14683 (save-excursion 16141 (save-excursion
14684 (org-back-to-heading) 16142 (org-back-to-heading)
@@ -14690,6 +16148,36 @@ this line is also exported in fixed-width font."
14690 (goto-char (match-end 0)) 16148 (goto-char (match-end 0))
14691 (insert org-quote-string " ")))))))) 16149 (insert org-quote-string " "))))))))
14692 16150
16151(defun org-reftex-citation ()
16152 "Use reftex-citation to insert a citation into the buffer.
16153This looks for a line like
16154
16155#+BIBLIOGRAPHY: foo plain option:-d
16156
16157and derives from it that foo.bib is the bbliography file relevant
16158for this document. It then installs the necessary environment for RefTeX
16159to work in this buffer and calls `reftex-citation' to insert a citation
16160into the buffer.
16161
16162Export of such citations to both LaTeX and HTML is handled by the contributed
16163package org-exp-bibtex by Taru Karttunen."
16164 (interactive)
16165 (let ((reftex-docstruct-symbol 'rds)
16166 (reftex-cite-format "\\cite{%l}")
16167 rds bib)
16168 (save-excursion
16169 (save-restriction
16170 (widen)
16171 (let ((case-fold-search t)
16172 (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)"))
16173 (if (not (save-excursion
16174 (or (re-search-forward re nil t)
16175 (re-search-backward re nil t))))
16176 (error "No bibliography defined in file")
16177 (setq bib (concat (match-string 1) ".bib")
16178 rds (list (list 'bib bib)))))))
16179 (call-interactively 'reftex-citation)))
16180
14693;;;; Functions extending outline functionality 16181;;;; Functions extending outline functionality
14694 16182
14695(defun org-beginning-of-line (&optional arg) 16183(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
14699first attempt, and only move to after the tags when the cursor is already 16187first attempt, and only move to after the tags when the cursor is already
14700beyond the end of the headline." 16188beyond the end of the headline."
14701 (interactive "P") 16189 (interactive "P")
14702 (let ((pos (point)) refpos) 16190 (let ((pos (point))
14703 (beginning-of-line 1) 16191 (special (if (consp org-special-ctrl-a/e)
16192 (car org-special-ctrl-a/e)
16193 org-special-ctrl-a/e))
16194 refpos)
16195 (if (org-bound-and-true-p line-move-visual)
16196 (beginning-of-visual-line 1)
16197 (beginning-of-line 1))
14704 (if (and arg (fboundp 'move-beginning-of-line)) 16198 (if (and arg (fboundp 'move-beginning-of-line))
14705 (call-interactively 'move-beginning-of-line) 16199 (call-interactively 'move-beginning-of-line)
14706 (if (bobp) 16200 (if (bobp)
@@ -14711,14 +16205,14 @@ beyond the end of the headline."
14711 (backward-char 1) 16205 (backward-char 1)
14712 (beginning-of-line 1)) 16206 (beginning-of-line 1))
14713 (forward-char 1)))) 16207 (forward-char 1))))
14714 (when org-special-ctrl-a/e 16208 (when special
14715 (cond 16209 (cond
14716 ((and (looking-at org-complex-heading-regexp) 16210 ((and (looking-at org-complex-heading-regexp)
14717 (= (char-after (match-end 1)) ?\ )) 16211 (= (char-after (match-end 1)) ?\ ))
14718 (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) 16212 (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
14719 (point-at-eol))) 16213 (point-at-eol)))
14720 (goto-char 16214 (goto-char
14721 (if (eq org-special-ctrl-a/e t) 16215 (if (eq special t)
14722 (cond ((> pos refpos) refpos) 16216 (cond ((> pos refpos) refpos)
14723 ((= pos (point)) refpos) 16217 ((= pos (point)) refpos)
14724 (t (point))) 16218 (t (point)))
@@ -14727,7 +16221,7 @@ beyond the end of the headline."
14727 (t refpos))))) 16221 (t refpos)))))
14728 ((org-at-item-p) 16222 ((org-at-item-p)
14729 (goto-char 16223 (goto-char
14730 (if (eq org-special-ctrl-a/e t) 16224 (if (eq special t)
14731 (cond ((> pos (match-end 4)) (match-end 4)) 16225 (cond ((> pos (match-end 4)) (match-end 4))
14732 ((= pos (point)) (match-end 4)) 16226 ((= pos (point)) (match-end 4))
14733 (t (point))) 16227 (t (point)))
@@ -14743,32 +16237,57 @@ If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
14743first attempt, and only move to after the tags when the cursor is already 16237first attempt, and only move to after the tags when the cursor is already
14744beyond the end of the headline." 16238beyond the end of the headline."
14745 (interactive "P") 16239 (interactive "P")
14746 (if (or (not org-special-ctrl-a/e) 16240 (let ((special (if (consp org-special-ctrl-a/e)
14747 (not (org-on-heading-p)) 16241 (cdr org-special-ctrl-a/e)
14748 arg) 16242 org-special-ctrl-a/e)))
14749 (call-interactively (if (fboundp 'move-end-of-line) 16243 (if (or (not special)
14750 'move-end-of-line 16244 (not (org-on-heading-p))
14751 'end-of-line)) 16245 arg)
14752 (let ((pos (point))) 16246 (call-interactively
14753 (beginning-of-line 1) 16247 (cond ((org-bound-and-true-p line-move-visual) 'end-of-visual-line)
14754 (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) 16248 ((fboundp 'move-end-of-line) 'move-end-of-line)
14755 (if (eq org-special-ctrl-a/e t) 16249 (t 'end-of-line)))
14756 (if (or (< pos (match-beginning 1)) 16250 (let ((pos (point)))
14757 (= pos (match-end 0))) 16251 (beginning-of-line 1)
14758 (goto-char (match-beginning 1)) 16252 (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))
14759 (goto-char (match-end 0))) 16253 (if (eq special t)
14760 (if (or (< pos (match-end 0)) (not (eq this-command last-command))) 16254 (if (or (< pos (match-beginning 1))
14761 (goto-char (match-end 0)) 16255 (= pos (match-end 0)))
14762 (goto-char (match-beginning 1)))) 16256 (goto-char (match-beginning 1))
14763 (call-interactively (if (fboundp 'move-end-of-line) 16257 (goto-char (match-end 0)))
14764 'move-end-of-line 16258 (if (or (< pos (match-end 0)) (not (eq this-command last-command)))
14765 'end-of-line))))) 16259 (goto-char (match-end 0))
14766 (org-no-warnings 16260 (goto-char (match-beginning 1))))
14767 (and (featurep 'xemacs) (setq zmacs-region-stays t)))) 16261 (call-interactively (if (fboundp 'move-end-of-line)
16262 'move-end-of-line
16263 'end-of-line)))))
16264 (org-no-warnings
16265 (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
14768 16266
14769(define-key org-mode-map "\C-a" 'org-beginning-of-line) 16267(define-key org-mode-map "\C-a" 'org-beginning-of-line)
14770(define-key org-mode-map "\C-e" 'org-end-of-line) 16268(define-key org-mode-map "\C-e" 'org-end-of-line)
14771 16269
16270(defun org-backward-sentence (&optional arg)
16271 "Go to beginning of sentence, or beginning of table field.
16272This will call `backward-sentence' or `org-table-beginning-of-field',
16273depending on context."
16274 (interactive "P")
16275 (cond
16276 ((org-at-table-p) (call-interactively 'org-table-beginning-of-field))
16277 (t (call-interactively 'backward-sentence))))
16278
16279(defun org-forward-sentence (&optional arg)
16280 "Go to end of sentence, or end of table field.
16281This will call `forward-sentence' or `org-table-end-of-field',
16282depending on context."
16283 (interactive "P")
16284 (cond
16285 ((org-at-table-p) (call-interactively 'org-table-end-of-field))
16286 (t (call-interactively 'forward-sentence))))
16287
16288(define-key org-mode-map "\M-a" 'org-backward-sentence)
16289(define-key org-mode-map "\M-e" 'org-forward-sentence)
16290
14772(defun org-kill-line (&optional arg) 16291(defun org-kill-line (&optional arg)
14773 "Kill line, to tags or end of line." 16292 "Kill line, to tags or end of line."
14774 (interactive "P") 16293 (interactive "P")
@@ -14806,12 +16325,24 @@ Any prefix to this command will cause `yank' to be called directly with
14806no special treatment. In particular, a simple `C-u' prefix will just 16325no special treatment. In particular, a simple `C-u' prefix will just
14807plainly yank the text as it is. 16326plainly yank the text as it is.
14808 16327
14809\[1] Basically, the test checks if the first non-white line is a heading 16328\[1] The test checks if the first non-white line is a heading
14810 and if there are no other headings with fewer stars." 16329 and if there are no other headings with fewer stars."
14811 (interactive "P") 16330 (interactive "P")
14812 (setq this-command 'yank) 16331 (org-yank-generic 'yank arg))
16332
16333(defun org-yank-generic (command arg)
16334 "Perform some yank-like command.
16335
16336This function implements the behavior described in the `org-yank'
16337documentation. However, it has been generalized to work for any
16338interactive command with similar behavior."
16339
16340 ;; pretend to be command COMMAND
16341 (setq this-command command)
16342
14813 (if arg 16343 (if arg
14814 (call-interactively 'yank) 16344 (call-interactively command)
16345
14815 (let ((subtreep ; is kill a subtree, and the yank position appropriate? 16346 (let ((subtreep ; is kill a subtree, and the yank position appropriate?
14816 (and (org-kill-is-subtree-p) 16347 (and (org-kill-is-subtree-p)
14817 (or (bolp) 16348 (or (bolp)
@@ -14826,7 +16357,8 @@ plainly yank the text as it is.
14826 end) 16357 end)
14827 (if (and subtreep org-yank-adjusted-subtrees) 16358 (if (and subtreep org-yank-adjusted-subtrees)
14828 (org-paste-subtree nil nil 'for-yank) 16359 (org-paste-subtree nil nil 'for-yank)
14829 (call-interactively 'yank)) 16360 (call-interactively command))
16361
14830 (setq end (point)) 16362 (setq end (point))
14831 (goto-char beg) 16363 (goto-char beg)
14832 (when (and (bolp) subtreep 16364 (when (and (bolp) subtreep
@@ -14842,7 +16374,8 @@ plainly yank the text as it is.
14842 (error (goto-char end))))) 16374 (error (goto-char end)))))
14843 (when swallowp 16375 (when swallowp
14844 (message 16376 (message
14845 "Yanked text not folded because that would swallow text")) 16377 "Inserted text not folded because that would swallow text"))
16378
14846 (goto-char end) 16379 (goto-char end)
14847 (skip-chars-forward " \t\n\r") 16380 (skip-chars-forward " \t\n\r")
14848 (beginning-of-line 1) 16381 (beginning-of-line 1)
@@ -14852,7 +16385,7 @@ plainly yank the text as it is.
14852 (org-paste-subtree nil nil 'for-yank) 16385 (org-paste-subtree nil nil 'for-yank)
14853 (push-mark beg 'nomsg))) 16386 (push-mark beg 'nomsg)))
14854 (t 16387 (t
14855 (call-interactively 'yank)))))) 16388 (call-interactively command))))))
14856 16389
14857(defun org-yank-folding-would-swallow-text (beg end) 16390(defun org-yank-folding-would-swallow-text (beg end)
14858 "Would hide-subtree at BEG swallow any text after END?" 16391 "Would hide-subtree at BEG swallow any text after END?"
@@ -14920,7 +16453,11 @@ With argument, move up ARG levels."
14920(defun org-up-heading-safe () 16453(defun org-up-heading-safe ()
14921 "Move to the heading line of which the present line is a subheading. 16454 "Move to the heading line of which the present line is a subheading.
14922This version will not throw an error. It will return the level of the 16455This version will not throw an error. It will return the level of the
14923headline found, or nil if no higher level is found." 16456headline found, or nil if no higher level is found.
16457
16458Also, this function will be a lot faster than `outline-up-heading',
16459because it relies on stars being the outline starters. This can really
16460make a significant difference in outlines with very many siblings."
14924 (let (start-level re) 16461 (let (start-level re)
14925 (org-back-to-heading t) 16462 (org-back-to-heading t)
14926 (setq start-level (funcall outline-level)) 16463 (setq start-level (funcall outline-level))
@@ -14993,23 +16530,6 @@ When ENTRY is non-nil, show the entire entry."
14993 (save-excursion (outline-end-of-heading) (point)) 16530 (save-excursion (outline-end-of-heading) (point))
14994 flag)))) 16531 flag))))
14995 16532
14996(defun org-forward-same-level (arg)
14997 "Move forward to the ARG'th subheading at same level as this one.
14998Stop at the first and last subheadings of a superior heading.
14999This is like outline-forward-same-level, but invisible headings are ok."
15000 (interactive "p")
15001 (org-back-to-heading t)
15002 (while (> arg 0)
15003 (let ((point-to-move-to (save-excursion
15004 (org-get-next-sibling))))
15005 (if point-to-move-to
15006 (progn
15007 (goto-char point-to-move-to)
15008 (setq arg (1- arg)))
15009 (progn
15010 (setq arg 0)
15011 (error "No following same-level heading"))))))
15012
15013(defun org-get-next-sibling () 16533(defun org-get-next-sibling ()
15014 "Move to next heading of the same level, and return point. 16534 "Move to next heading of the same level, and return point.
15015If there is no such heading, return nil. 16535If there is no such heading, return nil.
@@ -15023,27 +16543,85 @@ This is like outline-next-sibling, but invisible headings are ok."
15023 (point)))) 16543 (point))))
15024 16544
15025(defun org-end-of-subtree (&optional invisible-OK to-heading) 16545(defun org-end-of-subtree (&optional invisible-OK to-heading)
15026 ;; This is an exact copy of the original function, but it uses 16546 ;; This contains an exact copy of the original function, but it uses
15027 ;; `org-back-to-heading', to make it work also in invisible 16547 ;; `org-back-to-heading', to make it work also in invisible
15028 ;; trees. And is uses an invisible-OK argument. 16548 ;; trees. And is uses an invisible-OK argument.
15029 ;; Under Emacs this is not needed, but the old outline.el needs this fix. 16549 ;; Under Emacs this is not needed, but the old outline.el needs this fix.
16550 ;; Furthermore, when used inside Org, finding the end of a large subtree
16551 ;; with many children and grandchildren etc, this can be much faster
16552 ;; than the outline version.
15030 (org-back-to-heading invisible-OK) 16553 (org-back-to-heading invisible-OK)
15031 (let ((first t) 16554 (let ((first t)
15032 (level (funcall outline-level))) 16555 (level (funcall outline-level)))
15033 (while (and (not (eobp)) 16556 (if (and (org-mode-p) (< level 1000))
15034 (or first (> (funcall outline-level) level))) 16557 ;; A true heading (not a plain list item), in Org-mode
15035 (setq first nil) 16558 ;; This means we can easily find the end by looking
15036 (outline-next-heading)) 16559 ;; only for the right number of stars. Using a regexp to do
16560 ;; this is so much faster than using a Lisp loop.
16561 (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} ")))
16562 (forward-char 1)
16563 (and (re-search-forward re nil 'move) (beginning-of-line 1)))
16564 ;; something else, do it the slow way
16565 (while (and (not (eobp))
16566 (or first (> (funcall outline-level) level)))
16567 (setq first nil)
16568 (outline-next-heading)))
15037 (unless to-heading 16569 (unless to-heading
15038 (if (memq (preceding-char) '(?\n ?\^M)) 16570 (if (memq (preceding-char) '(?\n ?\^M))
15039 (progn 16571 (progn
15040 ;; Go to end of line before heading 16572 ;; Go to end of line before heading
15041 (forward-char -1) 16573 (forward-char -1)
15042 (if (memq (preceding-char) '(?\n ?\^M)) 16574 (if (memq (preceding-char) '(?\n ?\^M))
15043 ;; leave blank line before heading 16575 ;; leave blank line before heading
15044 (forward-char -1)))))) 16576 (forward-char -1))))))
15045 (point)) 16577 (point))
15046 16578
16579(defadvice outline-end-of-subtree (around prefer-org-version activate compile)
16580 "Use Org version in org-mode, for dramatic speed-up."
16581 (if (eq major-mode 'org-mode)
16582 (progn
16583 (org-end-of-subtree nil t)
16584 (backward-char 1))
16585 ad-do-it))
16586
16587(defun org-forward-same-level (arg &optional invisible-ok)
16588 "Move forward to the arg'th subheading at same level as this one.
16589Stop at the first and last subheadings of a superior heading."
16590 (interactive "p")
16591 (org-back-to-heading invisible-ok)
16592 (org-on-heading-p)
16593 (let* ((level (- (match-end 0) (match-beginning 0) 1))
16594 (re (format "^\\*\\{1,%d\\} " level))
16595 l)
16596 (forward-char 1)
16597 (while (> arg 0)
16598 (while (and (re-search-forward re nil 'move)
16599 (setq l (- (match-end 0) (match-beginning 0) 1))
16600 (= l level)
16601 (not invisible-ok)
16602 (org-invisible-p))
16603 (if (< l level) (setq arg 1)))
16604 (setq arg (1- arg)))
16605 (beginning-of-line 1)))
16606
16607(defun org-backward-same-level (arg &optional invisible-ok)
16608 "Move backward to the arg'th subheading at same level as this one.
16609Stop at the first and last subheadings of a superior heading."
16610 (interactive "p")
16611 (org-back-to-heading)
16612 (org-on-heading-p)
16613 (let* ((level (- (match-end 0) (match-beginning 0) 1))
16614 (re (format "^\\*\\{1,%d\\} " level))
16615 l)
16616 (while (> arg 0)
16617 (while (and (re-search-backward re nil 'move)
16618 (setq l (- (match-end 0) (match-beginning 0) 1))
16619 (= l level)
16620 (not invisible-ok)
16621 (org-invisible-p))
16622 (if (< l level) (setq arg 1)))
16623 (setq arg (1- arg)))))
16624
15047(defun org-show-subtree () 16625(defun org-show-subtree ()
15048 "Show everything after this heading at deeper levels." 16626 "Show everything after this heading at deeper levels."
15049 (outline-flag-region 16627 (outline-flag-region
@@ -15063,20 +16641,23 @@ Show the heading too, if it is currently invisible."
15063 (outline-flag-region 16641 (outline-flag-region
15064 (max (point-min) (1- (point))) 16642 (max (point-min) (1- (point)))
15065 (save-excursion 16643 (save-excursion
15066 (re-search-forward 16644 (if (re-search-forward
15067 (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) 16645 (concat "[\r\n]\\(" outline-regexp "\\)") nil t)
15068 (or (match-beginning 1) (point-max))) 16646 (match-beginning 1)
15069 nil)) 16647 (point-max)))
16648 nil)
16649 (org-cycle-hide-drawers 'children))
15070 (error nil)))) 16650 (error nil))))
15071 16651
15072(defun org-make-options-regexp (kwds) 16652(defun org-make-options-regexp (kwds &optional extra)
15073 "Make a regular expression for keyword lines." 16653 "Make a regular expression for keyword lines."
15074 (concat 16654 (concat
15075 "^" 16655 "^"
15076 "#?[ \t]*\\+\\(" 16656 "#?[ \t]*\\+\\("
15077 (mapconcat 'regexp-quote kwds "\\|") 16657 (mapconcat 'regexp-quote kwds "\\|")
16658 (if extra (concat "\\|" extra))
15078 "\\):[ \t]*" 16659 "\\):[ \t]*"
15079 "\\(.+\\)")) 16660 "\\(.*\\)"))
15080 16661
15081;; Make isearch reveal the necessary context 16662;; Make isearch reveal the necessary context
15082(defun org-isearch-end () 16663(defun org-isearch-end ()
@@ -15226,7 +16807,15 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
15226;; Make flyspell not check words in links, to not mess up our keymap 16807;; Make flyspell not check words in links, to not mess up our keymap
15227(defun org-mode-flyspell-verify () 16808(defun org-mode-flyspell-verify ()
15228 "Don't let flyspell put overlays at active buttons." 16809 "Don't let flyspell put overlays at active buttons."
15229 (not (get-text-property (point) 'keymap))) 16810 (and (not (get-text-property (point) 'keymap))
16811 (not (get-text-property (point) 'org-no-flyspell))))
16812
16813(defun org-remove-flyspell-overlays-in (beg end)
16814 "Remove flyspell overlays in region."
16815 (and (org-bound-and-true-p flyspell-mode)
16816 (fboundp 'flyspell-delete-region-overlays)
16817 (flyspell-delete-region-overlays beg end))
16818 (add-text-properties beg end '(org-no-flyspell t)))
15230 16819
15231;; Make `bookmark-jump' show the jump location if it was hidden. 16820;; Make `bookmark-jump' show the jump location if it was hidden.
15232(eval-after-load "bookmark" 16821(eval-after-load "bookmark"
@@ -15279,7 +16868,6 @@ Still experimental, may disappear in the future."
15279 ;; make tree, check each match with the callback 16868 ;; make tree, check each match with the callback
15280 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) 16869 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback)))
15281 16870
15282
15283;;;; Finish up 16871;;;; Finish up
15284 16872
15285(provide 'org) 16873(provide 'org)