diff options
Diffstat (limited to 'lisp/org')
97 files changed, 32689 insertions, 6834 deletions
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 00bbd9e9b79..00753467631 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,16 +1,6609 @@ -2010-10-22 Juanma Barranquero <lekktu@gmail.com> +2011-01-13 Stefan Monnier <monnier@iro.umontreal.ca> - * org-exp.el (org-export-visible): Fix typo in docstring. + * org-remember.el (org-remember-mode): + * org-capture.el (org-capture-mode): Don't run hook redundantly. -2010-10-12 Juanma Barranquero <lekktu@gmail.com> +2011-01-09 Chong Yidong <cyd@stupidchicken.com> - * org-agenda.el (org-prefix-category-length) - (org-prefix-category-max-length): Fix typos in docstrings. + * org-faces.el (org-link): Inherit from link face. + Suggested by Joakim Verona. + +2010-12-11 Tassilo Horn <tassilo@member.fsf.org> + + * org-footnote.el (org-footnote-create-definition): Place + Footnotes section before message-signature-separator also in modes + derived from message-mode. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org.el (org-make-tags-matcher): Remove useless cat-p value. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org.el (org-entry-properties): Enhance docstring. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-top-point-with-indent) + (org-list-bottom-point-with-indent): Pay also attention to + 'original-indentation property of text, as blocks are put to + column 0 upon exporting. + +2010-12-11 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-remove-temporary-directory): Handle exception + with message informing of failure to remove directory. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-header-arg-names:clojure): Add + `package' to the list of Clojure header arguments which will be read + from heading properties. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-inlinetask.el (org-inlinetask-export-templates): Add + Sébastien Vauban's suggestion for LaTeX export in docstring. This is + not default as it requires an additional LaTeX package: "todonotes". + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-inlinetask.el (org-inlinetask-export-templates): New variable. + + * org-inlinetask.el (org-inlinetask-export-handler): Make use of + templates to export inline tasks. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-current-level): Ignore inline tasks when getting current + level of entry. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): Ignore drawers inside inline + tasks if the line to indent isn't inside an inline task itself. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-inlinetask.el (org-inlinetask-get-task-level): New function. + + * org-indent.el (org-indent-add-properties): Find true level of + indentation wrt inline tasks. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-inlinetask.el (org-inlinetask-outline-regexp): New function. + + * org-inlinetask.el (org-inlinetask-goto-beginning): New function. + + * org-inlinetask.el (org-inlinetask-goto-end): New function. + + * org.el (org-mark-subtree): New command. + + * org.el (org-speed-commands-default, org-mode-map): Make use of + new command. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-inlinetask.el (org-inlinetask-export-handler): Remove protection + from @<span class...> so it can be removed during LaTeX export. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): More informative code block + evaluation messages. + +2010-12-11 Matt Lundin <mdl@imapmail.org> + + * org.el (org-make-heading-search-string): Optionally limit number + of lines stored in file link search strings. + (org-context-in-file-links) Add option to set to integer specifying + number of lines. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-finalize): New prefix argument + STAY-WITH-CAPTURE. + (org-capture-refile): Improve docstring. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sql.el (org-babel-execute:sql): Add msosql as optional sql + interaction engine. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-list): + (org-agenda-goto-today): Use `org-today'. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-make-header): Swap \begin{document} + and the title/author definitions. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el: Better backup definition for + `with-silent-modifications'. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-execute:python): Rename "prefix" to + "preamble". + (org-babel-python-evaluate): Rename "prefix" to "preamble". + (org-babel-python-evaluate-external-process): Rename "prefix" to + "preamble". + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-examplize-region): Check if `end' is a marker + or a point and handle appropriately. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sql.el (org-babel-execute:sql): Explicitly set field + separator to \t when importing tabular data. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-custom-commands-local-options): + Allow org-agenda-span to be a symbol. + (org-agenda-ndays): Make obsolete. + (org-agenda-span): New variable superseding org-agenda-ndays. + (org-agenda-menu): Use org-agenda-current-span. + (org-agenda-current-span): New local variable storing current + span. + (org-agenda-list): Take a span instead of ndays as argument. + This function is now responsible for computing the ndays based + on span. + (org-agenda-ndays-to-span): Return span only if number of days + really matches. + (org-agenda-span-to-ndays): New function. + (org-agenda-manipulate-query): Use org-agenda-compute-starting-span. + (org-agenda-goto-today): Use org-agenda-compute-starting-span. + (org-agenda-later): Do not give compute a new span, use the + current one. + (org-agenda-day-view, org-agenda-week-view) + (org-agenda-month-view, org-agenda-year-view): Stop touching + org-agenda-ndays. + (org-agenda-change-time-span): Only compute starting-span. + (org-agenda-compute-starting-span): New function derived from + the old org-agenda-compute-time-span. + (org-agenda-set-mode-name): Compute mode based on + org-agenda-current-span. + (org-agenda-span-name): New function. + +2010-12-11 Robert Pluim <rpluim@gmail.com> (tiny change) + + * org-agenda.el (org-agenda-toggle-deadlines): Fix docstring. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-quarter-to-date): Define variables. + (org-clock-special-range): Defin variables. Use org-floor*. + (org-clocktable-write-default): Define tcol. + + * org-compat.el (org-floor*): New function. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + John Wiegley <jwiegley@gmail.com> + + * org-complete.el: New file. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clocktable-write-default): Fix the % formula. + +2010-12-11 Matt Lundin <mdl@imapmail.org> + + * org-agenda.el (org-format-agenda-item): The value of + org-category is not converted to a string unless it is defined. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-execute:python): Pass the new "prefix" + header argument through to external evaluation. + (org-babel-python-evaluate): Pass the new "prefix" header argument + through to external evaluation. + (org-babel-python-evaluate-external-process): When specified prepend + "prefix" to the file used in external evaluation. + +2010-12-11 Dan Davison <dandavison7@gmail.com> + + * ob-python.el (org-babel-python-evaluate-session): Change python + module name from 'pp' to 'pprint'. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-R.el (org-babel-R-evaluate-session): Removing empty lines + from R session output, these are often the result of variable + assignments. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sql.el (orgtbl-to-csv): Declaring an external function to + fix a compiler warning. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-eval.el (require): No longer require ob.el to allow + requiring by ob.el. + + * ob.el (ob-eval): Require ob-eval. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-confirm-evaluate): Show code block's name when + it is available during evaluation query. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sql.el (org-babel-expand-body:sql): Expand the body of a sql + code block. + (org-babel-execute:sql): Use sql specific body expansion function. + (org-babel-sql-expand-vars): Insert variables into a sql code block. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): Using markers instead of + points for more robust buffer anchors. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org-capture.el: Use org-today. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org-habit.el: Use org-today. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org.el (org-auto-repeat-maybe): Use org-today. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-day-of-week): New function. + (org-quarter-to-date): New function. + (org-clock-special-range): Implement quarters. + +2010-12-11 Sébastien Vauban <wxhgmqzgwmuf@spammotel.com> + + * org.el (org-complete-tags-always-offer-all-agenda-tags): + Fix docstring. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-format-agenda-item): Convert category to a string + if it is a symbol. This fixes the following call to + org-agenda-get-category-icon which fails if category is not a string. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el: Updated requirements documentation to mention + the minimum version of Clojure. + (org-babel-expand-body:clojure): Fully qualified function name. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-lists): Do not add an + unnecessary newline character after a list. + + * org-list.el (org-list-bottom-point-with-indent): Ensure bottom + point is just after a non blank line. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-examplize-region): Remove old assertion which + no longer applies to the result insertion code. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-execute:python): Use a :return header + argument for external evaluation in which the code block body need + be wrapped in a function + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-expand-body:clojure): Trapped free + variable. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-edit-special): Edit formulas when in TBLMF line + +2010-12-11 Allen S. Rout <asr@ufl.edu> (tiny change) + + * org-capture.el (org-capture-after-finalize-hook): New hook. + (org-capture-finalize): Run the new hook. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-expand-body:clojure): Support for + pretty printing of Clojure code and data. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): No longer escape results which + will be wrapped in a block. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-eval.el (org-babel-eval-wipe-error-buffer): Fix compiler + warning and added documentation string. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-execute:clojure): Remade using slime + for all code evaluation. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-sectioning): Allow overlay arguments for + the column as well. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-confirm-evaluate): More descriptive message + when evaluation is aborted or disabled. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): Responds to new "wrap" header + argument. + (org-babel-merge-params): Includes new "wrap" header argument in + one of the results header argument exclusive groups. + +2010-12-11 David Maus <dmaus@ictsoc.de> + + * org-macs.el (with-silent-modifications): Fix condition for + with-silent-modification. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-parse-header-arguments): Stripping trailing + spaces off of header arguments (even the first one). + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sh.el (org-babel-sh-var-to-sh): Wrap end token of heredoc in + single quotes which is the best practice. + (org-babel-sh-table-or-results): Use `org-babel-script-escape' for + more robust parsing of shell output. + +2010-12-11 Dan Davison <dandavison7@gmail.com> + + * org.el (org-additional-option-like-keywords): Add more keywords, + and colons to some old ones. + +2010-12-11 Dan Davison <dandavison7@gmail.com> + + * ob-eval.el (org-babel-error-buffer-name): Define new variable. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-python-table-or-string): + Using `org-babel-script-escape' for reading string input from scripting + languages. + +2010-12-11 Achim Gratz <Stromeko@nexgo.de> (tiny change) + + * org-macs.el (org-called-interactively-p): Wrap function call in + with-no-warnings. + (with-silent-modifications) Declare macro for Emacs < 23.2. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-parse-header-arguments): Remove addition of + ":" to singleton first header arguments as it was leading to errors. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-make-header): Run the title through + `org-export-latex-fontify-headline'. + (org-export-latex-fontify-headline): Do the protection of math + snippets also here. + +2010-12-11 Richard Lawrence <richard.lawrence@berkeley.edu> + + * org-latex.el (org-export-as-latex): Sent the section title + through the preprocessor. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-html-level-start): Mark listified headings + with a custom id. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-open-at-point): Don't do footnote action if cursor is + on a bracket link. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-edit-special): Check also for TBLFM line. + +2010-12-11 Achim Gratz <Stromeko@Stromeko.DE> (tiny change) + + * org-clock.el (org-get-clocktable): Previous patch incorrectly + required whitespace in front of #+BEGIN: and #+END: + +2010-12-11 Dan Davison <dandavison7@gmail.com> + + * org-src.el (org-edit-src-code): Allow region to be inherited by + edit buffer when mark is one character beyond end of src block. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-list-bullet): Ensure point is at bol before + checking item indentation. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-map-src-blocks): Move to earlier in the file + and now autoloading. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-at-ref-p): Use higher level function + for testing list membership. + + * ob.el (org-babel-read-result): Use higher level function for + testing list membership. + (org-babel-result-end): Use higher level function for testing list + membership. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sqlite.el (ob-eval): Require ob-eval for external command + execution. + (org-babel-execute:sqlite): No longer uses the init option for + passing commands to sqlite. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): Drawers and blocks have no + influence on indentation of text below. Also fix indentation + problem with a block at column 0 and add a special case for + literal examples. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-map-src-blocks): Ensure that the file argument + is only evaluated once. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-resolve): Recognize `list' as a unique + type of data + (org-babel-ref-at-ref-p): Recognize `list' as a unique type of data + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-load-file): Can be called interactively. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) + + * org-table.el (orgtbl-after-send-table-hook): New hook. + (orgtbl-ctrl-c-ctrl-c): Run `orgtbl-after-send-table-hook' when a + table was sent. + (orgtbl-send-table): Return the number of sent tables, or nil if no + sending has happened. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-get-priority-function): New option. + (org-get-priority): Call `org-get-priority-function' if that + has been set. + +2010-12-11 Dan Davison <dandavison7@gmail.com> + + * ob-table.el (org-babel-table-truncate-at-newline): Only add + "..." if there is something after the newline. + +2010-12-11 Achim Gratz <Stromeko@nexgo.de> (tiny change) + + * org-clock.el (org-get-clocktable): + (org-in-clocktable-p): + (org-clocktable-shift): + (org-clocktable-steps): Fix regexp to allow for indented clock tables + +2010-12-11 Puneeth Chaganti <punchagan@gmail.com> + + * org-exp.el (org-export-handle-include-files): Support :minlevel + property. + (org-get-file-contents): New argument minlevel to demote included + content. + +2010-12-11 Noorul Islam <noorul@noorul.com> + + * org-latex.el (org-export-latex-hyperref-format): New option. + (org-export-latex-href-format): Rename the existing variable + `org-export-latex-hyperref-format' as `org-export-latex-href-format' + (org-export-latex-links): Use `org-export-latex-hyperref-format' and + `org-export-latex-href-format' + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el (org-babel-execute:calc): Ensure the *Calculator* + buffer exists before it is used. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-preprocess-string): delaying code block + processing a bit to allow correct list parsing in the export string + +2010-12-11 Christopher Allan Webber <cwebber@dustycloud.org> + + * org-agenda.el (org-agenda-timegrid-use-ampm): New option. + (org-agenda-time-of-day-to-ampm): New function. + (org-agenda-time-of-day-to-ampm-maybe): New function. + (org-format-agenda-item): Call org-agenda-time-of-day-to-ampm-maybe. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-faces.el (org-cycle-level-faces): New option. + + * org.el (org-get-level-face): Honor org-cycle-level-faces. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-today): New function. + (org-agenda-get-day-face): New function. + (org-timeline): Use org-agenda-today and org-agenda-get-day-face. + (org-agenda-list): Use org-agenda-today and org-agenda-get-day-face. + (org-todo-list): Use org-agenda-today. + (org-get-all-dates): Use org-agenda-today. + (org-agenda-day-face-function): New variable. + (org-agenda-get-day-face): Use org-agenda-day-face-function. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-ctrl-c-ctrl-c): Consider sending a radio table also + in Org. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-as-html): Do not treat partially + protected lines as if they were fully protected. + +2010-12-11 Dan Davison <dandavison7@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): + Remove hard-wired configuration of minted export + (org-export-latex-minted-with-line-numbers): Remove variable + +2010-12-11 Bastien Guerry <bzg@altern.org> + + * org-clock.el (org-dblock-write:clocktable): Fix double + reference to `link' in let construct. + (org-clock-clocktable-formatter): Fix typo in docstring. + (org-clocktable-write-default): Fix typo in docstring. + +2010-12-11 David Maus <dmaus@ictsoc.de> + + * org-protocol.el (org-protocol-unhex-string): Normalize percent + escape sequence to upper case letters. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-get-info): including pass-through + header arguments in results variable header argument string + +2010-12-11 David Maus <dmaus@ictsoc.de> + + * org-exp.el (org-export-visible): Limit search for in-buffer options + beginning of first headline. + +2010-12-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-open-at-point): Remove stale link handler for news: + links. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clocktable-write-default): Better handling of + narrowing. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-category-icon-alist): Fix defcustom type. + +2010-12-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): simplify code and remove bug that + would insert a tab at the beginning of the line when trying to + indent the item. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org.el (org-diary-sexp-entry): Split sexp result strings at semicolon. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-prefix-format): Insert place holder + for icon. + (org-agenda-category-icon-alist): New option. + (org-agenda-get-category-icon): New function. + (org-format-agenda-item): Support for icons. + (org-compile-prefix-format): Support for icons. + +2010-12-11 Julien Danjou <julien@danjou.info> + + * org-compat.el: Create defalias for `string-match-p' and + looking-at-p. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el (org-babel-execute:calc): support for variables -- + converts :var variables in calc variables + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-sparse-tree): Mention [r] in dispatch menu + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-list-parse-list): Use `org-looking-at-p'. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-id.el (org-id-store-link): Test for org-mode before checking + for IDs. + +2010-12-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-shorten-string): New function. + + * org-exp.el (org-export-convert-protected-spaces): New function. + (org-export-preprocess-string): + Call `org-export-convert-protected-spaces' to handle new hard spaces. + +2010-12-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-narrow-to-subtree): Check for heading that ends at end + of buffer. + +2010-11-12 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-templates): Remove autoload from + defcustom. + + * ob-lisp.el (slime): Don't expect slime to be present. + +2010-11-11 Dan Davison <dandavison7@gmail.com> + + * ob.el: `copy-sequence' suffices to copy alist; no need for + `copy-tree'. + +2010-11-11 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-execute-src-block): If ":results file" is in + effect, then ensure that the value of :file is returned as the + result; don't rely on language files for this. + +2010-11-11 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-sha1-hash): Avoid corrupting `info' data + structure by side-effects of `sort'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bottom-point-with-indent): Do not check + indentation of a non-empty blank line. + + * org-list.el (org-sort-list): Sort a list with point anywhere + inside it. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el (org-babel-execute:calc): Safer evaluation and + hopefully better error messages. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-babel-load-languages): Adding calc. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-initiate-session): Don't resolve variable + references unless prefix arg is supplied. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el (org-babel-execute:calc): Ensure that calc stack + refers to the correct stack. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el: Adding the beginnings of support for calc code + blocks. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-update-block-body): Declaring function + for updating code block bodies. + (org-babel-spec-to-string): + (org-babel-detangle): Detangle all tangled and commented code + blocks in the current file back to org. + (org-babel-tangle-jump-to-org): Jump from a tangled and commented + file back to the originating org-mode code block ob-tangle: + detangle changes in code files back to the original org files. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-comment-format-beg): Fix typo. + (org-babel-tangle-comment-format-end): Fix typo. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-exp.el (org-export-format-source-code-or-example): + Use minted for latex source code export if `org-export-latex-listings' + has the value 'minted + + * org-latex.el (org-export-latex-listings): Document special value + 'minted + + * org-latex.el (org-export-latex-minted): Delete variable. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-get-src-block-info): Retrieve contents of + parentheses, excluding parentheses themselves. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-gnuplot.el (org-babel-variable-assignments:gnuplot): + Fix bug in gnuplot data file assignment using user variables. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-latex.el (org-babel-execute:latex): Adding new :headers + header argument for latex code blocks. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-templates): New capture property + `:kill-buffer'. (org-capture-finalize): Kill target buffer if that + is desired. + (org-capture-target-buffer): Remember if we have to make the + buffer. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-dblock-write:clocktable): Fix bug when + computing clock tables. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-dblock-write:clocktable): Pass file minutes up + to caller even if no table is generated. + +2010-11-11 Łukasz Stelmach <lukasz.stelmach@iem.pw.edu.pl> + + * org-agenda.el (org-agenda-get-sexps): Handle lists as return + values from diary entries + + * org-bbdb.el (org-bbdb-anniversaries): Handle lists of + anniversaries + + * org.el (org-diary-sexp-entry): Handle lists as return values + from diary entries. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-empty-lines-before): + (org-capture-empty-lines-after): Make sure the n=0 does not insert + any newlines. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-clojure-babel-clojure-cmd): Fix error + message when clojure binary is not found. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-format-table-html): New argument DOCBOOK. + (org-format-org-table-html): New argument DOCBOOK. When set, use + align instead of class to align table fields. + + * org-docbook.el (org-export-as-docbook): Specify the docbook + argument for the table converter. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-called-interactively-p): New macro. + + * org-freemind.el: No longer require 'rx. + (org-freemind): New customization group, use it for all the + variables. + (org-export-as-freemind): Add docstring. + (org-freemind-show): Improve filen naming. + (org-freemind-convert-links-helper): New function. + (org-freemind-bol-helper-base-indent): New variable. + (org-freemind-bol-helper): New function. + (org-freemind-node-css-style): New option. + (org-freemind-node-pattern): New variable. + (org-freemind-from-org-mode): Better docstring. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * ob-haskell.el (org-babel-variable-assignments:haskell): + Don't pass more than two arguments to mapc. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * ob.el (org-babel-ref-resolve): Declare to silence byte compiler. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-footnote.el (message-signature-separator): Defvar to silence + byte compiler. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-exp.el (org-export-string): Fix reference to wrong symbol. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> + + * org.el (org-link-search): Return 'dedicated on successful match + when org-link-search-must-match-exact-headline is set to t. + +2010-11-11 Daniel Clemente <n142857@gmail.com> + + * org-html.el (org-html-make-link): Append fragment to file: links + if present. + +2010-11-11 Tassilo Horn <tassilo@member.fsf.org> + + * org-footnote.el (org-footnote-create-definition) + (org-footnote-goto-local-insertion-point): Add footnotes before + signature when in message-mode. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-display-inline-images): Improve regexp. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-cycle): Make sure resetting to startup visibility + works after another cycle command. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-string): New function org-export-string + can be used to convert a string of test in org-mode markup to a + specified format. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-display-inline-images): Allow non-ASCII characters + in image file names. Save match data. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-auto-repeat-maybe): Fix shifting multiple time + stamps. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-store-forced-table-alignment): + (org-export-remove-special-table-lines): Allow the "c" cookie for + table alignment. + + * org-html.el (org-export-table-header-tags): + (org-export-table-data-tags): Add another %s format for the + alignment. + (org-export-html-table-align-individual-fields): New option. + (org-format-org-table-html): Implement field-by-field alignment + and support centering. + (org-format-table-table-html): Make sure the new table tag formats + don't break this function. + + * org-table.el (org-table-cookie-line-p): + (org-table-align): Allow for the <c> cookie. + + * org.el (org-set-font-lock-defaults): Allow for the <c> cookie. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-exp.el (org-export-normalize-links): Skip normalization of + plain links that are part of another link. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-expand-body:R): Fix bug in let binding. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-indent.el (org-indent-add-properties): + Use `with-silent-modificatons'. + (org-indent-remove-properties): Use `with-silent-modificatons'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-cookie-line-p): Fix indentation. + + * org-exp.el (org-store-forced-table-alignment): New function. + (org-export-preprocess-string): + Call `org-store-forced-table-alignment'. + + * org-html.el (org-format-org-table-html): Use stored alignment + information. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Respects prefix argument + (which forces re-calculation). + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Remove needless param + sorting from ob-execute-src-block, the params are sorted already + by ob-sha1-hash. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-sha1-hash): Ensure that info is sorted at the + header argument level. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-sha1-hash): Consider words in different order + as different input. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-sha1-hash): Fix check for zero length sequences. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-sh-var-to-sh): Ensure value has the + structure of an Org-mode table (list of lists). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Fix bug + (reference to unassigned variable `src-lang' and avoid calling + org-babel-get-src-block-info twice. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Updated to reflect the new + info list contents. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Supply non-nil argument to + `org-babel-get-src-block-info' to avoid resolving variable + references. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-map-src-blocks): Fix minor bug in and + improved efficiency of org-babel-map-src-blocks. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Now explicitly + checks that a code block will actually be tangled before + collecting it's full information (a process which could involve + the execution of other code blocks). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-demarcate-block): Use light version of + `org-babel-get-src-block-info'. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-sha1-hash): Now handles more complex types in + params. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Generally using the new + more informative params + (org-babel-process-params): Don't forget the :var portion of + variable assignments. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-table.el (sbe): Simplified to reflect to var resolution. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-resolve): Bringing the referent + arguments back to their params before evaluation. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-resolve): Cleanup of variable usage and + indentation. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-table.el (sbe): Use `org-babel-process-params params' instead + of `org-babel-expand-variables'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-C.el (org-babel-C-execute): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-R.el (org-babel-execute:R): Remove call to + org-babel-process-params which should no longer be called from + within a language file + (org-babel-R-variable-assignments): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-asymptote.el (org-babel-execute:asymptote): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-clojure.el (org-babel-execute:clojure): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-dot.el (org-babel-execute:dot): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-emacs-lisp.el (org-babel-expand-body:emacs-lisp): Remove + call to org-babel-process-params which should no longer be called + from within a language file + (org-babel-execute:emacs-lisp): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-haskell.el (org-babel-execute:haskell): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-js.el (org-babel-execute:js): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-lisp.el (org-babel-execute:lisp): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-ocaml.el (org-babel-execute:ocaml): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-octave.el (org-babel-execute:octave): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-perl.el (org-babel-execute:perl): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-python.el (org-babel-execute:python): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-ruby.el (org-babel-execute:ruby): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-scheme.el (org-babel-execute:scheme): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-screen.el (org-babel-execute:screen): Remove call to + org-babel-process-params which should no longer be called from + within a language file + (org-babel-prep-session:screen): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-sh.el (org-babel-execute:sh): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-sql.el (org-babel-execute:sql): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-haskell.el (org-babel-execute:haskell): Remove reference to + processed params + + * ob-clojure.el (org-babel-execute:clojure): Remove reference to + processed params + + * ob-R.el (org-babel-execute:R): Remove reference to processed + params. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sql.el (org-babel-execute:sql): Use generic expansion + function + (org-babel-expand-body:sql): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-execute:sh): Use generic expansion function + (org-babel-expand-body:sh): Delete function + (org-babel-prep-session:sh): Change name of called function + (org-babel-variable-assignments:sh): Change function name. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-screen.el (org-babel-execute:screen): Use generic expansion + function + (org-babel-expand-body:screen): Delete function + (org-babel-prep-session:screen): Remove references to processed + params. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sass.el (org-babel-execute:sass): Use generic expansion + function + (org-babel-expand-body:sass): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-ruby.el (org-babel-execute:ruby): Use generic expansion + function + (org-babel-prep-session:ruby): Use new variable assignment + function + (org-babel-variable-assignments:ruby): New function + (org-babel-expand-body:ruby): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-execute:python): Use generic expansion + function + (org-babel-prep-session:python): Change name of called function + (org-babel-variable-assignments:python): Change function name + (org-babel-expand-body:python): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-plantuml.el (org-babel-expand-body:plantuml): Delete function + (automatically handled by generic version). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-perl.el (org-babel-execute:perl): Use generic expansion + function + (org-babel-expand-body:perl): Delete function + (org-babel-variable-assignments:perl): New function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-org.el (org-babel-expand-body:org): Delete function + (automatically handled by generic version). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el (org-babel-execute:octave): Use generic expansion + function + (org-babel-variable-assignments:octave): Change name of function + (org-babel-variable-assignments:matlab): New defalias + (org-babel-prep-session:octave): Change name of function + (org-babel-expand-body:matlab): Delete function + (org-babel-expand-body:octave): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-ocaml.el (org-babel-execute:ocaml): Use generic expansion + function + (org-babel-variable-assignments:ocaml): New function + (org-babel-expand-body:ocaml): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-mscgen.el (org-babel-expand-body:mscgen): Delete function + (automatically handled by generic version). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-js.el (org-babel-execute:js): Use new variable assignment + function + (org-babel-expand-body:js): Delete function + (org-babel-prep-session:js): Use new variable assignment function + (org-babel-variable-assignments:js): New function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-haskell.el (org-babel-execute:haskell): Use generic expansion + function + (org-babel-expand-body:haskell): Delete function + (org-babel-prep-session:haskell): Use variable assignment function + (org-babel-variable-assignments:haskell): New function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-gnuplot.el (org-babel-expand-body:gnuplot): Use variable + assignment function + (org-babel-prep-session:gnuplot): Use variable assignment function + (org-babel-variable-assignments:gnuplot): New function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-ditaa.el (org-babel-expand-body:ditaa): Delete function + (automatically handled by generic version). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-css.el (org-babel-expand-body:css): Delete function + (automatically handled by generic version). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-asymptote.el (org-babel-execute:asymptote): Use generic + expansion function + (org-babel-expand-body:asymptote): Delete function + (org-babel-variable-assignments:asymptote): New function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-expand-body:R): Use new function + `org-babel-variable-assignments:R'; don't trim body. + (org-babel-execute:R): Respond to changes in + `org-babel-expand-body:R' + (org-babel-prep-session:R): Called function is now named + `org-babel-variable-assignments:R' + (org-babel-variable-assignments:R): Receives processed-params as + new optional argument. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-C.el (org-babel-C-expand): Don't trim body. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-scheme.el (org-babel-expand-body:scheme): Fix bug in + obtaining variable references. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Supply variable + assignment lines to generic expansion command. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-expand-src-block): Supply variable assignment + lines to generic expansion function + (org-babel-expand-body:generic): Prepend body with optional + variable assignment lines. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-results): Replaced old function call. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-execute): Now expanding variable + references before execution. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Only sort parameters if + it's required for caching. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-table.el (sbe): Reworking for better indentation and to + integrate the new variable resolution. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-resolve-reference): Now expanding + variables when resolving references. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-merge-params): Fix order or precedence for + variables. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el (org-babel-expand-body:c++): Remove obsoleted optional + third argument + (org-babel-expand-body:c++): Remove obsoleted optional third + argument + (org-babel-C-expand): Remove obsoleted optional third argument + + * ob-R.el: + (org-babel-expand-body:R): Remove obsoleted optional third + argument + (org-babel-execute:R): Remove obsoleted optional third argument + (org-babel-R-variable-assignments): Remove obsoleted optional + third argument + + * ob-asymptote.el: + (org-babel-expand-body:asymptote): Remove obsoleted optional + third argument + (org-babel-execute:asymptote): Remove obsoleted optional third + argument + + * ob-clojure.el: + (org-babel-expand-body:clojure): Remove obsoleted optional third + argument + (org-babel-execute:clojure): Remove obsoleted optional third + argument + + * ob-css.el: + (org-babel-expand-body:css): Remove obsoleted optional third + argument + + * ob-ditaa.el: + (org-babel-expand-body:ditaa): Remove obsoleted optional third + argument + + * ob-dot.el: + (org-babel-expand-body:dot): Remove obsoleted optional third + argument + (org-babel-execute:dot): Remove obsoleted optional third + argument + + * ob-emacs-lisp.el: + (org-babel-expand-body:emacs-lisp): Remove obsoleted optional + third argument + (org-babel-execute:emacs-lisp): Remove obsoleted optional third + argument + + * ob-gnuplot.el: + (org-babel-expand-body:gnuplot): Remove obsoleted optional third + argument + + * ob-haskell.el: + (org-babel-expand-body:haskell): Remove obsoleted optional third + argument + (org-babel-execute:haskell): Remove obsoleted optional third + argument + (org-babel-load-session:haskell): Remove obsoleted optional + third + (org-babel-prep-session:haskell): Remove obsoleted optional + third + + * ob-js.el: + (org-babel-expand-body:js): Remove obsoleted optional third + argument + (org-babel-execute:js): Remove obsoleted optional third argument + + * ob-latex.el: + (org-babel-expand-body:latex): Remove obsoleted optional third + argument + + * ob-lisp.el: + (org-babel-expand-body:lisp): Remove obsoleted optional third + argument + (org-babel-execute:lisp): Remove obsoleted optional third + argument + + * ob-mscgen.el: + (org-babel-expand-body:mscgen): Remove obsoleted optional third + argument + + * ob-ocaml.el: + (org-babel-expand-body:ocaml): Remove obsoleted optional third + argument + (org-babel-execute:ocaml): Remove obsoleted optional third + argument + + * ob-octave.el: + (org-babel-expand-body:matlab): Remove obsoleted optional third + argument + (org-babel-expand-body:octave): Remove obsoleted optional third + argument + (org-babel-execute:octave): Remove obsoleted optional third + argument + (org-babel-octave-variable-assignments): Remove obsoleted + optional third + + * ob-org.el: + (org-babel-expand-body:org): Remove obsoleted optional third + argument + + * ob-perl.el: + (org-babel-expand-body:perl): Remove obsoleted optional third + argument + (org-babel-execute:perl): Remove obsoleted optional third + argument + + * ob-plantuml.el: + (org-babel-expand-body:plantuml): Remove obsoleted optional + third argument + + * ob-python.el: + (org-babel-expand-body:python): Remove obsoleted optional third + argument + (org-babel-execute:python): Remove obsoleted optional third + argument + (org-babel-python-variable-assignments): Remove obsoleted + optional third + + * ob-ruby.el: + (org-babel-expand-body:ruby): Remove obsoleted optional third + argument + (org-babel-execute:ruby): Remove obsoleted optional third + argument + + * ob-sass.el: + (org-babel-expand-body:sass): Remove obsoleted optional third + argument + + * ob-scheme.el: + (org-babel-expand-body:scheme): Remove obsoleted optional third + argument + (org-babel-execute:scheme): Remove obsoleted optional third + argument + + * ob-screen.el: + (org-babel-expand-body:screen): Remove obsoleted optional third + argument + + * ob-sh.el: + (org-babel-expand-body:sh): Remove obsoleted optional third + argument + (org-babel-execute:sh): Remove obsoleted optional third argument + (org-babel-sh-variable-assignments): Remove obsoleted optional + third + + * ob-sql.el: + (org-babel-expand-body:sql): Remove obsoleted optional third + argument + + * ob-sqlite.el: + (org-babel-expand-body:sqlite): Remove obsoleted optional third + argument + (org-babel-execute:sqlite): Remove obsoleted optional third + argument + + * ob.el: + (org-babel-expand-body:generic): Remove obsoleted optional third + argument. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-prep-session:clojure): Purging all + calls to removed org-babel-ref-variables. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-ingest): Now returns the count of + ingested code blocks. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-in-export-file): Wrapper for collecting + information from within the original export file. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-get-src-block-info): Small but crucial fix) + (this should return nil if not match found. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-emacs-lisp.el (org-babel-expand-body:emacs-lisp): + Whitespace (org-babel-execute:emacs-lisp): Whitespace. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-sh-variable-assignments): Provide missing + docstring + + * ob-python.el (org-babel-python-variable-assignments): + Provide missing docstring. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el (org-babel-expand-body:octave): Refactor: break + variable assignment part out into a separate function + (org-babel-octave-variable-assignments): New function constructing + list of variable assignment statements + (org-babel-prep-session:octave): Use new function + `org-babel-octave-variable-assignments' instead of previous + (incorrect) variable assignment code. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-expand-body:sh): Refactor: break variable + assignment part out into a separate function + (org-babel-sh-variable-assignments): New function constructing + list of variable assignment statements + (org-babel-prep-session:sh): Use new function + `org-babel-sh-variable-assignments' instead of previous + (incorrect) variable assignment code. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-expand-body:python): Refactor: break + variable assignment part out into a separate function + (org-babel-python-variable-assignments): New function constructing + list of variable assignment statements + (org-babel-prep-session:python): Use new function + `org-babel-python-variable-assignments' instead of previous + (incorrect) variable assignment code. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-expand-body:R): Refactor: break variable + assignment part out into a separate function + (org-babel-R-variable-assignments): New function constructing list + of variable assignment statements + (org-babel-prep-session:R): Use new function + `org-babel-R-variable-assignments' instead of previous + (incorrect) variable assignment code. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-initiate-session): Better variable names. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-number-sequence): + Declared * ob-R.el (org-number-sequence): Declared. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-map-src-blocks): Store correct value of + `end-block'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-mark-block): New function to mark the body of a + src block in the style of `mark-defun'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-number-sequence): New function. + + * ob-R.el (org-babel-expand-body:R): Use `org-number-sequence'. + + * ob.el (org-babel-where-is-src-block-result): + Use `org-number-sequence'. + (org-babel-current-buffer-properties): Fix variable definition. + + * ob-ref.el (org-babel-ref-index-list): Use `org-number-sequence'. + + * ob-latex.el (org-babel-latex-tex-to-pdf): Use the 2-argument + version of `shell-command'. + + * org-latex.el (org-export-as-pdf): Use the 2-argument version of + `shell-command'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-list-search-unenclosed-generic): Replace call + to booleanp. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-agenda-jump-prefer-future): New option. + + * org-agenda.el (org-agenda-goto-date): + Use `org-agenda-jump-prefer-future'. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org-latex.el (org-export-latex-links) : Replaced hard coded + hyperref format with custom variable + `org-export-latex-hyperref-format'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-heading): Fix docstring. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) + + * org-capture.el (org-capture-place-entry): If the first line is + already a headline, just stay there. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sh.el (org-babel-sh-evaluate): No longer assumes that results + are non-nil. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-ascii.el (org-ascii-replace-entities): Match an optional {} + after an entity. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (orgtbl-to-html): Apply `org-html-expand' to the + table fields. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-heading): When on the headline of an inline + task, insert another inline tasks. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Only create + links for blocks that will actually tangle. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sh.el (org-babel-expand-body:sh): Don't insert extra newlines + in expanded shell bodies. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-expand-body:sh): Avoid inserting extra + newline characters. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-expand-body:sh): Align code. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-params-from-properties): Max line with at <=80 + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-listings-langs): Clojure is now + recognized as a lisp. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-params-from-properties): Use `org-babel-read' + to interpret property as header argument value. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-parse-header-arguments): Simplify reading of + header arg value. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-org-to-ascii): + (org-publish-org-to-latin1): + (org-publish-org-to-utf8): New functions. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-heading): Skip inline tasks when trying to + insert a new heading after the end of the subtree. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-inlinetask.el (org-inlinetask-min-level): Set customization + type to integer or nil. + + * org.el (org-insert-heading): When after an inline task, do not + use level but go back to headline level before the inline task. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-inlinetask.el (org-inlinetask-in-task-p): New function. + + * org.el (org-indent-line-function): Fix indentation of inline + tasks. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-activate-links): Fix customize type. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-latex-to-pdf-process): Add rubber as another + default option. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-latex.el (org-export-latex-minted): Document pygments + dependency. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-create-index-file): Encrypt the index + file if encryption has been turned on. + (org-mobile-copy-agenda-files): Avoid double encryption of + `mobileorg.org'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-exp.el (org-export-latex-minted-with-line-numbers): + Ensure that variable is declared. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-src-preserve-indentation): Fix compiler + warning. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-exp.el (org-export-format-source-code-or-example): + Latex formatting of source code blocks using the minted package + (org-export-plist-vars): Add :latex-minted property + (org-export-latex-minted): Ensure variable is defined + (org-export-latex-minted-langs): Ensure variable is defined. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-src.el (org-edit-src-code): Use `org-region-active-p'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-tangle.el (org-babel-spec-to-string): Whitespace changes. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-tangle.el (org-babel-spec-to-string): Don't trim whitespace + when `org-src-preserve-indentation' is non-nil. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-lob.el (org-babel-lob-ingest): Provide message stating number + of blocks added to Library of Babel. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-lob.el (org-babel-lob-ingest): Check for nil source block + name. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-place-default-actions-for-lists): + Fix typo in regexp. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-toggle-checkbox): Avoid some boundary error + when inserting a checkbox in an empty last item of a list. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (org-gnus-nnimap-query-article-no-from-file): + Query article number from file is nil by default. + +2010-11-11 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk> + + * org-beamer.el (org-beamer-amend-header): Fix typo in docstring. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-place-entry): Move to `beg' before + searching for `%?'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-format-latex): Fix mathjax treatment of single + letters in between dollars. + +2010-11-11 Sébastien Vauban <wxhgmqzgwmuf@spammotel.com> + + * org-latex.el (org-latex-to-pdf-process): Add a third pdflatex + run. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-blank-before-new-entry): Improve docstring. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-force-id-on-agenda-items): + Fix docstring. + (org-mobile-write-agenda-for-mobile): Use outline path if we do + not have an ID and are not allowed to make one. + (org-mobile-get-outline-path-link): New function. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-copy-agenda-files): Encrypt the empty + file. + (org-mobile-write-agenda-for-mobile): Use the right name, even if + the file get encrypted. + (org-mobile-move-capture): Only delete tempfile if it does exist. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-number-p): Fix documentation string. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Accepting + "tangle" as a positive argument for the :noweb header argument + during tangling. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-src-blocks): Fix export when headings + have links, with tests. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-latex-to-pdf-process): Use texi2dvi if + available. + (org-export-latex-get-error): New function. + (org-export-as-pdf): Give an indication of the errors that + happened during processing. + +2010-11-11 Łukasz Stelmach <lukasz.stelmach@iem.pw.edu.pl> + + * org-exp.el (org-export-language-setup): Fix Polish entries. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-tags): Allow comma as a separator when + specifying tags at the completion interface. + (org-tags-completion-function): Allow comma as a separator when + specifying tags at the completion interface. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-src-blocks): Don't jump back to + export-file if exporting from a buffer which is not visiting a + file. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-src-blocks): Only append "::" to a file + name in link construction if there is a heading to follow it. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-html-inline-image-extensions): Add "svg" + as an allowed extension. + +2010-11-11 Sébastien Vauban <wxhgmqzgwmuf@spammotel.com> + + * org-agenda.el (org-agenda-add-time-grid-maybe): Pad clock times + with zeros. Start applying face earlier. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (or): Don't create org-babel-temporary-directory in batch + as it won't be removed by emacs-kill-hook + (org-babel-remove-temporary-directory): Only try to remove this + directory if it exists. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-temporary-directory): Fixing byte-compilation + warning in ob.el. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle): Now sharing the file name in + the tangling message. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-load-languages): Fixes compiler warning. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): Fixes bug with svg + output. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-ascii.el (org-export-as-ascii): Use the correct match group. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (boundp): Uncommenting defvar form for + org-babel-temporary-directory + (org-babel-temp-file): Now using the org-babel-temporary-directory + for holding new babel temporary files + (org-babel-remove-temporary-directory): Removes the babel temp dir + when Emacs shutsdown + (kill-emacs-hook): Now removing the babel temp dir on Emacs + shutdown. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-fill-template): Initialize history + variable. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Don't move point when generating + edit buffer. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Deal with point being in + #+end_src line. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-current-column): Add interactive to turn + this into a command. + +2010-11-11 Bernt Hansen <bernt@norang.ca> + + * org.el (org-insert-heading): Run org-insert-heading-hook when + creating the first heading in a file. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-startup-with-inline-images): New option. + (org-startup-options): Add new keywords inlineimages and + noinlineimages. + (org-mode): Inline images when this has been configured. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-get-src-block-info): Remove optional + HEADER-VARS-ONLY argument; further simplification. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-confirm-evaluate): Fix bug causing extra + prompt in ob-confirm-evaluate in some cases. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Visible region and completion + during language selection. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-get-src-block-info): Remove comment. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-get-src-block-info): Simplify function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-get-src-block-info): Form info list correctly + when parenthesised arguments are missing. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-exp.el (org-export-babel-evaluate): Docstring typo + (org-babel-exp-code): Docstring typo. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-encryption-password): + Improve docstring. + (org-mobile-encryption-password-session): New variable. + (org-mobile-encryption-password): New function. + (org-mobile-check-setup): + (org-mobile-encrypt-file): + (org-mobile-decrypt-file): Use the new function. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-capture.el (org-capture-place-template): Widen to remove + possible restrictions in target buffer. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> + + * org.el (org-speed-command-hook): Add org-speed-command-hook + (org-babel-speed-command-hook): Hook for Babel's speed commands. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-execute-buffer): Re-implement using + `org-babel-map-src-blocks'. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-capture.el (org-capture-templates): Update doc string with + new message date related escapes. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-store-link-message): Define properties %:date) + (%:date-timestamp, and %:date-timestamp-inactive. + + * org-mew.el (org-mew-store-link): Dto. + + * org-mhe.el (org-mhe-store-link): Dto. + + * org-rmail.el (org-rmail-store-link): Dto. + + * org-vm.el (org-vm-store-link): Dto. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-message-field): Always get literal content of + header fields. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (org-gnus-store-link): Define properties + %:date-timestamp and %:date-timestamp-inactive. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (org-gnus-store-link): Handle empty date header + field. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change) + + * org.el (org-speed-command-hook): New. Hook for installing + additional speed commands. Use this for enabling speed commands on + src blocks. + (org-speed-command-default-hook): The default hook for + org-speed-command-hook. Factored out from org-self-insert-command + and mimics existing behaviour. + (org-self-insert-command): Modified to use org-speed-command-hook. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-search-view): Recover spaces in search words + if they were escaped with \ or inside a regexp. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-additional-option-like-keywords): Add PROPERTIES to + the list of completable meta line words. + (org-complete): Complete property names after #+PROPERTY. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-python-evaluate-session): Make temp file + names consistent. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-clojure.el (org-babel-clojure-evaluate-external-process): + Delete extra format argument. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-org.el (org-babel-org-export): Typo in docstring. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-sh-evaluate): Remove unused temporary file + variable. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-scheme.el (org-babel-execute:scheme): Alter temp file name. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-process-file-name): New function + (org-babel-maybe-remote-file): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-C.el (org-babel-C-execute): Remove unused variable. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-make-link-string): Prevent superfluous colon. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-make-org-heading-search-string): Leave headline + intact. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-make-link-string): Don't escape characters in link + type. + +2010-11-11 Bastien Guerry <bzg@altern.org> + + * org-capture.el (org-capture-templates): Update docstring to + advertize %:org-date. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-dot.el (org-babel-execute:dot): Automatically specifies + "-T<ext>" based on file name extension. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-org.el (org-babel-org-export): Raise error on nested export + call. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): Support for svg + output files. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Better initialization of + stars. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-src-tab-acts-natively): Add customize interface. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-src-strip-leading-and-trailing-blank-lines): + New variable allowing prevention of automatic stripping of leading and + trailing blank lines when exiting edit buffer. + (org-edit-src-exit): Respect value of + `org-src-strip-leading-and-trailing-blank-lines' + (org-src-native-tab-command-maybe): + Bind `org-src-strip-leading-and-trailing-blank-lines' to nil during + this function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): If mark was inside code block + then code edit buffer inherits mark with active region. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Fix compiler warnings. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Better handling of empty + space around demarcated area. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-goto-date): Turn off prefer future for + this command. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (org-gnus-open-nntp): New function. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-open-nntp): New function. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-open): Open message by numeric reference if + article part is not a message id. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-filter-apply): Move cursor to a + visible line. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Interactive demarcation of + code blocks + + * ob-keys.el (org-babel-key-bindings): Key bindings for block + demarcation. + +2010-11-11 Bastien Guerry <bzg@altern.org> + + * org.el (org-link-types): Add the "message" link type. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-types): Add 'message:' link type to default + link types. + +2010-11-11 Bastien Guerry <bzg@altern.org> + + * org-gnus.el (org-gnus-store-link): Add the :date property to + gnus links, allowing the use of %:date in capture templates. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-list-bullet): Follow order of bullets + indicated in doc-string. + + * org-list.el (org-list-bottom-point-with-indent): List is ended + when a line is less indented that the last item, not the less + indented item. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-src-blocks): Now switching back to the + original file before resolving code block parameters to ensure + headline and buffer wide parameters are taken into consideration + when only a narrowed portion of the file is exported. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-forward-same-level): Fix docstring. + +2010-11-11 Sebastian Rose <sebastian_rose@gmx.de> + + * org-publish.el (org-publish-attachment): Put the attachment into + the right directory. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change) + + * org.el (org-goto-first-child): New command. + +2010-11-11 Matt Lundin <mdl@imapmail.org> + + * org-agenda.el (org-prepare-agenda): If the agenda is called from + within the agenda via an elisp link, such as + [[elisp:(org-agenda-list)]], org-prepare-agenda erases the buffer + of the file containing the link, since that buffer is current + during org-prepare agenda (due to a with-current-buffer in + org-agenda-open-link). An additional test now ensures that the + agenda buffer is in fact current when the buffer is erased and + local variables for the agenda are set. + +2010-11-11 David Maus <dmaus@ictsoc.de> (tiny change) + + * org-exp.el (org-infile-export-plist): Define property macro. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-mhe.el (org-mhe-get-header): Remove possible folding white + space in message header field. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed): Fix typo in customization group :tag + property. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-tag-markup): New option. + (org-export-latex-keywords-maybe): + Use `org-export-latex-tag-markup'. + +2010-11-11 Rémi Vanicat <vanicat@debian.org> + + * org-icalendar.el (org-icalendar-use-UTC-date-time): New option. + (org-ical-ts-to-string): Use UTC time when requested. + +2010-11-11 Noorul Islam <noorul@noorul.com> (tiny change) + + * org-html.el (org-html-cvt-org-as-html): Do not convert protocol + from 'file' to 'http'. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-store-log-note): Fix wrong usage + of`org-adapt-indentation'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-skip-over-state-notes): Do not compute bottom point + at each item. + + * org-mouse.el (org-mouse-for-each-item): Use `org-apply-on-list' + instead of moving to each item. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-capture.el (org-capture-templates): Small fix in doc string. + +2010-11-11 aaa bbb <dominik@powerbook-g4-12-van-aaa-bbb.local> + + * org-archive.el (org-get-local-archive-location): + Use `org-carchive-location' as default. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el (org): No longer requires org + + * ob-ledger.el (org): No longer requires org. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-priority): Save match data before call to + `read-char-exclusive'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-to-generic): Descriptions labels can be + any suit of symbols, and will end at double colons. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): Indent past [@num] and + [@start:num], consistently with what is already done with + checkboxes. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-store-log-note): Indent new notes to the right + column. Also take `org-list-two-spaces-after-bullet-regexp' into + consideration when creating the note. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (nnimap-group-overview-filename): Declare function + to silence byte compiler. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (org-gnus-nnimap-query-article-no-from-file): + New customization variable. + (org-gnus-nnimap-cached-article-number): New function. + (org-gnus-follow-link): Try to fetch cached article number of + message-id. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-org.el (org-babel-org-default-header): Used to insert a dummy + first line into code blocks before export so that the first line + is not interpreted as a title + (org-babel-org-export): Use new dummy code block prefix. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): No longer throws error when + inserting an empty result. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el: autoload org-babel-tangle-lang-exts from ob-tangle. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-do-in-edit-buffer): + Use `org-babel-where-is-src-block-head' to test for source block at + point. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-keys.el (org-babel-key-bindings): Adding key-binding for + `org-babel-goto-src-block-head' + + * ob.el (org-babel-goto-src-block-head): Jump to the head of the + current code block. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-next-src-block): Now raising more informative + error when no further code blocks can be found + (org-babel-previous-src-block): Now raising more informative error + when no previous code blocks can be found. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el + (org-export-preprocess-after-include-files-hook): Now using this + hook instead of `org-export-preprocess-hook'. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-python-evaluate): Refactor as call to + either `org-babel-python-evaluate-external-process' or + `org-babel-python-evaluate-session'. + (org-babel-python-evaluate-external-process): New function to + handle evaluation in external process. + (org-babel-python-evaluate-session): New function to handle + evaluation in emacs inferior process. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-org.el (org-babel-execute:org): Evaluates body to latex ascii + or html respecting :results header arg + (org-babel-org-export): Exports a string of text to an output + format. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): Remove existing results when + nil results are returned. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-ascii.el (org-export-as-ascii): Bind and set link path for + link type specific markup function. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-clock.el (notifications-notify): Properly declare function + to silence byte compiler. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item): Check invisibility of point at a + meaningful location. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item-generic): Updating checkboxes + can modifiy bottom point of a list, so make it a marker before + calling `org-update-checkbox-count-maybe'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org.el (org-src-fontify-natively): Set to nil by default. + Supply cutomize interface. + +2010-11-11 Bastien Guerry <bzg@altern.org> + + * org-ascii.el (org-export-as-ascii): Fix bug in ASCII export: use + `org-bracket-link-analytic-regexp++' to match the link type. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Rename `lang' to + `language'. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-comment-format-beg): + Format string specifying the link-comment preceding a code block + (org-babel-tangle-comment-format-end): Format string specifying + the link-comment following a code block + (org-babel-tangle-collect-blocks): Storing more information in the + spec of a tangling code block + (org-babel-spec-to-string): Now makes use of customizable + link-comment formats. + +2010-11-11 Achim Gratz <Stromeko@stromeko.net> (tiny change) + + * org.el (org-delete-backward-char): Check for nil overwrite-mode + before inserting spaces. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-icalendar.el (org-print-icalendar-entries): Exclude tags + from summary of non-TODO ical entries. + (org-print-icalendar-entries): Use `org-complex-heading-regexp' to + exclude tags from summary of TODO ical entries. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-map-src-blocks): Now exposes much information + about the code block in the form of let-bound local variables. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-list.el (org-outline-regexp, org-ts-regexp) + (org-ts-regexp-both, org-in-regexps-block-p) + (org-level-increment, org-at-heading-p) + (outline-previous-heading, org-icompleting-read) + (org-time-string-to-seconds): Declare to fix compiler warning. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-toggle-checkbox): Ignore items in drawers when + used from an heading. Send an error when no item is in region. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-do-in-edit-buffer): Use unwind-protect to + ensure that edit buffer is exited. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-pad-newline): Can be used to + control the amount of extra newlines inserted into tangled code + (org-babel-tangle-collect-blocks): Now conditionally collects + information to be used for "org" style comments + (org-babel-spec-to-string): Now inserts "org" style comments, and + obeys the newline configuration variable when inserting whitespace. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-pre-tangle-hook): Defines new tangle + hook + (org-babel-tangle): Calls new tangle hook. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture): Compute the length of the correct + string when removing properties. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): Now expanding file + names before shell quoting. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-src-tab-indents-natively): New variable + controlling whether language-native TAB action should be performed + (org-src-native-tab-command-maybe): New function to perform + language-native TAB action. + (org-tab-first-hook): Add `org-src-native-tab-command-maybe'. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): Explicitly check + `org-plantuml-jar-path' before use. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-src-font-lock-fontify-block): Re-use hidden + language major mode buffers during fontification. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org.el (org-fontify-meta-lines-and-blocks): Alter main regexp to + match code blocks with switches and header args. Call + `org-src-font-lock-fontify-block' for automatic fontification of + code in code blocks, controlled by variable + `org-src-fontify-natively'. + (org-src-fontify-natively): New variable. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ruby.el (org-babel-expand-body:ruby): Remove requirement of + inf-ruby. + +2010-11-11 Noorul Islam <noorul@noorul.com> (tiny change) + + * org-html.el (org-html-make-link): (Expand-file-name ) removes + one "/" from "///path-to-file", so add one. Anything other than + 'file' type should be exported along with the type. + +2010-11-11 Noorul Islam <noorul@noorul.com> (tiny change) + + * org.el (org-insert-subheading) : Fix compiler warning + (org-insert-todo-subheading) : Fix compiler warning. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture): Remove read-only text properties + from capture text. + (org-capture-set-target-location): Throw an error if file+headline + target does not point into a file which is in Org mode. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-map-src-blocks): Prefer `when' to `if'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Improve docstring. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-execute-src-block): Document prefix argument in + docstring. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ditaa.el (org-babel-execute:ditaa): Now expanding + org-ditaa-jar-path with expand-file-name. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-execute-subtree): Pass prefix arg through to + `org-babel-execute-src-block'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-ascii.el (org-export-ascii-preprocess): Allow [@start:x] and + [@x] syntax for list numbering. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): Indentation of source block + is left to `org-edit-src-exit' and shouldn't be modified by + `org-indent-line-function'. Indentation of others blocks should be + the same as the #+begin line. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-map-src-blocks): If FILE is nil evaluate BODY + forms on source blocks in current buffer; restore point in current + buffer. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct): Accept list boundaries as an + argument in order to avoid computing `org-list-top-point' and + `org-list-bottom-point' twice when indenting. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-ending-method): Default value is now + `both', to ensure maximum compatibility before previous + implementation. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-in-item-p-with-indent): Test if first line + is the item beginning. + + * org-list.el (org-list-top-point-with-indent): Test if first line + is a valid list beginning. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-ending-method): New customizable variable + to tell Org Mode how lists end. See docstring. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Shifting step of top-level + item depends on `org-level-increment'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): Indent first non blank line + after a list according to current heading level. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-docbook.el (org-export-as-docbook): Remove check for + indentation on lines that do not start with a list bullet. + + * org-html.el (org-export-as-html): Same thing. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bottom-point): Take into consideration + that bound of search can be before true ending of the list. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct-apply-struct): No longer shift + item's body twice: one after replacing bullet and one after + changing indentation. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct-indent): Add code to replace + bullets if needed when indenting. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item-generic): A single item + already counting blank lines in his body should be separated with + the next one by a blank line. Moreover, if user already provided + blank lines, follow his wishes. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): When moving top item of a + *-list to column 0, only the first item had its bullet changed to + -. It now changes all items of the top-level list, as expected. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-toggle-checkbox): Go to beginning of line + before processing. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct-apply-struct): Check if ancestor + exists. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-renumber-ordered-list): Check for [@start:x] is + done at each item. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el : Removed unused variable + `org-suppress-item-indentation'. + + * org-list.el (org-renumber-ordered-list): Skip item if bullet + number is already good. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-automatic-rules): Doc-string reflects this + change. + + * org-list.el (org-indent-item-tree): Prevent whole list from + being moved when user is not moving subtree. Thus) + (`org-cycle-item-indentation' will not allow to move the list. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Remove region code. It was + prone to errors and undocumented. + + * org-list.el (org-item-indent-positions): Better heuristics to + determine what bullet the item will have when demoted. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bullet-string): First check if + `org-list-two-spaces-after-bullet-regexp' isn't nil. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bullet-string): Do not modify match-data. + + * org.el (org-toggle-item): Now working again when changing list + items into plain text. Moreover take into consideration + `org-list-two-spaces-after-bullet-regexp'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Remove unnecessary bullets + fix, and improved heuristics to determine bullet when indenting. + + * org-list.el (org-item-indent-positions): Function now returns + sane results when there are two lists separated with blank lines + only. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-docbook.el (org-export-as-docbook): Use override="num" in + any listitem matching [@start:num] + + * org-html.el (org-export-as-html): Use value="num" in any li + matching + [@start:num] + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-set-font-lock-defaults): Correct fontification for + checkboxes found after [@start:?]. + + * org-list.el (org-list-at-regexp-after-bullet-p): Skip any + [@start:?] when looking at a regex after a bullet. + + * org-list.el (org-toggle-checkbox): Correct insertion of + checkboxes when there is already a [@start:?] in the item. + + * org-list.el (org-checkbox-blocked-p): Properly check if there's + an unchecked item before. + + * org-list.el (org-list-parse-list): Function handles items having + both a counter and a checkbox. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): Org-tab-ind-state + stores both indentation and bullet when cycle started. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el: `org-at-description-p' renamed to + `org-at-item-description-p', `org-first-list-item-p' renamed to + `org-list-first-item-p', `org-end-of-item-text-before-children' + renamed to `org-end-of-item-or-at-child'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-ctrl-c-ctrl-c): Call `org-fix-bullet-type' instead + of `org-maybe-renumber-ordered-list' and `org-fix-bullet-type' + before toggling a checkbox. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bullet-string): New function returning + bullet concatenated with an appropriate number of white spaces. + + * org-list.el (org-list-insert-item-generic): Insert the right + bullet, with help of `org-list-bullet-string'. + + * org-list.el (org-indent-item-tree): + Use `org-list-bullet-string'. + + * org-list.el (org-fix-bullet-type): Use `org-list-bullet-string'. + + * org-list.el (org-toggle-checkbox): Send an error when + `org-toggle-checkbox' is trying to insert a checkbox at a + description item. + + * org-list.el (org-item-re): Modified regexp so it can catch + correct number of white space before item body. + + * org-list.el (org-list-at-regexp-after-bullet-p): Take into + consideration new `org-item-re'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item-generic): The second item in a + list will be separated from its predecessor with the number of + blank lines separating the first item from its parent, if any, or + no blank line. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Fix and reorder every list + and sublist, from parent of list that has moved if indenting, or + from list at point if outdenting. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Try to keep relative + position on line. It can't if point is in white spaces before + bullet because mixed tabs and spaces make some columns + unattainable. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): Cycle when the whole + item only contains bullet and maybe a checkbox. Previously, TAB + would cycle when the first line of the item was blank. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): Allow a point just + after a description item or a checkboxed item to start cycling. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-list-bullet): + Check `org-plain-list-ordered-item-terminator' before allowing 1. or 1) + as valid bullets when cycling. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): Do return t if and + only if cycling is possible and succeded. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): When outdenting a subtree, + the last item shouldn't have a children. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): Cycling should play + nicely with indent rule in `org-list-automatic-rules'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): If indent rule is activated, + it should be impossible to outdent an item having children without + moving its subtree. Improved reordering of lists modified by + cycling indentation. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-maybe-renumber-ordered-list): Remove call for + `org-fix-bullet-type' to prevent infinite loop, and some checks + already done in `org-renumber-ordered-list'. + + * org-list.el (org-fix-bullet-type): Remove a check and call + directly `org-maybe-renumber-ordered-list'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): It shouldn't be possible to + indent the first item of a sublist (though outdent is possible) as + it would break list's structure. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item-generic): When local search + doesn't help, search the list globally for blank lines. Moreover, + don't bother with new lists, and add 1 blank line. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-capture.el (org-capture-place-item): + Use `org-search-forward-unenclosed' and + `org-search-backward-unenclosed' and new variable + `org-item-beginning-re'. + + * org-list.el (org-item-beginning-re): Regexp matching beginning + of an item. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-list-bullet): Put back support for + 'previous argument. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-in-item-p): Handle case when point is at an + heading. + + * org-list.el (org-list-make-subtree): Add protection when used + outside of list + + * org-list.el (org-insert-item): Remove useless hack now + `org-in-item-p' is fixed. + + * org-timer.el (org-timer-item): Remove useless hack now + `org-in-item-p' is fixed. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-list-bullet): Prevent description items + from being numbered. String argument is also recognized now, as + long as it is a valid bullet. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Moving indentation of top + list item will make the whole list move. + + * org-list.el (org-apply-on-list): Function is less sensitive to + changes of indentation. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-at-item-checkbox-p): Add whitespaces at the end + of the regexp. + + * org-list.el (org-checkbox-blocked-p): Use new checkbox regexp. + + * org-list.el (org-cycle-item-indentation): Allow cycling + description items and checkbox items. + + * org-list.el (org-toggle-checkbox): Use new checkbox regexp. + + * org-list.el (org-reset-checkbox-state-subtree): Use new checkbox + regexp. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item-internal): Guessing of blank lines + number is made by looking at neighbours items, if any. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-sort-list): Add the possibility to sort timer + lists with the ?t or ?T options. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-search-unenclosed-internal): New function to + handle both `org-search-forward-unenclosed' and + `org-search-backward-unenclosed'. + + * org-list.el (org-search-backward-unenclosed): Can send errors + now. Removed useless usage of COUNT. + + * org-list.el (org-search-forward-unenclosed): Can send errors + now. Removed useless usage of COUNT. + + * org-list.el (org-update-checkbox-count): + Use `org-search-forward-unenclosed' and + `org-search-backward-unenclosed' instead of `re-search-forward' + and `re-search-backward'. + + * org-list.el (org-sort-list): Use `org-search-forward-unenclosed' + and `org-search-backward-unenclosed' instead of + `re-search-forward' and `re-search-backward'. + + * org-list.el (org-list-make-subtree): + Use `org-search-forward-unenclosed' and + `org-search-backward-unenclosed' instead of `re-search-forward' + and `re-search-backward'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item-internal): Fixes the problem when + point was before the first char of the item's body. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-timer.el (org-timer-item): Refactoring. Compute timer string + before inserting it in the buffer + + * org-timer.el (org-timer): Add an optional argument to return + timer string instead of inserting it. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item-internal): New function to handle + positionning and contents of an item being inserted at a specific + pos. It is not possible anymore to split a term in a description + list or a checkbox when inserting a new item. + + * org-list.el (org-insert-item): Refactored by using the new + `org-insert-item-internal' function. + + * org-timer.el (org-timer-item): Refactored by using the new + `org-insert-item-internal' function. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bottom-point): Be sure to check real + ORG-OUTLINE-REGEXP and not outline-regexp, that might be modified. + + * org.el (org-cycle-internal-local): Cycle up to end of subtree or + end of item if we are in a list. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item): Move before any special block in + a list prior to add a new item. + + * org-timer.el (org-timer-item): When in a timer list, insert a + new timer item like `org-insert-item'. If in another list, send an + error. Otherwise, start a new timer list. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el: Minor refactoring. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-timer.el (org-timer-item): Insert description list item at + the right column. + + * org-list.el (org-insert-item): Insert the right number of blank + lines before a relative timer. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item): Remove restriction on latex + blocks. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-search-backward-unenclosed): Do not stop in + protected places. + + * org-list.el (org-search-forward-unenclosed): Do not stop in + protected places. + + * org-latex.el (org-export-latex-lists): Use the fact that + org-search-forward do not stop anymore at protected places. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-search-backward-unenclosed): Do not prevent + list items from being inside LaTeX blocks. + + * org-list.el (org-search-forward-unenclosed): Do not prevent list + items from being inside LaTeX blocks. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-in-item-p): Do not widen before checking if we + are in item. + + * org-list.el (org-list-send-list): We cannot count on + `org-list-top-point' and `org-list-bottom-point' before buffer is + narrowed. Find bounds of list otherwise. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-end-regexp): By default, list ending is + exactly 2 blank lines. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-docbook.el (org-export-as-docbook): When we find an empty + line, we do not need to check for + `org-empty-line-terminates-plain-lists' because we would have + found end-list marker before. + + * org-html.el (org-export-as-html): Same. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item): Simplify count of blank lines to + insert. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-end-regexp): New customizable variable to + define what string should end lists. + + * org-list.el (org-list-end-re): Function is now aware of + `org-list-end-regexp'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el (org-export-as-html): Code cleanup. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-docbook.el (org-export-as-docbook): Properly close any open + list when seeing ORG-LIST-END. Removed any reference to now + unneeded DIDCLOSE variable. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-mark-list-ending): Fix number of blank + lines inserted after a list. + + * org-list.el (org-list-parse-list): Fix case when + `org-list-end-re' would have an indentation greater than current + list. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-mark-list-ending): Differentiate between + export backends, and replace `org-list-end-re' by a blank line + upon exporting. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el (org-export-as-html): Delete didclose and everything + related to it, as it is no longer needed. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el (org-export-html-preprocess): Remove unneeded + insertion of list end marker, as it is now handled by + `org-export-mark-list-ending'. + + * org-html.el (org-export-as-html): Cleaner termination of lists. + + * org-exp.el (org-export-mark-list-ending): New function to insert + specific markers at the end of lists when exporting to a backend + not using `org-list-parse-list'. This function is called early in + `org-export-preprocess-string', while it is still able to + recognize lists. + + * org-latex.el (org-export-latex-lists): Better search for + lists. It now only finds items not enclosed and not protected. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el: Replaced `re-search-forward' by + `org-search-forward-unenclosed' where it made sense. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-apply-to-list): Now a return value is handed at + each new call of the function applied. + + * org-list.el (org-fix-bullet-type): Use the new + `org-apply-to-list' format. + + * org-list.el (org-renumber-ordered-list): Use the new + `org-apply-to-list' format. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-in-regexps-block-p): Minor fix: limit wasn't + correctly used. + + * org-list.el (org-search-forward-unenclosed): Better regexp used. + + * org-list.el (org-search-backward-unenclosed): Better regexp + used. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-sort-list): End-rec function was ill-defined. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-search-forward-unenclosed): Fix behavior when + last occurence was enclosed. + + * org-list.el (org-search-backward-unenclosed): Fix behavior when + last occurence was enclosed. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-in-regexps-block-p): Fix documentation. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-search-backward-unenclosed): Fix block regexp. + + * org-list.el (org-search-forward-unenclosed): Fix block regexp. + + * org-list.el (org-list-parse-list): Minor fix. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-parse-list): Delete `org-list-end-re' when + called with t argument. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el (org-export-html-preprocess): + Replace `org-list-end-re' by a blank line during pre-process. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bottom-point): No need for square brackets + for `skip-chars-backward'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el: Do not delete space between end of list and + beginning of the following. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el: preprocess buffer string and add ORG-LIST-END where + needed. Lists should not end before seeing this. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el: Notice end of lists. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-parse-list): Better handling of + restrictions when function is called on a list with sublists. + + * org-list.el (org-list-send-list): Find the true ending of the + list being sent. + + * org-list.el (org-list-radio-list-templates): Templates are more + specific to lists. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-js.el (org-babel-js-eoe): Indicate end of input + (org-babel-execute:js): Support for session evaluation + (org-babel-prep-session:js): Fleshed out definition + (org-babel-js-initiate-session): Can initiate a session using + mozrepl. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-set-regexps-and-options): Protect escape char in + `org-complex-heading-regexp-format'. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-scheme.el (org-babel-scheme-eoe): For marking the end of + session-based evaluation + (org-babel-execute:scheme): Now supports session-based evaluation + (org-babel-prep-session:scheme): Now works and defines variables + (org-babel-scheme-initiate-session): Now works using run-scheme + from cmuscheme. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-export-latex-default-packages-alist): Remove the + t1enc package - this is already covered by fontenc. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (with-parsed-tramp-file-name): Declared + (org-babel-tramp-localname): Ensure variable name exists locally. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-temp-file): Don't use babel temporary directory + in remote case; use make-temp-file with remote file name so that + temp file is guaranteed not to exist previously on remote machine. + (org-babel-tramp-localname): New function to return local name + portion of possibly remote file specification. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-R-write-object-command): New unified R + command for writing results to file + (org-babel-R-wrapper-method): Remove variable + (org-babel-R-wrapper-lastvar): Remove variable + (org-babel-R-evaluate-external-process): Use new R command + (org-babel-R-evaluate-session): Use new R command. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-comint.el + (org-babel-comint-eval-invisibly-and-wait-for-file): New function + to evaluate code invisibly and block until output file exists. + + * ob-R.el (org-babel-R-evaluate-session): Use `ess-eval-buffer' to + evaluate R code in session for :results value. Write result to + file invisibly using new function + `org-babel-comint-eval-invisibly-and-wait-for-file'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-fill-template): Align tags after + insertion. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-concatenate-multiline-emphasis): + Ignore matches that start in a headline. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): Wrapping in-file + and out-file in shell-quote-argument. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-docview.el (org-docview-store-link): Use expanded macro to + get current page. + (doc-view-goto-page, image-mode-window-get): Declare functions for + byte compiler. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-scheme.el: very preliminary support for evaluating scheme + code blocks + + * org.el (org-babel-load-languages): Adding scheme. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (require): Remove circular (require 'org). + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-R.el (ess-make-buffer-current): + Declared (ess-ask-for-ess-directory): + Declared (ess-local-process-name): + Declared * ob-latex.el (org-babel-latex-tex-to-pdf): Capturing free + variable + + * ob.el (org-edit-src-code): Fixing arguments + (org-edit-src-exit): + Declared (org-outline-overlay-data): + Declared (org-set-outline-overlay-data): Declared. + +2010-11-11 Glenn Morris <rgm@gnu.org> + + * ob.el: Require org when compiling. + (org-save-outline-visibility): Remove macro declaration. + + * ob-emacs-lisp.el: Require ob-comint when compiling, for macros. + Remove unnecessary/macro declarations. + + * org-docview.el: Require doc-view when compiling. + (doc-view-goto-page): Autoload rather than declaring. + (doc-view-current-page): Remove macro declaration. + + * ob.el (tramp-compat-make-temp-file, org-edit-src-code) + (org-entry-get, org-table-import): Fix declarations. + (org-match-string-no-properties): Remove declaration. + + * ob-sh.el (org-babel-comint-in-buffer) + (org-babel-comint-wait-for-output, org-babel-comint-buffer-livep) + (org-babel-comint-with-output): Remove unnecessary declarations. + + * ob-R.el (orgtbl-to-tsv): Fix declaration. + + * org-list.el (org-entry-get): Fix declaration. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-remove-temporary-directory): Remove explicit + second argument. + +2010-11-11 Magnus Henoch <magnus.henoch@gmail.com> (tiny change) + + * org-clock.el (org-clocktable-steps): Allow ts and te to be day + numbers. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-macs.el (org-save-outline-visibility): Move from org.el. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-org.el (org-babel-default-header-args:org): Additional + ":results silent" default header argument for org code blocks. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-do-export): Remove hacky ":noeval", + which is now an alias to ":eval no" + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-remove-temporary-directory): The version of + `delete-directory' found in files.el can not be assumed to be + present on all versions, so this copies the recursive behavior of + that command in such a way that all calls to delete-directory will + also work with the built-in internal C implementation of that + function. This is not overly difficult as all elements of the + directory can be assumed to be files. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el (org-babel-C-execute): Corrected arguments to + org-babel-temp-file. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-temporary-directory): Variable to hold the + value of the Babel temporary directory. + +2010-11-11 Aditya Siram <aditya.siram@gmail.com> + + * ob.el (org-babel-load-in-session): Expanding noweb references + when appropriate. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-make-link-regexps): Modified regexp of + org-plain-link-re. + +2010-11-11 Noorul Islam <noorul@noorul.com> (tiny change) + + * org-habit.el (org-habit-parse-todo): Find sr-days only if + scheduled-repeat is non nil. Use 4th element of the list returned + by (org-heading-components) as habit-entry. Modify the error + message to be more meaningful. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-latex.el (org-babel-execute:latex): Adding new ":fit" and + ":border" header arguments which both use the "preview" latex + package to fit the resulting pdf image to the figure. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-store-link): Don't try to store link if point + is at end of buffer. + +2010-11-11 Harri Kiiskinen <harkiisk@gmail.com> + + * org-publish.el (org-publish-project-alist): Document the new + body-only property. + (org-publish-org-to): Use the body-only property. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change) + + * org.el (org-store-link): Return link when invoked + non-interactively from an agenda buffer. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change) + + * org.el (org-store-link): Storing of links to headlines in + indirect buffers was broken. Fix it. + +2010-11-11 Aidan Kehoe <kehoea@parhasard.net> + + * ob-tangle.el (org-babel-tangle): Change the MODE argument to + #'set-file-modes to use integer, not character syntax, avoiding + compile problems with recent XEmacs. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-add-entry-text): Make sure we move + forward even if there is no text to be added. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-make-tags-matcher): Read "\\-" as "-" in the + tags/property matcher. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-infile-export-plist): Bind case-fold-search to + t. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-with-point-at-orig-entry): New macro. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-set-initial-vars): + Bind `case-fold-search' to t around the search for special LaTeX setup. + + * org-beamer.el (org-beamer-after-initial-vars): + Bind `case-fold-search' to t around the search for special BEAMER + setup. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-write-agenda): Delete postscript file after + creating conversion to pdf. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-write-agenda): Move require statements to + proper place in evaluated lisp expression. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-write-agenda): Rename temporary buffer to + remove dependency of `flet' macro. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-lob.el (org-babel-lob-get-info): Edit docstring. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-exp.el (org-babel-exp-lob-one-liners): Get parameter values + from all standard sources when executing #+lob/#+call lines. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-R-evaluate): Break the two branches into two + separate functions + (org-babel-R-evaluate-external-process): New function to handle + external process evaluation + (org-babel-R-evaluate-session): New function to handle session + evaluation. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-initiate-session): New function derived from + previous `org-babel-switch-to-session' + (org-babel-switch-to-session): Refactored to use new + `org-babel-initiate-session'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-switch-to-session): Supply missing "P" argument + to (interactive). + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-format-entry): Decode entry according to + its character encoding. + +2010-11-11 David Maus <dmaus@ictsoc.de> (tiny change) + + * org-feed.el (xml-substitute-special): Declare function for byte + compiler. + (org-feed-unescape): Removed. + (org-feed-parse-rss-entry, org-feed-parse-atom-entry): + Use `xml-substitute-special' to unescape XML entities. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-switch-to-session): Throw error if block if + :session not in effect for the block. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-create-with-table.el): Align table + before converting. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-do-in-edit-buffer): Suppress message and check + that org-src buffer is current before attempting exit. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (ob-comint): Require 'ob-comint + (org-src-babel-info): Define variable. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-do-in-edit-buffer): New macro to evaluate lisp + in the language major mode edit buffer. + (org-babel-do-key-sequence-in-edit-buffer): New function to call + an arbitrary key sequence in the language major mode edit buffer + + * org-src.el (org-src-switch-to-buffer): Add new allowed value + 'switch-invisibly for `org-src-window-setup'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (ob-keys): Require ob-keys, because `org-babel-map' + is used. + (org-src-do-at-code-block): New macro to evaluate lisp with point + at the start of the Org code block containing the code in this + edit buffer. + (org-src-do-key-sequence-at-code-block): New function to execute + command bound to key at the Org code block containing the code in + this edit buffer. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-R-associate-session): New function to + associate R code edit buffers with ESS comint session. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): If at src block, store babel + info as buffer local variable. + (org-src-associate-babel-session): New function to associate code + edit buffer with comint session. Does nothing unless a + language-specific function named + `org-babel-LANG-associate-session' exists. + (org-src-babel-configure-edit-buffer): New function to be called + in `org-src-mode-hook'. + (org-src-mode-hook): Add `org-src-babel-configure-edit-buffer' to + hook. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-switch-to-session-with-code): New function to + generate split frame displaying edit buffer and session. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-tags): Consider org-indent-mode when computing + the tags column. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-looking-at-p): Only use looking-at-p when + defined. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-finalize-agenda-entries): Delete excluded + lines directly after call to sorting filter function. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-complex-heading-regexp-format): Document the + variable. + (org-get-refile-targets): Use `org-complex-heading-regexp-format' + to make the regular expression for matching the headline. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-refile-check-position): New function. + (org-goto): + (org-refile-get-location): Call `org-refile-check-position'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-python-initiate-session-by-key): Use eq + instead of equal to compare symbols. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-before-sorting-filter-function): + New hook function. + (org-finalize-agenda-entries): + Apply `org-agenda-before-sorting-filter-function'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-first-lines): Do not protect meta + lines that have nothing to do with babel. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-place-template): Handle the + checkitem case. + (org-capture-place-item): Provide boundaries for the search to + make sure we do not get a match in a different tree. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-preprocess-apply-macros): Fix the macro + argument parser. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org-latex.el (org-latex-to-pdf-process): Add output-directory + option for the command pdflatex. + (org-export-as-pdf): Respect directory in path of + EXPORT_FILE_NAME. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-with-LaTeX-fragments): New default t, + which now means to use MathJax processing for HTML. Also allow + new value `dvipng' to force the old image processing. + (org-infile-export-plist): Parse for MATHJAX setup line. + + * org-html.el (org-export-html-mathjax-options): New option. + (org-export-html-mathjax-config): New function. + (org-export-html-mathjax-template): New option. + (org-export-html-preprocess): Call the LaTeX snippet processor + with an additional argument to declare special ways of processing. + (org-export-as-html): Bind the dynamical variable + `org-export-have-math'. Insert the MathJax script template when + it is needed by the document. + + * org.el (org-preview-latex-fragment): Call `org-format-latex' + with the additional processing argument. + (org-export-have-math): New variable, for dynamic scoping. + (org-format-latex): Implement specific ways of processing. + New function argument for processing type. + (org-org-menu): Remove the entry to configure LaTeX snippet + processing. + +2010-11-11 Bastien Guerry <bzg@altern.org> + + * org-agenda.el (org-agenda-clock-goto): Use `\C-c\C-x\C-j' for + `org-clock-goto' and `J' for `org-agenda-clock-goto'. If the + heading currently clocked in is not listed in the agenda, display + this entry in another buffer. If there is no running clock, + display a help message. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-tables): Return "" instead of nil + when no label is attached. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-menu-show-match): New option. + (org-agenda-menu-two-column): New option. + (org-agenda-get-restriction-and-command): Implement dispatch menu + without showing the matcher, and with two-column display. + +2010-11-11 Bernt Hansen <bernt@norang.ca> + + * org-indent.el (org-indent-mode): Fix grammar for message when + mode is refused. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): Ensures `beg' is set, even if + no previous result exists. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * ob.el Declare org-babel-lob-execute-maybe() to avoid compiler + warning. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org.el: org-set-visibility-according-to-property () Use backward + search instead of forward, so that top hierarchy gets priority. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-timeline): Allow indirect buffer. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-preprocess-after-radio-targets-hook): + (org-export-define-heading-targets-headline-hook): New hooks. + + * org.el (org-modules): Add entry for org-wikinodes.el. + (org-font-lock-set-keywords-hook): New hook. + (org-open-at-point-functions): New hook. + (org-find-exact-headling-in-buffer): + (org-find-exact-heading-in-directory): New functions. + (org-mode-flyspell-verify): Better cursor position for checking if + flyspell should ignore a word. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-indent.el (org-indent-remove-properties): + (org-indent-add-properties): Make sure changing these properties + does not trigger modification hooks. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-link-search-must-match-exact-headline): New option. + (org-link-search-inhibit-query): New variable. + (org-link-search): Search for exact headline match in Org files. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-execute-src-block-maybe): Remove check for + `org-babel-no-eval-on-ctrl-c-ctrl-c'; this is done in the new + function `org-babel-execute-safely-maybe'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-load-in-session): Set directory in case :dir + arg is in effect. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Don't throw + errors when we're not under of a headline. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el (org-babel-octave-wrapper-method): Use dlmwrite to + write delimited text instead of save -ascii + (org-babel-octave-import-elisp-from-file): Specify that data + written to file is tab-delimited. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-R-evaluate): Specify that tabular data is + tab-delimited. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-import-elisp-from-file): Allow separator to be + specified. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-python-table-or-string): Fix recognition + of lists and tuples. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el (org-babel-octave-evaluate-external-process): + Allow remote files. + +2010-11-11 Juan Pechiar <pechiar@computer.org> + + * ob-octave.el (org-babel-octave-evaluate-external-process): + Use `org-babel-octave-import-elisp-from-file' instead of + `org-babel-eval-read-file'. + (org-babel-octave-var-to-octave): Separate matrix rows with ';', + and use '%s' as format specifier instead of '%S'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el: Only (require 'matlab) when necessary. + (org-babel-octave-initiate-session) (require) octave-inf or matlab + as appropriate. + (org-babel-execute:matlab): Remove (require). + (org-babel-prep-session:matlab): Remove (require). + (org-babel-matlab-initiate-session): Remove (require). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el (org-babel-octave-evaluate): Fix formal argument + list. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-python-table-or-string): Can now handle + VERY long result lines. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-tables): Add label if any + + * org-latex.el (org-export-latex-convert-table.el-table): + Fix little mistake when inserting label. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-cycle-internal-local): Remove an unnecessary call + to `org-back-to-heading' that was preventing point to stay at its + column when cycling visibility. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org-capture.el (org-capture-finalize): Make messages consistent. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org-gnus.el: Suppress compiler warning by declaring outside + function nnimap-retrieve-headers-from-file. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org-colview.el Use org-beamer-select-environment instead of + org-beamer-set-environment-tag. + +2010-11-11 Matt Lundin <mdl@imapmail.org> + + * org.el (org-insert-time-stamp): Fix org-insert-time-stamp so + that the value of org-last-inserted-timestamp includes time range. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-store-link-message): Provide link property for + message-id without angle brackets. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-R.el (org-babel-R-evaluate): Improved prompt-stripping regexp. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-find-file-noselect-refresh): Finds a + file ensuing that the latest changes on disk are represented. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sqlite.el (org-babel-sqlite-expand-vars): Now inserts string + arguments w/o quotes. + +2010-11-11 Bernt Hansen <bernt@norang.ca> + + * org-capture.el (org-capture-finalize): Fix clock in of + interrupted task during capture finalize. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-R.el (org-babel-R-evaluate): Clean up extra prompts in + session output. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el (org-babel-C-ensure-main-wrap): More generous regular + expression for matching main function. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-one-liner-regexp): Fix error in lob + regexp -- it wasn't matching lob lines w/o indices. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-latex-listings-w-names): Fix compiler + warning in org-exp.el. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-file): Better error message if + base-directory or publishing-directory are not defined. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-colview.el (org-columns-display-here): Use overlays to + overrule line prefix properties during column view. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-filter-preset): Document the + limitation for the filter preset - it can only be used for an + entire agenda view, not in an individual block in a block agenda. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-table.el (sbe): Now able to accept range references from + tables. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-pick-name): If colnames or rownames contain a + list of names, then use those directly. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): + Escape underscores in code block names on latex listings export. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-with-temp-filebuffer): + Use find-file-noselect to avoid excess buffer movement. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-html-should-inline-p): Only inline images if + they should be. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-id.el (org-id-store-link): Autoload. + + * org.el ("org-id"): Autoload `org-id-store-link'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-html-should-inline-p): Only inline images if + they should be. + +2010-11-11 Eric S Fraga <e.fraga@ucl.ac.uk> + + * org-icalendar.el (org-icalendar-alarm-time): New option. + + * org-icalendar.el (org-print-icalendar-entries): Timed events are + exported with alarm events, a.k.a. reminders. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-target-buffer): Throw an error if we + have no target file. + (org-capture-select-template): Use a default template if the user + has not specified any. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-modules): Add entry for org-velocity. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-execute): Changing indentation to + improve line length. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-handle-table-metalines): Choose a better + position for checking protectedness. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-table.el (org-table-convert-region): Don't continue csv + importation which the point catches the end, this fixes an + infinite loop which was caused by the (point) never catching up + with the "end" marker. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-string-nw-p): New function. + + * org-capture.el (org-capture-import-remember-templates): + Interpret an empty string as request to use + `org-default-notes-file'. + (org-capture-target-buffer): If the FILE is not a (non-empty) + string, use `org-default-notes-file'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-templates): Fix customize type. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-colview-xemacs.el (org-columns-compile-map): + (org-columns-number-to-string): + (org-columns-string-to-number): Handle estimate ranges. + (org-estimate-mean-and-var): New function. + (org-estimate-combine): New function. + (org-estimate-print): New function. + (org-string-to-estimate): New function. + +2010-09-25 Juanma Barranquero <lekktu@gmail.com> + + * org.el (org-refile-targets): + * org-agenda.el (org-agenda-hide-tags-regexp): Fix typos in docstrings. + +2010-08-19 Glenn Morris <rgm@gnu.org> + + * org.el (org-outline-overlay-data, org-set-outline-overlay-data) + (org-save-outline-visibility): Move to org-macs. + * org-macs.el (org-outline-overlay-data, org-set-outline-overlay-data) + (org-save-outline-visibility): Move here from org.el. + (show-all): Autoload it. + * ob.el: Don't require org when compiling. + +2010-08-18 Glenn Morris <rgm@gnu.org> + + * ob.el: Require org when compiling. + (org-save-outline-visibility): Remove macro declaration. + * ob-emacs-lisp.el: Require ob-comint when compiling, for macros. + Remove unnecessary/macro declarations. + * org-docview.el: Require doc-view when compiling. + (doc-view-goto-page): Autoload rather than declaring. + (doc-view-current-page): Remove macro declaration. + +2010-08-17 Glenn Morris <rgm@gnu.org> + + * ob.el (tramp-compat-make-temp-file, org-edit-src-code) + (org-entry-get, org-table-import): Fix declarations. + (org-match-string-no-properties): Remove unnecessary declaration. + * ob-sh.el (org-babel-comint-in-buffer) + (org-babel-comint-wait-for-output, org-babel-comint-buffer-livep) + (org-babel-comint-with-output): Remove unnecessary declarations. + * ob-R.el (orgtbl-to-tsv): Fix declaration. + * org-list.el (org-entry-get): Fix declaration. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el: New file. + * ob-R.el: New file. + * ob-asymptote.el: New file. + * ob-clojure.el: New file. + * ob-comint.el: New file. + * ob-css.el: New file. + * ob-ditaa.el: New file. + * ob-dot.el: New file. + * ob-emacs-lisp.el: New file. + * ob-eval.el: New file. + * ob-exp.el: New file. + * ob-gnuplot.el: New file. + * ob-haskell.el: New file. + * ob-keys.el: New file. + * ob-latex.el: New file. + * ob-lob.el: New file. + * ob-matlab.el: New file. + * ob-mscgen.el: New file. + * ob-ocaml.el: New file. + * ob-octave.el: New file. + * ob-perl.el: New file. + * ob-python.el: New file. + * ob-ref.el: New file. + * ob-ruby.el: New file. + * ob-sass.el: New file. + * ob-screen.el: New file. + * ob-sh.el: New file. + * ob-sql.el: New file. + * ob-sqlite.el: New file. + * ob-table.el: New file. + * ob-tangle.el: New file. + * ob.el: New file. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mks.el: New file. + * org-capture.el: New file. + +2010-07-19 Christian Egli <christian.egli@sbszh.ch> + + * org-taskjuggler.el: New file. + +2010-07-19 Matt Lundin <mdl@imapmail.org> + + * org-agenda.el (org-search-view): Fix inclusion of agenda-archives + in org-agenda-text-search-extra-files. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-list.el (org-list-send-list): Locally bind variable `txt'. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-reload): Now also reloading babel files. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-plist): Make sure txt is a string + before calling `string-match'. + (org-capture-templates): Fix customization type. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Make a special case + for \nbsp. + (org-latex-entities): Remove the entry for \nbsp. + (org-latex-entities-exceptions): Variable removed. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-refile): Do not try to manipulate + bookmark list. + + * org.el (org-refile): Use the correct bookmark here. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-list-send-list): Parse list from its true beginning. + + * org.el (org-ctrl-c-ctrl-c): Maybe send the list when at a list item. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-link): Correctly determine if we should use + a relative path. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-radio-list-templates): Fix templates. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-send-list): Regexp defining the start of + a radio list is now on par with the one used for radio tables. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-entities.el (org-entities-help): Add a headline for + the user-defined entities. + +2010-07-19 Dirk-Jan C. Binnema <djcb.bulk@gmail.com> (tiny change) + + * org-agenda.el (org-agenda-action): Document capture key and add it + to the prompt. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-listings-langs): Add (sqlite "SQL"). + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-first-lines): Do not mark + meta lines for removal. Do not remove BABEL config lines during export. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-capture.el (org-capture): Check if + `org-capture-link-is-already-stored' is bound before evaluating. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el: Add autoload for org-babel-do-load-languages. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-src.el (org-src-lang-modes): Add sqlite to sql-mode. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el: Change indentation to match coding style + guideline. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-unescape, org-feed-parse-atom-feed): Load XML + library if necessary. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-amend-header): Standardize the + header cookie for the beamer extra stuff. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-amend-header): Put extra header + last in header. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-exp-blocks.el (org-export-blocks-format-ditaa) + (org-export-blocks-format-dot): Remove text properties of body before + calculating cache hash. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-tabular-environment): New option. + (org-export-latex-tables): Use `org-export-latex-tabular-environment'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-version-check): New function. + + * org-indent.el (org-indent-mode): Check for exact emacs version. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-templates): Allow the template + to come from a file or function call. + (org-capture-place-entry): Get the template from file or function. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-agenda-bulk-action): Don't create marker for + position if target is entire file. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-autoload): Autoload a few more org-table functions. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-babel-load-languages): Add ob-mscgen. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-tables): Format string now + matches options. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-babel-load-languages): This variable controls which + languages will be loaded by org-babel. It is customizable through + the customize interface. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-format-image): Update number of + arguments to allow for an optional short-name. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-indent.el (org-indent-mode): Refuse to turn on prior to Emacs 23.2. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-target-location): + Store exact positions for file+regexp and file+function targets. + (org-capture-place-entry, org-capture-place-item) + (org-capture-place-table-line, org-capture-place-plain-text): + Respect exact positions. + (org-capture-finalize): Make sure we are at the beginning of a line + when fixing the empty lines after the entry. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-entry-get-with-inheritance): New argument LITERAL-NIL. + (org-entry-get): Pass `literal-nil' into + `org-entry-get-with-inheritance'. + (org-todo): React to nil values of the LOGGING property. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-default-notes-file): Update docstring. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-link-frame-setup): Use `org-gnus-no-new-news' as default. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-attach-captions-and-attributes): + Add a shortname attribute to caption strings under the symbol name + org-caption-shortn. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-switchb): Rename from `org-iswitchb'. + Improve docstring. + (org-iswitchb): New alias. + (org-ido-switchb): Make alias point to `org-switchb'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-fill-template): + Respect time-of-day preference in template prompt. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-unescape): Remove superfluous lambda. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-disable-folder-check): New customization + variable. + (org-wl-open): Disable folder check depending on + `org-wl-disable-folder-check'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-target-location): + Fix file+function interpretation. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-parse-rss-entry): Unescape rss element + content. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (xml-entity-alist): Declare variable + `xml-entity-alist' for byte compiler. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-unescape): New function. + Unescape protected entities. + (org-feed-parse-atom-entry): Use function for atom:content + type text and html. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-parse-rss-feed): Ignore case of rss + element names. + +2010-07-19 Bernt Hansen <bernt@norang.ca> + + * org.el (org-time-string-to-absolute): Ignore cyclic repeater + when displaying items on todays agenda date. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-progress): Avoid reusing previous + value of EXTRA. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-initialize-cache): + Make timestamp directory, the entire path to it. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-handle-comments): Make sure to check + for protection in the comment line, and not in the line after it. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-html-preprocess): Call org-format-latex, + possibly with a protect-only argument. + + * org.el (org-format-latex): New argument PROTECT-ONLY. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-handle-table-metalines): This function + removes table specific meta-lines, now that we aren't wiping + everything that looks remotely like a comment at the end of the + export process we have to be sure to catch all of the specific lines + in org-exp.el. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-select-backend-specific-text): Properly + get rid of #+Backend and #+ATTR_Backend specifics to backends not + matching the one we're exporting to. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-table.el (orgtbl-to-generic): Add the :remove-newlines + option which will strip newline characters from the text of table + cells and replace then with "\n". + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-confirm-shell-link-function) + (org-confirm-elisp-link-function): Limit the values that can be set by + file variables. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-compute-latex-and-specials-regexp): Deal with + string elements by discarding them. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-iswitchb): Make sure to use at least iswitchb. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-position-for-last-stored) + (org-capture-bookmark-last-stored-position): New functions. + (org-capture-place-table-line): Better error catching. + (org-capture-place-item, org-capture-place-entry) + (org-capture-place-plain-text): + Call `org-capture-position-for-last-stored'. + (org-capture-finalize): Just call + `org-capture-bookmark-last-stored-position'. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-mark-blockquote-verse-center): + Fix small bug, now grabbing match data before overwritten by looking-at + this fixes a problem with remainders of #+end_quote lines appearing + in exported output. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-frame-setup): Add customization option for + Wanderlust. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-fixed-width): Now check + org-example rather than org-protected on verbatim export, because by + default all ": " prefixed lines are marked protected. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-fixed-width): Check for + protection before wrapping ": " lines as verbatim. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-handle-comments): Check for protection + before removing comments. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-entities.el (org-entities): Restructure the list. + (org-entities-help): Turn the help output into a buffer + in Org-mode, so that it becomes easier to find a symbol + in the structure. + (org-entities-create-table): Deal with new structure. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-write-agenda): Use backquotes to expand + `flet' at compile time. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-entry-properties): Make sure that standard property + names are used even if the user has customized time keywords. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-not-nil): Return the value if not interpreted + as nil. + + * org.el (org-entry-get) + (org-entry-get-with-inheritance): Interpret the value "nil" + as nil for properties. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-switch-to-buffer-other-window): Return the buffer. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-not-nil): New function. + + * org.el (org-block-todo-from-children-or-siblings-or-parent): + Use `org-not-nil' to interpret a property value of nil. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-truely-invisible-p): New function. + (org-beginning-of-line): Use `org-truely-invisible-p'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-timestamps): No errors + while getting TODO state. + (org-agenda-highlight-todo): No error when no keyword has + been matched. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-timestamp-change): New optional argument UPDOWN. + Use this to identify calls from org-timestamp-up/down, so that we can + skip by rounding minutes in this case. + (org-timestamp-up, org-timestamp-down, org-timestamp-up-day) + (org-timestamp-down-day): Call org-timestamp-change with the + updown argument. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-action): Make `c' key call org-capture. + + * org-capture.el: New file. + + * org-compat.el (org-get-x-clipboard): Function moved here from + remember.el. + + * org-mks.el: New file. + + * org.el (org-set-regexps-and-options): Allow statistic cookies as + part of complex headlines. + (org-find-olp): New argument THIS-BUFFER. When set, assume that the + OLP does not contain a file name. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-mode): Set `comment-start' instead of changing the + syntax of the `#' character. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Mark examples + by a property. + + * org-html.el (org-export-html-close-lists-maybe): Check if raw + HTML stuff was actually made from an example. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-latex.el: Items are no longer skipped when their first line + ends on a protected element. + + * org-list.el: Protected environments looking like lists are not + exported anymore. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-preprocess): + Cleanup trailing newline after block. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-exp.el: Comment regexp now matches documentation. No more + protection check when deleting comments before export. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-exp.el (org-export-preprocess-string): + Now using `org-export-handle-include-files-recurse' to resolve + included files. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-agenda.el (org-agenda-get-deadlines) + (org-agenda-get-scheduled): + * org.el (org-time-string-to-seconds): + For deadline and scheduled agenda display ignore the cyclic repeater + when calculating how many days late the task is. If you have a weekly + task and miss the date the agenda view will show more than a week late + now instead of resetting on the cyclic repeating date. This makes it + much more obvious when you missed a repeating task after the repeater. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-exp.el (org-export-mark-blockquote-verse-center): + Consider environments that end at eob. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org.el (org-raise-scripts): Do not fontify sub/superscripts of text + with face `org-special-keyword'. Make property keys as :LAST_REPEAT: + display correctly. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org.el (org-at-property-p): Use save-match-data macro instead of let. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org.el (test): Remove unused test function. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-preprocess): Fix typo. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-postblock-hook): + Add documentation to and turn into a defcustom. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-get-file-contents): By un-setting prefix1 to "" + instead of to nil we avoid errors when :prefix1 is defined, but + prefix is not. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Environments coming + from latex backend specific instructions (#+LaTeX) are already + protected and won't be treated as normal environments. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-set-timer): Fix typo in the docstring. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-set-timer): Use a prefix argument. + See the docstring of the function. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-set-timer): Fix bug about cancelling + timers. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-w3m.el (org-w3m-copy-for-org-mode) + (org-w3m-get-next-link-start, org-w3m-get-prev-link-start): + Get text property directly, not using macro `w3m-anchor'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-emph-re): Document the match groups. + +2010-07-19 Bernt Hansen <bernt@norang.ca> + + * org-clock.el (org-clock-in): Set `org-clock-clocking-in' to + t before calling `org-clock-out', so that that function can + know its call context. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-default-timer): New variable. + (org-timer-set-timer): Use the new variable. Also offer the + possibility to replace the current timer by a new one. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-kill-note-or-show-branches): Hide subtree before + exposing the headings. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-add-planning-info): Remove the empty line also + if there is no whitespace at all in there. + + * org-table.el (org-table-align): Fix alignment of strings + with invisible characters. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-refile-cache-get): Return empty list of targets + when cache was cleared. + (org-clone-subtree-with-time-shift): Maybe create ID property + in cloned subtrees. + (org-clone-delete-id): New customization variable. + (org-clone-subtree-with-time-shift): Use customization + variable `org-clone-delete-id'. + (org-clone-subtree-with-time-shift): Remove empty property + drawer in cloned subtrees. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-refile-use-cache): New option. + (org-refile-cache, org-refile-markers): New variable. + (org-refile-marker, org-refile-cache-clear) + (org-refile-cache-check-set, org-refile-cache-put) + (org-refile-cache-get): New function. + (org-get-refile-targets): Use the refile cache. + + * org-clock.el (org-clock-sum): Don't include running clock if + the time block is wrong. + +2010-07-19 John Wiegley <jwiegley@gmail.com> + + * org-clock.el (org-clock-clock-in, org-clock-in): + Add parameter `start-time'. + (org-clock-resolve-clock): Add parameter `clock-out-time'. + If set, and resolve-to is a past time, then the clock out + event occurs at `clock-out-time' rather than at `resolve-to'. + In this case, `resolve-to' becomes the clock in time. + (org-clock-jump-to-current-clock): Create new global command + to reveal the current clock. + (org-clock-resolve): Add new commands g/G and j/J, and a + help window describing all commands and their meaning. + (org-clock-resolve-expert): New customization variable. + (org-find-open-clocks): Fix a bug that caused discovered + clocks not to match up with the currently active clock. + (org-resolve-clocks): Change the argument + `also-non-dangling-p' to `only-dangling-p', since due to a bug + this was the default behavior all along. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-id.el (org-id-uuid): New function. Return string with + random (version 4) UUID. + (org-id-method): Make 'uuid the new default value. + (org-id-new): Use `org-id-uuid' if call to uuidgen program + does not return a UUID. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-format-image): Add support + for multicolumn figures in LaTeX. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-clone-subtree-with-time-shift): Remove ID + property of original subtree in cloned subtrees. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): + XEmacs compatibility. + + * org-latex.el (org-export-latex-tables): Accept comma in + align string. + + * org-docbook.el (org-export-docbook-xslt-stylesheet): New option. + (org-export-docbook-xslt-proc-command): Fix docstring. + (org-export-docbook-xsl-fo-proc-command): Fix docstring. + (org-export-as-docbook-pdf): + Improve formatting of the xslt command. + + * org-exp.el (org-infile-export-plist): Check for XSLT setting. + + * org.el (org-file-contents): Improve error message. + (org-set-regexps-and-options): Remove spaces at both ends. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-docbook.el (org-export-as-docbook-pdf): + Improve formatting of the xslt command. + +2010-07-19 Sebastian Rose <sebastian_rose@gmx.de> + + * org-publish.el (org-publish-cache): Use one big hashmap for + each project defined in `org-publish-project-alist'. + (initialize-files-alist): Function removed. + (org-publish-validate-link): Function removed. + (org-publish-get-base-files): Add variable `sitemap-requested' + to avoid sorting where possible. + (org-publish-get-files): Function removed. + (org-publish-get-project-from-filename): Make independent of + file list. + (org-publish-file): New argument NO-CACHE. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-beginning-of-defun, org-end-of-defun): + New functions. + (org-mode): Install the `org-beginning-of-defun' and + `org-end-of-defun' functions. + (org-pretty-entities): New option. + (org-toggle-pretty-entities): New command. + (org-fontify-entities): New function. + (org-startup-options): New keywords for pretty entities. + (org-set-font-lock-defaults): Call the pretty entities + function. + + * org-latex.el (org-export-latex-keywords-maybe): Protect the + TODO markup. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org-habit.el (org-habit-build-graph): Help-echo date when + mouse is over stars. + +2010-07-19 Jan Böker <jan.boecker@jboecker.de> + + * org.el (org-file-apps): Improve docstring to reflect + grouping matches. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-startup-visibility): Fix empty line display. + + * org-latex.el (org-export-latex-links): Use the formatting + function of the link type, if it is available. + + * org-table.el (org-table-get-remote-range): Return to + original buffer when retrieving remote reference. + + * org.el (org-display-inline-images): Do the entire buffer, + not just the narrowed region. Clear the cache. + (org-display-inline-images): Match mode file paths. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-store-link-folder): Don't throw error when + called on WL folder group. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-replace-escapes): Make sure the cdr is not nil. + (org-read-date): Make `M-v' and `C-v' scroll the popup calendar. + (org-mode): Revert comment syntax changes. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-sparse-tree): Make `C-c / t' search for all TODO + keywords, and `C-c / T' for a specific one. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-mode): Fix comment syntax settings. + + * org-src.el (org-edit-src-allow-write-back-p): + Define variable. + + * org.el (org-inline-image-overlays): New variable. + (org-toggle-inline-images, org-display-inline-images) + (org-remove-inline-images): New commands. + (org-mode-map): Define a key for `org-toggle-inline-images'. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-message-field): New function. + Return content of header field in message entity. + (org-wl-store-link): Call `org-wl-store-link-folder' or + `org-wl-store-link-message' depending on major-mode. + (org-wl-store-link-folder): New function. Store link to + Wanderlust folder. + (org-wl-store-link-message): New function. Store link to + Wanderlust message. + (org-wl-store-link-message): Store link to message while + visiting message. + (org-wl-open): Don't try to jump to message when opening a + folder link. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-replace-escapes): Avoid infinite loop when + replace string contains escape sequence it replaces. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-crypt.el (org-crypt-key-for-heading): Use symmetric + encryption when now key is set. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-recalculate-buffer-tables) + (org-table-iterate-buffer-tables): New commands. + + * org.el (org-check-for-hidden): When there is a region, skip + the check. + +2010-07-19 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): allow-write-back-p had + erroneously been omitted from let binding. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-sorting-choice): New sorting type alpha. + (org-cmp-alpha): New defsubst. + (org-em): New defsubst. + (org-entries-lessp): Only compute needed comparisons. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-format-org-table-html): Test all columns + for number content. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-treat-sub-super-char): + Make sure parenthesis matching is consistent. + + * org-table.el (org-table-colgroup-line-p) + (org-table-cookie-line-p): New functions. + + * org-exp.el (org-table-clean-before-export): Better tests for + colgroup and cookie lines. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-goto): Push a mark before changing + the position. + + * org-footnote.el (org-footnote): New group. + (org-footnote-section) + (org-footnote-tag-for-non-org-mode-files): Fix typos. + + * org-list.el (org-end-of-item-text-before-children): Also do + the right thing at the end of a file. + + * org.el (org-set-packages-alist, org-get-packages-alist): + New function. + (org-export-latex-default-packages-alist) + (org-export-latex-packages-alist): Add extra flag to + each package, indicating if it should be used for snippets. + (org-create-formula-image): Add the snippet argument. + (org-splice-latex-header): New argument SNIPPET-P, pass it + through to `org-latex-packages-to-string'. + (org-latex-packages-to-string): New argument SNIPPET-P. + + * org-latex.el (org-export-latex-make-header): Add the snippet + argument. + + * org-docbook.el (org-export-as-docbook): Implement ordered + lists starting at some offset. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-link-types, org-open-at-point): Add doi links. + + * org-ascii.el (org-export-ascii-preprocess): Remove list + startcounter cookies. + + * org-list.el (org-renumber-ordered-list): Respect counter + start values. + + * org-latex.el (org-export-latex-lists): Accept ordered list + item offset cookie. + + * org-html.el (org-export-as-html): Accept ordered list + item offset cookie. + + * org-indent.el (org-indent-mode): Turn off `indent-tabs-mode' + which messes up alignment of tags. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-cancel, org-clock-out): Make sure + the modeline display is removed. + + * org-exp.el (org-export-format-drawer-function): + Fix docstring. + + * org-agenda.el (org-agenda-refile): New optional argument + NO-UPDATE. + (org-agenda-refile): Call `org-agenda-redo' unless NO-UPDATE + is set. + (org-agenda-bulk-action): Call the refile command with updates + suppressed - but arrange for `org-agenda-redo' to be called at + the end. + + * org.el (org-mode): Make table mapping quiet. + (org-table-map-tables): New optional argument QUIETLY. + + * org-ascii.el (org-export-ascii-preprocess): Make table + mapping quiet. + + * org-html.el (org-export-as-html, org-html-level-start): + Change XHTML IDs to not use dots. + + * org-exp.el (org-export-define-heading-targets): + Change XHTML IDs to not use dots. + + * org-docbook.el (org-export-docbook-level-start): + Change XHTML IDs to not use dots. + + * org-latex.el (org-export-as-latex): Make sure that the + result buffer is in latex-mode. + + * org.el (org-shiftup-final-hook, org-shiftdown-final-hook) + (org-shiftleft-final-hook, org-shiftright-final-hook): + New hooks. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-justify-field-maybe): Make sure that + inserting a value does not turn a line into a hline. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-sum): New argument HEADLINE-FILTER. + (org-clock-sum): Add property to selected headlines. + (org-dblock-write:clocktable): Make tags matcher. + + * org.el (org-set-autofill-regexps): XEmacs compatibility. + + * org-latex.el (org-export-latex-set-initial-vars): Allow "-" + in latex class definitions. + + * org.el (org-shiftup-hook, org-shiftdown-hook) + (org-shiftleft-hook, org-shiftright-hook): New hooks. + + * org-entities.el (org-entities): Use \land and \lor for logical + operators. + + * org.el (org-shiftmetaleft, org-shiftmetaright): Call the subtree + indentation commands. + (org-hidden-tree-error): New defsubst. + (org-metaleft, org-metaright): Check for hidden stuff and throw an + error. + (org-check-for-hidden): New function. + + * org-list.el (org-item-re): New function. + (org-at-item-p): Use `org-item-re'. + (org-end-of-item-text-before-children): New function. + (org-outdent-item, org-indent-item): Arrange for leaving the + subtree alone. + (org-outdent-item-tree, org-indent-item-tree): New argument + NO-SUBTREE. + (org-indent-item-tree): Use `org-end-of-item-text-before-children' + to find the end for processing while ignoring the subtree. + + * org-publish.el (org-publish-sitemap-sort-alphabetically) + (org-publish-sitemap-sort-folders) + (org-publish-sitemap-sort-ignore-case): New options. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-compare-directory-files): Fix sorting. + + * org-compat.el (org-get-x-clipboard-compat): Use (featurep 'xemacs). + + * org-publish.el (org-publish-project-alist): Update docstring. + (org-publish-file-title-cache): New variable. + (org-publish-initialize-files-alist): + Initialize `org-publish-initialize-files-alist' to nil. + (org-publish-sort-directory-files): New function. + (org-publish-projects): Access the new properties. + (org-publish-find-title): Use the file title cache. + (org-publish-find-title): Build the file title cache. + (org-publish-get-base-files-1): Sort files. + (org-publish-aux-preprocess): Do not throw an error when before + the first headline. Allow an empty target, meaning to link just + to the file. + (org-publish-index-generate-theindex.inc): Check if there is + actually a target and only then add it to the link. + (org-publish-projects): Fix a remaining issue with the last commit. + + * org-html.el (org-export-as-html): Treat verse as open/close + paragraph. + (org-export-html-close-lists-maybe): Allow to splice raw HTML into + and out of lists. + +2010-07-19 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Allow the org-src edit buffer to + be used in a read-only mode. + (org-edit-src-code): Different message in read-only mode. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-src.el (org-edit-src-find-region-and-lang): Test for + table.el as late as possible. + + * org-colview-xemacs.el: Make sure this file is never loaded into + Emacs. Remove all tests for XEmacs. + + * org-colview.el: Make sure this file is never loaded into XEmacs. + + * org-agenda.el (org-highlight, org-unhighlight): Use direct + overlay calls. + + * org.el (org-key): Apply the translations defined in + `org-xemacs-key-equivalents'. + + * org-mouse.el (org-mode-hook): Use `org-defkey'. + + * org-compat.el (org-xemacs-key-equivalents): New constant. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-inlinetask.el (org-inlinetask-defaut-state): New option. + (org-inlinetask-insert-task): Use `org-inlinetask-defaut-state'. + Obey `org-odd-levels-only'. + + * org-compat.el (org-find-overlays): Use overlays-in/at. + + * org.el (org-remove-empty-overlays-at) + (org-outline-overlay-data, org-hide-block-toggle) + (org-format-latex, org-context): Use overlays-in/at. + + * org-src.el (org-edit-src-exit): Use overlays-in/at. + + * org-agenda.el (org-agenda-mark-clocking-task) + (org-agenda-fontify-priorities, org-agenda-dim-blocked-tasks) + (org-agenda-entry-text-hide) + (org-agenda-fix-tags-filter-overlays-at) + (org-agenda-bulk-remove-overlays): Use overlays-in/at. + + * org-compat.el (org-overlays-at): Function removed. + (org-overlays-in): Function removed. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-clock.el (org-clock-set-current): Just return the headline + itself, strip the TODO keyword, the priority cookie and the tags. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-xemacs-without-invisibility): New macro. + (org-xemacs-without-invisibility): New macro. + (org-indent-to-column, org-indent-line-to, org-move-to-column): + Redefine using the macro `org-xemacs-without-invisibility'. + + * org.el (org-mode, org-org-menu): Use `add-to-invisibility-spec'. + + * org-table.el (orgtbl-mode): Use `add-to-invisibility-spec'. + + * org-compat.el (org-make-overlay, org-delete-overlay) + (org-overlay-start, org-overlay-end, org-overlay-put) + (org-overlay-get, org-overlay-move, org-overlay-buffer): + Functions removed. + (org-add-to-invisibility-spec): Function removed. + + * org-html.el (org-export-as-html-and-open): Add argument to + kill-buffer. + + * org-habit.el (require): `calendar' is now required already by + org.el on top level. + + * org-clock.el (require): `calendar' is now required already by + org.el on top level. + + * org-agenda.el (require, org-timeline, org-agenda-list) + (org-todo-list, org-agenda-to-appt): `calendar' is now required + already by org.el on top level. + + * org.el (org-export-latex-fix-inputenc): Declare function. + + * org-agenda.el (org-agenda-goto-calendar): Do not bind obsolete + variables. + + * org.el (calendar): Require calendar now on top level in org.el + and define aliases to new variables when needed. + (org-read-date, org-goto-calendar): Do not bind obsolete + variables. + + * org-clock.el (org-clock-out, org-clock-cancel): Get rid of + compilation warning, add comment that this cannot be done with + `with-current-buffer'. + + * org-wl.el (org-wl-open): Use `with-current-buffer'. + + * org.el (overlay, org-remove-empty-overlays-at) + (org-outline-overlay-data, org-set-outline-overlay-data) + (org-show-block-all, org-hide-block-toggle) + (org-highlight-new-match, org-remove-occur-highlights) + (org-tags-overlay, org-fast-tag-selection, org-date-ovl) + (org-read-date, org-read-date-display, org-eval-in-calendar) + (org-format-latex, org-context) + (org-speedbar-restriction-lock-overlay) + (org-speedbar-set-agenda-restriction): Use the normal overlay API. + + * org-table.el (org-table-add-rectangle-overlay) + (org-table-remove-rectangle-highlight) + (org-table-overlay-coordinates) + (org-table-toggle-coordinate-overlays): Use the normal overlay + API. + + * org-src.el (org-edit-src-code, org-edit-fixed-width-region) + (org-edit-src-exit, org-src-mode-configure-edit-buffer): Use the + normal overlay API. + + * org-colview.el (org-columns-new-overlay) + (org-columns-display-here, org-columns-remove-overlays) + (org-columns-edit-value, org-columns-next-allowed-value) + (org-columns-update): Use the normal overlay API. + + * org-clock.el (org-clock-out, org-clock-cancel) + (org-clock-put-overlay, org-clock-remove-overlays): Use the normal + overlay API. + + * org-agenda.el (org-agenda-mark-filtered-text) + (org-agenda-mark-clocking-task, org-agenda-fontify-priorities) + (org-agenda-dim-blocked-tasks, org-agenda-entry-text-show-here) + (org-agenda-entry-text-hide) + (org-agenda-restriction-lock-overlay) + (org-agenda-set-restriction-lock) + (org-agenda-filter-by-tag-hide-line) + (org-agenda-fix-tags-filter-overlays-at) + (org-agenda-filter-by-tag-show-all, org-hl) + (org-agenda-goto-calendar, org-agenda-bulk-mark) + (org-agenda-bulk-remove-overlays): Use the normal overlay API. + + * org-freemind.el (org-freemind-from-org-mode-node) + (org-freemind-from-org-mode) + (org-freemind-from-org-sparse-tree, org-freemind-to-org-mode): + Use interactive-p instead of called-interactively, because this is + backward compatible with older Emacsen I still support.. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-define-heading-targets): Fix bug in + regexp finding ID and CUSTOM_ID properties. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-footnote.el (org-footnote-goto-previous-reference): + Rename from `org-footnote-goto-next-reference'. + + * org.el (org-auto-repeat-maybe): Only record LAST_REPEAT if + org-log-repeat is non-nil, or if there is clocking data in the + entry. + + * org-crypt.el (org-encrypt-entry): Improve mapping behavior. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-align-all-tags): New command. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-link-remove-filter): New customizable + variable. If non-nil, filter conditions are stripped when storing + link to message in filter folder. + (org-wl-shimbun-prefer-web-links): New customizable variable. + If non-nil, links to shimbun messages are created as web links to + message source. + (org-wl-nntp-prefer-web-links): New customizable variable. + If non-nil, links to nntp message are created as web links to gmane + or googlegroups. + (org-wl-namazu-default-index): New customizable variable. + Directory of namazu search index that should be used as default + when opening a link in a search folder. + (org-wl-folder-types): New constant. Wanderlust folder type + indicators. + (org-wl-folder-type): New function. Return type of Wanderlust + folder. + (org-wl-store-link): Create web links for shimbun or nntp messages + and strip filter conditions depending on customizable variables. + (org-wl-open): Open namazu search folder for message when called + with prefix. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-remove-if, org-remove-if-not): New functions. + (org-open-file): Use internal remove-if functions. + +2010-07-19 Jan Böcker <jan.boecker@jboecker.de> + + * org.el (org-file-apps-entry-match-against-dlink-p): New function. + (org-file-apps-ex): Remove variable. + (org-open-file): Integrate org-file-apps-ex functionality back + into org-file-apps, and decide whether to match a regexp against + the link or the filename using org-file-apps-entry-uses-grouping-p. + +2010-07-19 Jan Böcker <jan.boecker@jboecker.de> + + * org.el (org-file-apps-ex): New variable. + (org-open-file): Before considering org-file-apps, first match the + regexps from org-file-apps-ex against the whole link. + See docstring of org-file-apps-ex. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-export-latex-default-packages-alist): + Remove microtype package. + (org-todo-repeat-to-state): New variable. + (org-auto-repeat-maybe): Allow user-selected target states. + (org-default-properties): Add the new property REPEAT_TO_STATE. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-check-setup): Make sure that there is + a binary to compute checksums. + +2010-06-26 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-goto-calendar): Do not bind obsolete + variables. + + * org.el (calendar): Require calendar now on top level in org.el + and define aliases to new variables when needed. + (org-read-date, org-goto-calendar): Do not bind obsolete + variables. + +2010-06-22 Glenn Morris <rgm@gnu.org> + + * org-entities.el: Add explicit utf-8 coding cookie to file with + utf-8 characters. + +2010-05-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * org.el (org-file-complete-link): Avoid (expand-file-name "."). 2010-05-07 Chong Yidong <cyd@stupidchicken.com> * Version 23.2 released. +2010-05-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * org-table.el (orgtbl-setup): + * org-agenda.el (org-agenda-entry-text-mode): Simplify. + +2010-05-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * org-table.el (orgtbl-mode): Use define-minor-mode. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-link): Find the link buffer on visible frames. + (org-export-latex-default-packages-alist): Hyperref must be loaded + late. + (org-open-file): More care with the new matching for file links. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Do not yet protect + defined entities - these will be taken care of later. + (org-export-latex-special-chars): Post-process entity replacement. + (org-export-latex-fontify-headline): Do not yet protect defined + entities - these will be taken care of later. + (org-export-latex-tables, org-export-latex-links): Format the + caption properly. + + * org-entities.el (org-entities-user): Fix typo. + + * org.el (org-prepare-agenda-buffers): Uniquify TODO keywords. + + * org-entities.el (org-entities-user): Improve docstring. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-entities.el (org-macs): Require org-macs, to be sure that we + have `declare-function' defined. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-classes): Update docstring. + + * org.el (org-format-latex-header): Add cookies to the header. + (org-splice-latex-header): Implement placement according to cookies. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-aux-preprocess): Control case + sensitivity. + +2010-04-10 Bastien Guerry <bzg@altern.org> + + * org.el (org-splice-latex-header): Fix typo. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-make-header): + Use `org-splice-latex-header' to build the header. + (org-export-latex-classes): Update docstring. + + * org.el (org-splice-latex-header): New function. + (org-create-formula-image): Use `org-splice-latex-header' to build + the header. + + * org-gnus.el (org-gnus-follow-link): Handle nndoc backend. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-export-latex-packages-alist) + (org-export-latex-default-packages-alist): Fix docstring to + reflect the expected structure. + + * org-docbook.el (org-docbook-do-expand): Fix bug with variable names. + (org-export-docbook-finalize-table): Make use of label for tables. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-attach.el (org-attach-commit): Split on newlines. + + * org.el (org-export-latex-default-packages-alist): Use list + instead of cons for the entries. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-entities.el (org-entity-get-representation): Catch the case + that there is not entry in the list. + + * org-mobile.el (org-mobile-use-encryption) + (org-mobile-encryption-tempfile, org-mobile-encryption-password): + New options. + (org-mobile-check-setup): CHeck the encryption setup. + (org-mobile-copy-agenda-files, org-mobile-sumo-agenda-command) + (org-mobile-create-sumo-agenda): Use encryption code. + (org-mobile-encrypt-and-move): New function. + (org-mobile-encrypt-file, org-mobile-decrypt-file): + New functions. + (org-mobile-move-capture): Decrypt the capture file. + + * org.el (org-entities): Require the new file. + (org-export-latex-default-packages-alist): New variable. + (org-complete): Use new entity code for completion. + (org-create-formula-image): Use the new packages variable. + + * org-latex.el (org-export-latex-classes): Remove the standard + packages from the class headers. + (org-export-latex-make-header): Use the new package variable. + (org-export-latex-special-chars): Better regexp for entities, to + support entity name that contain numbers. + (org-export-latex-treat-backslash-char): Use the new entity code. + + * org-html.el (org-html-do-expand): Use the new entity code. + + * org-exp.el (org-export): Add the new export commands. + (org-html-entities): Constant removed. + (org-export-visible): Add the new export commands. + + * org-docbook.el (org-docbook-do-expand): Use new entity code. + + * org-ascii.el (org-export-ascii-entities): New variable. + (org-export-as-latin1, org-export-as-latin1-to-buffer) + (org-export-as-utf8, org-export-as-utf8-to-buffer): New commands. + (org-export-as-encoding): New function. + (org-export-ascii-preprocess): Call `org-ascii-replace-entities'. + (org-ascii-replace-entities): New function. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + Ulf Stegemann <ulf@zeitform.de> + + * org-entities.el: New file. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-html-level-start): Catch the case that target + might be nil. + +2010-04-10 Dan Davison <davison@stats.ox.ac.uk> + + * org.el (org-appearance): Change Customize group variable name + from org-font-lock to org-appearance, and change tag from "Org + Font Lock" to "Org Appearance". + (org-odd-levels-only): Change Customize group variable name. + (org-level-color-stars-only): Change Customize group variable name. + (org-hide-leading-stars): Change Customize group variable name. + (org-hidden-keywords): Change Customize group variable name. + (org-fontify-done-headline): Change Customize group variable name. + (org-fontify-emphasized-text): Change Customize group variable name. + (org-fontify-whole-heading-line): Change Customize group variable name. + (org-highlight-latex-fragments-and-specials): Change Customize + group variable name. + (org-hide-emphasis-markers): Change Customize group variable name. + (org-emphasis-alist): Change Customize group variable name. + (org-emphasis-regexp-components): Change Customize group variable + name. + (org-modules): Remove mention of org-R. + + * org-faces.el (org-faces): Change Customize group variable name. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-diary-last-run-time): New variable. + (org-diary): Prepare agenda buffers only if last call was some + time ago. + + * org-html.el (org-export-html-preprocess): Replace \ref macros + with a link. + (org-format-org-table-html): Add the label as an anchor. + + * org-docbook.el (org-export-docbook-format-image): Do some + formatting on captions. + + * org-latex.el (org-export-latex-tables, org-export-latex-links): + Do some formatting on captions. + + * org-html.el (org-export-html-format-image) + (org-format-org-table-html): Do some formatting on captions. + +2010-04-10 Dan Davison <davison@stats.ox.ac.uk> + + * org.el (org-hidden-keywords): New customizable variable. This is + a list of symbols specifying which of the special keywords #+DATE, + #+AUTHOR, #+EMAIL and #+TITLE should be hidden by font lock. + (org-fontify-meta-lines-and-blocks): Changes to font-lock code + implementing new faces and hiding behaviour. + + * org-faces.el (org-document-title): New face for #+TITLE lines. + (org-document-info): New face for #+DATE, #+AUTHOR, #+EMAIL lines. + (org-document-info-keyword): New face for #+DATE, #+AUTHOR, #+EMAIL + keywords. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-sanitize-plist): New function to + rename "index" properties to "sitemap". Do this renaming + globally. + (org-publish-with-aux-preprocess-maybe): New macro. + (org-publish-org-to-pdf, org-publish-org-to-html): Use the new + macro. + (org-publish-aux-preprocess) + (org-publish-index-generate-theindex.inc): New function. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-align): Interpret <N> at fixed width, + not as maximum width. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-author-info, org-export-email-info): + Fix docstrings. + + * org-beamer.el (org-beamer-select-environment): Rename from + `org-beamer-set-environment-tag'. Improve docstring. + + * org-freemind.el (org-freemind-write-mm-buffer): Fix another + problem with odd levels. + + * org-ascii.el (org-export-as-ascii): Export email only if the + author wants it. + + * org-docbook.el (org-export-as-docbook): Export email only if the + author wants it. + + * org-html.el (org-export-as-html): Export email only if the + author wants it. + + * org-exp.el (org-export-email-info): New option. + (org-export-plist-vars): Add entry for `org-export-email'. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-goto-line): Fix typo. + +2010-04-10 Mikael Fornius <mfo@abc.se> + + * org.el (org-agenda-files): Typo. + (org-read-agenda-file-list): Add optional argument to help + `org-store-new-agenda-file-list' to remember un-expanded file + names. Expand file names relative to `org-directory'. + (org-store-new-agenda-file-list): Keep un-expanded file names when + saving, if available. + (org-agenda-files): Update documentation. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-ascii.el (org-export-as-ascii): Catch the case of exporting + a buffer with no file name attached. + + * org.el (org-log-refile): New option. + (org-log-note-headings): Add a heading for refiling. + (org-startup-options): Add keywords for logging of the refile + action. + (org-refile): Add logging action. + (org-add-log-note): Allow for refiling action. + + * org-agenda.el (org-agenda-bulk-action): Make sure + `org-log-refile' is not `note' during a bulk action. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-map-dblocks): Use save-excursion to remember the + position. + + * org-attach.el (org-attach-commit): Remove dependence on xargs. + (org-attach-delete-one): Commit after deleting a file. + + * org-latex.el (org-export-latex-fontify): Do not mistake table.el + borders for strike-through emphasis. + + * org-freemind.el (org-freemind-write-mm-buffer): Simplify the + handling of odd levels. + + * org-agenda.el (org-agenda-todo-ignore-deadlines): Document `past' + and `future' values. + (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item): + Handle `past' and `future' values. + + * org.el (org-read-agenda-file-list): Interpret file names + relative to org-directory and allow environment variables and + "~". + + * org-latex.el (org-export-latex-special-chars): Allow a + parenthesis before an exponent or subscript. + +2010-04-10 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-exit): When returning from code edit + buffer, if code block is hidden, leave point at start of + #+begin_src line. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-heading): Do not remove all spaces if the + headline is empty. + + * org-indent.el (org-indent): Fix group name. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-goto-column): Fix forcing a non-existing + column. + (org-table-get, org-table-put, org-table-goto-line) + (org-table-current-line): New functions. + +2010-04-10 Jan Böcker <jan.boecker@jboecker.de> + + * org.el (org-open-file): Allow regular expressions in + org-file-apps to capture link parameters using groups. In a + command string to be executed, the parameters can be referenced + using %1, %2, etc. Lisp forms can access them using + (match-string n link). + (org-apps-regexp-alist): Adopt the created regexp, as this is now + matched against a file: link instead of the file name. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-crypt.el (org-reveal-start-hook): Add a decryption function + to this hook. + (org-decrypt-entries, org-encrypt-entries, org-decrypt-entry): + Add docstrings. + + * org.el (org-point-at-end-of-empty-headline) + (org-level-increment, org-get-previous-line-level): New function. + (org-cycle-level): Rewritten to be independent of when this + function is called. + (org-in-regexps-block-p): New function. + (org-reveal-start-hook): New hook. + (org-reveal): Run new hook. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-keywords): Start a new paragraph + after time keywords, do not add "\newline". + + * org-html.el (org-export-as-html): Avoid double # in href. + + * org.el (org-refile-get-location): Catch an invalid target + specification. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-add-entry-to-org-agenda-diary-file): + Make sure the behavior regarding to extracting time is + consistent. + +2010-04-10 Stephen Eglen <stephen@gnu.org> + + * org-agenda.el (org-agenda-insert-diary-extract-time): + New variable. + (org-agenda-add-entry-to-org-agenda-diary-file): Use this new + variable rather than `org-agenda-search-headline-for-time'. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-fix-bullet-type): Improve cursor positioning. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-adaptive-fill-regexp-backup): New variable. + (org-set-autofill-regexps): Store a backup of + `adaptive-fill-regexp'. + (org-adaptive-fill-function): Fix filling of comments and ordered + lists. If there is no other match, till try adaptive fill. + +2010-04-10 John Wiegley <jwiegley@gmail.com> + + * org-agenda.el (org-agenda-include-deadlines): Add new + customization variable to determine whether unscheduled tasks + should appear in the agenda solely because of their deadline. + Default to true, which was the previous behavior (it just wasn't + configurable). + (org-agenda-mode-map, org-agenda-view-mode-dispatch): Bind ! in + the agenda to show/hide deadline tasks. + (org-agenda-menu): Add menu option for show/hide deadlines. + (org-agenda-list): Make the agenda list sensitive to the value of + `org-agenda-include-deadlines'. + (org-agenda-toggle-deadlines): New function to toggle the value of + `org-agenda-include-deadlines' and repaint the modeline + indicators. + (org-agenda-set-mode-name): Show "Deadlines" in the agenda + modeline if deadline tasks are being displayed. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-eval-formula): Replace $# and @# by + current column and row number. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-property, org-delete-property): Go back to + prompting for the property. + + * org-latex.el (org-export-latex-make-header): Fully process + author line. + (org-export-latex-fontify-headline): Allow several arguments, not + just one. + (org-export-latex-fix-inputenc): Catch the error when + `latexenc-coding-system-to-inputenc' is not defined. + + * org-agenda.el (org-agenda-skip-if-todo): New function. + (org-agenda-skip-if): Add conditions for TODO keywords. + (org-agenda-skip-if): Document the new todo conditions. + +2010-04-10 Mikael Fornius <mfo@abc.se> + + * org.el (org-at-property-p): Check if we are inside a property + drawer not just any drawer. + (org-set-property, org-delete-property): When cursor is on a + property key value pair do not prompt for property name instead + use name at cursor. + (org-ctrl-c-ctrl-c): Still do org-property-action when cursor is + on the first line of a property drawer. + (org-property-end-re): Spell check. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-attach-captions-and-attributes): Add the + properties to the entire table, in case the first line is + removed. + + * org-archive.el (org-archive-reversed-order): New option. + (org-archive-subtree, org-archive-to-archive-sibling): Use the new + option `org-archive-reversed-order'. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-entry-types): New variable. + (org-agenda-list): Use `org-agenda-entry-types'. + (org-agenda-custom-commands-local-options): Support for setting + `org-agenda-entry-types' as an option. + (org-diary): Shift some documentation from here to the variable + `org-agenda-entry-types'. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-make-header): Apply macros in + author field. + + * org-clock.el (org-clocking-buffer, org-clocking-p): New function. + (org-clock-select-task, org-clock-notify-once-if-expired) + (org-clock-in, org-clock-out, org-clock-cancel, org-clock-goto) + (org-clock-out-if-current, org-clock-save): Use the new functions. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-docbook.el (org-export-as-docbook): Remove unnecessary + newline. + (org-export-as-docbook): Remove unnecessary newline. + (org-export-as-docbook): Fix problem with double footnote + reference in one place. + + * org-exp.el (org-export-format-source-code-or-example): + Remove unnecessary newline. + + * org.el (org-deadline, org-schedule): Allow rescheduling entries + with repeaters. + + * org-table.el (org-table-convert-refs-to-rc): Better way to catch + function calls that look like references. + + * org.el (org-open-at-point): Get link abbreviations from + reference buffer. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-convert-refs-to-rc): Do not read arctan2 + as a reference. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-link-unescape): Solve issue with lower-case escapes. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-classes): + Add \usepackage{latexsym} to all classes. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-as-html): Do not allow protected lines + into the table of contents. + + * org-latex.el (org-export-latex-special-chars): Find subsequent + occurrences of special characters. + (org-export-latex-tables): Do not convert table-like stuff that is + protected. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-toggle-checkbox): No errors when updating + checkbox count fails because there is no heading. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-report-include-clocking-task): + New option. + (org-clock-sum): Add the current clocking task. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-cycle): Print a message when in a table.el table. + (org-edit-special): Recognize the table.el context. + (org-ctrl-c-ctrl-c): Print a message when in a table.el table. + + * org-src.el (org-at-table.el-p): Declare. + (org-edit-src-code): Handle a special case for table.el editing. + (org-edit-src-find-region-and-lang): Recognize the table.el + context. + + * org-latex.el (org-export-latex-tables): Convert table.el + tables. + (org-export-latex-convert-table.el-table): New function. + + * org-html.el (org-html-expand): Fix table.el export. + + * org-latex.el (org-export-latex-preprocess): Protect footnotes in + headings. + + * org-id.el (org-id-find-id-file): Fix bug when there is no hash + table for the id locations. + + * org.el (org-read-date-analyze): Match American-style dates, like + 5/30 or 5/13/7. Make sure cal-iso.el is loaded. Don't force he + current year when reading ISO and American dates. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-face-from-face-or-color): New function. + (org-get-todo-face, org-font-lock-add-priority-faces) + (org-get-tag-face): Use `org-face-from-face-or-color'. + + * org-faces.el (org-todo-keyword-faces, org-priority-faces): + Allow simple colors as values. + (org-faces-easy-properties): New option. + + * org-agenda.el (org-agenda-set-mode-name): Show if the agenda is + restricted, as an agenda mode. + (org-agenda-fontify-priorities): Allow simple colors as values. + +2010-04-10 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-current-timer): Rename from + `org-timer-last-timer'. + (org-timer-timer1, org-timer-timer2, org-timer-timer3): Remove. + (org-timer-cancel-timer, org-timer-show-remaining-time) + (org-timer-set-timer): Update to use only one timer. + + * org.el (org-set-property): Remove useless space in the prompt. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-html-style-default): Add a default style + for textareas. + + * org-exp.el (org-export-format-source-code-or-example): + Fix textarea tag. + +2010-04-10 Bastien Guerry <bzg@altern.org> + + * org-clock.el (org-clock-current-task): New variable to store + last clocked in task. + (org-clock-set-current, org-clock-delete-current): New functions. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-remember.el (org-remember-apply-template): Extend comment. + (org-remember-handler): Implement clock sibling filing. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-all, org-publish-current-file) + (org-publish-current-project): When called with prefix argument + FORCE, also rebuild the validation file list. + + * org-latex.el (org-export-latex-preprocess): Protect footnotes in + section headings. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-as-html-and-open): Kill product buffer + if the user wants that. + + * org-latex.el (org-export-as-pdf-and-open): Kill product buffer + if the user wants that. + + * org-exp.el (org-export-kill-product-buffer-when-displayed): + New option. + + * org-agenda.el (org-batch-agenda-csv): Use the time property + instead of the `time-of-day' property. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-timer.el (org-timer-start-hook, org-timer-stop-hook) + (org-timer-pause-hook, org-timer-set-hook) + (org-timer-cancel-hook): New hooks. + (org-timer-start): Run `org-timer-start-hook'. + (org-timer-pause-or-continue): Run `org-timer-pause-hook'. + (org-timer-stop): Run `org-timer-stop-hook'. + (org-timer-cancel-timers): Run `org-timer-cancel-hook'. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-reveal): Double prefix arg shows the subtree of the + parent. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-search-view): Fix bug with searching full + words in headlines in search view. + (org-agenda-skip-deadline-prewarning-if-scheduled): New option. + (org-agenda-get-deadlines): Suppress pre-warning if the entry is + scheduled (if the user configures it so. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-hide-archived-subtrees): Don't jump to end of + subtree if the match was not in a headline. + (org-inside-latex-macro-p): Allow more complex arguments. + (org-emphasize): Protect against use at end of buffer. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-align-tags): Avoid side effects on + text properties. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-todo-ignore-scheduled): More allowed + values. + (org-agenda-todo-ignore-scheduled) + (org-agenda-todo-ignore-deadlines): More control with different + allowed values. + (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item): + Honor the new option settings. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-get-location): Make sure the selection buffer is + shown in the current frame. + + * org-ascii.el (org-export-ascii-table-widen-columns): + New option. + (org-export-ascii-preprocess): Realign tables to remove narrowing + if `org-export-ascii-table-widen-columns' is set. + + * org-table.el (org-table-do-narrow): New variable. + (org-table-align): Narrow only if `org-table-do-narrow' is t. + + * org.el (org-deadline, org-schedule): Allow updating if the + relevant time stamp does not have a repeater, i.e. do not require + that no time stamp has a repeater. + + * org-agenda.el (org-agenda-align-tags): Don't add a face to the + new white space before the tags. + + * org-latex.el (org-export-as-latex): Do nit require the buffer to + be visiting a file when only exporting to a buffer or string. + (org-export-latex-fix-inputenc): Only save the buffer is there is + a file name attached to it. + +2010-04-10 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-exit): Widen before exiting edit buffers. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-fontify-meta-lines-and-blocks): + Honor `org-fontify-quote-and-verse-blocks'. + + * org-faces.el (org-fontify-quote-and-verse-blocks): New option. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-open-at-point): Also check for text property + org-linked-text before offering collected links. + +2010-04-10 Stephen Eglen <stephen@gnu.org> + + * org-agenda.el (org-agenda-add-entry-to-org-agenda-diary-file): + Optionally extract time specification from text and add to the + timestamp. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-html-entities): Fix typo. + + * org-latex.el (org-export-latex-make-header): Use \providecommand + to make sure the \alert macro is defined. + + * org.el (org-format-latex-signal-error) + (org-create-formula-image): Use `org-format-latex-signal-error'. + +2010-04-10 Stephen Eglen <stephen@gnu.org> + + * org.el (org-store-link): For dired buffers, use + default-directory as link name if dired-get-filename returns + nil. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-concatenate-multiline-links): The for + protectedness at beginning of match. + + * org-latex.el (org-export-latex-fix-inputenc): Never leave the + AUTO as a coding system, instead default to utf8. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-block-todo-from-children-or-siblings-or-parent) + (org-block-todo-from-checkboxes): Respect the local variable + value when deciding if blocking should be active. + + * org-latex.el (org-export-latex-make-header): Define the align + macro if it is not yet defined. + + * org-agenda.el (org-agenda-insert-diary-make-new-entry): + Call `org-insert-heading' with the INVISIBLE-OK argument. + + * org-mac-message.el (org-mac-message-insert-flagged): + Call `org-insert-heading' with the INVISIBLE-OK argument. + + * org.el (org-insert-heading): New argument INVISIBLE-OK. + + * org-agenda.el (org-agenda-view-mode-dispatch): Improve the + prompt message. + + * org-html.el (org-html-level-start): Use the + `html-container-class' text property to set an additional class + for an outline container. + + * org-exp.el (org-export-remember-html-container-classes): + New function. + (org-export-preprocess-string): + Call `org-export-remember-html-container-classes'. + + * org.el (org-cycle): Mention level cycling in the docstring. + (org-default-properties): Add new property HTML_CONTAINER_CLASS. + + * org-remember.el (org-remember-apply-template): Do file insertion + first. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-habit.el (org-habit-insert-consistency-graphs): Fix a + problem with mis-aligned graphs when showing habits. + +2010-04-10 Mikael Fornius <mfo@abc.se> + + * org.el (org-assign-fast-keys): Prefer keys used in keyword name + when assigning. Begin using numerical characters when all in name + is used up. This is to spare alphanumeric characters for better + match with other keywords. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-preprocess-hook): Improve documentation. + + * org-latex.el (org-export-latex-preprocess): More consistent + conversion and protection of the words LaTeX and TeX. + (org-export-latex-fontify-headline, org-export-latex-preprocess): + Allow angle brackets in commands, for beamer. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-in): Improve the look of the clock line + by formatting links. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-classes): Use AUTO as the place + holder string for the coding system. And improve the + documentation. + (org-export-latex-fix-inputenc): Only modify the coding system if + it is given by the placeholder AUTO. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-task-overrun-text): New option. + (org-task-overrun, org-clock-update-period): New variables. + (org-clock-get-clock-string, org-clock-update-mode-line): + Mark overrun clock. + (org-clock-notify-once-if-expired): Check if clock is overrun. + + * org-faces.el: New face `org-mode-line-clock-overrun'. + +2010-04-10 Jan Böcker <jan.boecker@jboecker.de> + + * org.el (org-narrow-to-subtree): Position the end of the narrowed + region before the line with the next heading, to prevent the user + from prepending text to the next headline. + +2010-04-10 Stephen Eglen <stephen@gnu.org> + + * org-agenda.el (org-get-time-of-day): + Use org-agenda-time-leading-zero to allow leading zero (rather than + space) for times. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-diary-entry-in-org-file): Make sure + org-datetree.el is loaded. + + * org-datetree.el: Autoload `org-datetree-find-day-create'. + + * org-latex.el (org-export-latex-hyperref-format): New option. + (org-export-latex-links): Use `org-export-latex-hyperref-format'. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-ctags.el (org-ctags-enable): Change order of functions. + (org-ctags-create-tags): Add wildcard to file name expansion. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-entry-properties): Fix some important bugs. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-link-unescape, org-link-escape): Only use hexlify if + the table is not explicitly given. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-out-when-done): Allow a list of keywords + as value. + (org-clock-out-if-current): Work with the new list value of + `org-clock-out-when-done'. + (org-clock-out, org-clock-out-if-current): Avoid circular logic + between clocking out and state changes. + + * org-ctags.el (org-ctags-path-to-ctags): Better system-type test. + + * org-latex.el (org-export-latex-treat-backslash-char): Do not by + accident protect a character that is before a backslash. + +2010-04-10 Paul Sexton <eeeickythump@gmail.com> + + * org-ctags.el: New file. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-diary-class): + Use `org-order-calendar-date-args'. + + * org.el (org-order-calendar-date-args): New function. + + * org-exp.el (org-export-target-internal-links): Check for + protectedness after the first bracket. + + * org.el (org-entry-properties): Don't match wrong-case TODO + keywords. + + * org-agenda.el (org-agenda-schedule, org-agenda-deadline): + Document that ARG is passed through to remove the date. + (org-agenda-bulk-action): Accept prefix arg and pass it on. + Do not read a date when the user has given a `C-u' prefix. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-fix-displayed-tags): Fix bug when all + tags are hidden. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-fix-inputenc): New function. + (org-export-latex-inputenc-alist): New option. + + * org-exp.el (org-export): New key SPC to publish enclosing + subtree. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-indent.el (org-indent-add-properties): Catch case when there + is no headline in the buffer. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-html-entities): Add checkmark symbol. + + * org-ascii.el (org-export-ascii-preprocess): Protect targets in + verbatim code for ASCII export. + + * org.el (org-update-statistics-cookies): Also see checkboxes in + ordered lists. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-view-mode-dispatch): Define the `L' + key. + + * org-beamer.el (org-beamer-amend-header): Change the location + where `org-beamer-header-extra' is inserted. + + * org.el (org-compute-latex-and-specials-regexp): Don't do BIND + just for computing this regexp. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-frame-default-options): New option. + (org-beamer-sectioning): Use default options if the user does not + have defined any. + (org-beamer-fix-toc): Put a frame around the table of contents. + + * org-exp.el (org-export-remove-comment-blocks-and-subtrees): + Make sure case-folding works well when processing comment stuff. + + * org-latex.el (org-export-latex-after-save-hook): New hook. + (org-export-as-latex): Run the new hook. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-environments-default): Add the note + environments. + (org-beamer-after-initial-vars): Allow several BEAMER_HEADER_EXTRA + lines and collect and combine the content. + (org-beamer-after-initial-vars): Check for note tags and make sure + they will be seen like a property. + + * org.el (org-offer-links-in-entry): Fix bug when there is a + single link. + + * org-exp.el (org-export): Make sure the mark is activated, also + when `transient-mark-mode' is off. + + * org-agenda.el (org-agenda-search-view-always-boolean): New option. + (org-agenda-search-view-search-words-only): Obsolete variable, is + now an alias for `org-agenda-search-view-always-boolean'. + (org-agenda-search-view-force-full-words): New option. + (org-search-view): Improve docstring, and implement a better logic + for Boolean and phrase searches. + (org-agenda-last-search-view-search-was-boolean): New variable. + (org-agenda-manipulate-query): Consider the type of the last + search when modifying the search string. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-as-latex): Do the first letbind in the + right moment. + + * org-agenda.el (org-get-entries-from-diary): Add the new face to + these entries. + + * org-faces.el (org-agenda-diary): New face. + + * org.el (org-make-link-regexps): Allow regexp-special characters + in link types. + (org-open-file): When in-emacs is `system', also force system + opening, like when the value was `(16)'. + (org-update-statistics-cookies): Handle entries without children. + + * org-exp.el + (org-export-preprocess-before-normalizing-links-hook): New hook. + (org-export-preprocess-string): Run the new hook. + + * org.el (org-offer-links-in-entry): Make RET open all links. + + * org-html.el (org-export-as-html): Remove any leftover display + properties in the html file. + + * org-wl.el (org-wl-store-link): Work-around for format bug with + text properties. + + * org-habit.el (org-habit-insert-consistency-graphs): Turn off + invisibility while adding the graphs. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-remember.el (org-select-remember-template): Use C letter to + customize remember templates. + + * org-agenda.el (org-agenda-bulk-mark, org-agenda-bulk-unmark): + Move cursor to next visible line. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-sectioning): Leave columns environment + by specifying 0 or 1 for column width. + (org-beamer-column-widths): Make 0 stand for 0.0. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-mark-radio-links): Don't match inside + <<target>>. + + * org.el (org-format-latex-header-extra): New variable. + (org-format-latex): Set org-format-latex-header-extra from + in-buffer stuff. + (org-format-latex): Add org-format-latex-header-extra to the + variables on which image creation depends. + (org-create-formula-image): Add the header stuff from in-buffer + settings. + (org-read-date-analyze): Base the analysis for future preference + on NOW, not on the default date. + + * org-inlinetask.el (org-inlinetask-export-handler): Add CSS class + for TODO keyword in inline tasks. + + * org.el (org-log-note-headings): New headings for removing + deadline or scheduling date. + (org-deadline, org-schedule): Arrange for logging when removing a + date. + (org-add-log-note): Handle deadline and scheduling removal. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-visible): Add LaTeX/pdf export. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-diary-class): New function. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Do process the text + of a radio target. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-entry-properties): Add TIMESTAMP properties back + in. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-all-time-keywords): New variable. + (org-set-regexps-and-options): Set `org-all-time-keywords'. + (org-entry-blocked-p): New function. + (org-special-properties): Add BLOCKED as a new special property. + (org-entry-properties): New optional argument SPECIFIC, only parse + for this property when it is specified. + (org-entry-get): Pass a SPECIFIC argument to + `org-entry-properties'. + + * org-latex.el (org-export-as-latex): Preprocess TEXT as well. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-tables): No forced line end if + there is no caption. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-html-entities): Add Euro symbols from Marvosym + package. + + * org-latex.el (org-export-latex-tables): Only add a caption when + macro in in longtable environments if one has been defined. + + * org-html.el (org-export-as-html): Only take title from buffer if + not exporting body-only. + + * org-latex.el (org-export-latex-preprocess): Better version of + the regular expression for protecting LaTeX macros. + (org-export-latex-preprocess): Start searching for macros to + protect from beginning of buffer. + + * org-exp.el (org-export-target-internal-links): Check for + protectedness earlier in the string. + + * org-agenda.el (org-agenda-highlight-todo): Match TODO keywords + case sensitively. + + * org-id.el (org-id-store-link): Match TODO keywords case + sensitively. + + * org.el (org-heading-components, org-get-outline-path) + (org-display-outline-path): Match TODO keywords case sensitively. + + * org-latex.el (org-export-as-latex): Ignore read-only + properties. + + * org-exp.el (org-export-preprocess-string): Remove any + `read-only' properties. + + * org-agenda.el (org-agenda-inactive-leader): New option. + (org-agenda-get-timestamps): Use `org-agenda-inactive-leader'. + (org-tags-view): Prompt for matcher if MATCH is an empty string. + (org-todo-list): Prompt for matcher if ARG is an empty string. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-open-link-functions): New hook. + (org-open-at-point): Run `org-open-link-functions'. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-date-prompt): Allow inactive time + stamps as well. + + * org.el (org-inhibit-startup-visibility-stuff): New variable. + (org-mode): Don't do startup visibility if inhibited. + (org-outline-overlay-data, org-set-outline-overlay-data): + New functions. + (org-save-outline-visibility): New macro. + (org-log-note-headings): Document that one should not change the + `state' note format. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-make-link-regexps): Capture link path into a group. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-after-initial-vars): Do not overwrite + the options plist. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-startup-with-beamer-mode): New option. + (org-property-changed-functions) + (org-property-allowed-value-functions): New hooks. + (org-entry-put, org-property-get-allowed-values): Run the new + hooks. + (org-property-next-allowed-value): Run the new hooks. + + * org-exp.el (org-export-select-backend-specific-text): Add the + special beamer tags. + + * org-beamer.el: New file. + + * org-latex.el (org-export-latex-after-initial-vars-hook): New hook. + (org-export-as-latex): + Run `org-export-latex-after-initial-vars-hook'. + (org-export-latex-format-toc-function) + (org-export-latex-make-header): + Call `org-export-latex-format-toc-function'. + + * org.el (org-fill-template): Make template searches case sensitive. + + * org-exp.el (org-export): Use "1" as a sign to export only the + subtree. + + * org-colview-xemacs.el (org-columns-edit-value): + Use org-unrestricted property. + + * org-colview.el (org-columns-edit-value): + Use org-unrestricted property. + + * org.el (org-compute-property-at-point): Set org-unrestricted + text property if the list contains ":ETC". + (org-insert-property-drawer): + Use org-unrestricted property. + + * org-exp.el + (org-export-preprocess-before-selecting-backend-code-hook): New hook. + (org-export-preprocess-string): + Run `org-export-preprocess-before-selecting-backend-code-hook'. + + * org-xoxo.el (org-export-as-xoxo): Run `org-export-first-hook'. + + * org-latex.el (org-export-region-as-latex): + Run `org-export-first-hook'. + + * org-html.el (org-export-as-html): Run `org-export-first-hook'. + + * org-docbook.el (org-export-as-docbook): + Run `org-export-first-hook'. + + * org-ascii.el (org-export-as-ascii): Run `org-export-first-hook'. + + * org-exp.el (org-export-first-hook): New hook. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-previous-item): Exit at the beginning of the + buffer. + + * org-id.el (org-id-locations-save): Only write the id locations + if any are defined. + + * org-archive.el (org-archive-all-done): Make this work in a file + with org-odd-levels-only set. + + * org.el (org-get-refile-targets): Catch the case when a buffer + has no file. + + * org-latex.el (org-export-as-latex): Cleanup forced line ends + where they are not needed. + (org-export-latex-subcontent): Remove unnecessary newlines. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-make-header): Remove \obeylines. + (org-export-latex-fontify): Fix regexp bug that takes special + care of protecting the right boundary characters in emphasis + matches. + (org-export-latex-preprocess): Allow multiple arguments to latex + macros. + + * org.el (org-make-link-regexps): Use John Gruber's regexp for + urls. + + * org-macs.el (org-re): Interpret :punct: in regexps. + + * org-exp.el (org-export-replace-src-segments-and-examples): + Also take the final newline after the END line. + + * org.el (org-clean-visibility-after-subtree-move): Only fix + entries that are not entirely invisible already. + (org-insert-link): Respect org-link-file-path-type for + "docview:" links in addition to "file:" links. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): + Avoid additional extra white lines in LaTeX. + + * org-list.el (org-list-parse-list): Leave empty lines after the + list, don't consider them as part of the list. + + * org-mobile.el (org-mobile-sumo-agenda-command): Allow tagstodo + searches. + + * org-clock.el (org-clock-select-task): Convert integer to + character for XEmacs. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-resolve): Make reading a char XEmacs + compatible. + +2010-04-10 Tassilo Horn <tassilo@member.fsf.org> + + * org.el (org-complete-tags-always-offer-all-agenda-tags): + New variable. + (org-set-tags): Use it. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-empty-line-terminates-plain-lists): + Update docstring. + + * org.el (org-format-latex): Fix link creation for processed latex + snippets. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-footnote.el (org-footnote-normalize): Protect replacement + text. + + * org.el (org-inside-latex-macro-p): Save match data. + +2010-04-10 Jan Böcker <jan.boecker@jboecker.de> + + * org-docview.el: New file. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-class-options): New variable. + (org-export-latex-set-initial-vars): Use the class options. + + * org.el (org-forward-same-level): Stop at headings that start + with an invisible character. + (org-additional-option-like-keywords): Add LaTeX_CLASS_OPTIONS. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-footnote.el (org-footnote-normalize): Don't take optional + arguments in LaTeX macros as footnotes. + + * org.el (org-inside-latex-macro-p): New function. + + * org-latex.el (org-latex-to-pdf-process): Change customization + group to `org-export-pdf'. + + * org-agenda.el (org-agenda-get-blocks): Look at time string also + on days after the first one. + + * org.el (org-insert-heading): Also check for item before assuming + before-first-heading condition. + + * org-latex.el (org-latex-to-pdf-process): Fix typo in group tag. + (org-export-pdf-logfiles): New option. + (org-export-as-pdf): Use `org-export-pdf-logfiles'. + (org-export-pdf-logfiles): Fix customization type. + + * org.el (org-insert-link): Improve error message when there is no + default link to select with RET. + + * org-agenda.el (org-agenda-filter-by-tag): Use char argument from + parameter list. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-parse-global) + (org-export-latex-parse-content) + (org-export-latex-parse-subcontent): + Use `org-re-search-forward-unprotected'. + (org-export-as-pdf): Remove log files produced by XeTeX. + + * org-macs.el (org-re-search-forward-unprotected): New function. + +2010-04-10 James TD Smith <ahktenzero@mohorovi.cc> + + * org-colview.el (org-agenda-colview-summarize): Sort out some + confusion between properties and titles, which resulted in + agenda summaries not working if a title was set for a column. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-agendas): New option. + (org-mobile-sumo-agenda-command): Select the right agendas. + + * org-latex.el (org-export-latex-format-image): Preserve the + original-indentation property. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-insert-selection-line): Catch error when + an old tasks no longer exists. + + * org-latex.el (org-export-as-pdf): Remove also the .idx file. + (org-export-as-pdf): Don't remove the old PDF file before making + the new one. + + * org-mouse.el (org-mouse-end-headline, org-mouse-insert-item) + (org-mouse-context-menu): Use `org-looking-back'. + + * org.el (org-cycle-level): Use `org-looking-back'. + + * org-list.el (org-cycle-item-indentation): + Use `org-looking-back'. + + * org-compat.el (org-looking-back): New function. + + * org.el (org-insert-heading): Catch before-first-headline when + inserting a headline. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-format-image): Indent figure + environment, so that it does not interrupt plain list. + + * org.el (org-open-at-point): Allow long link descriptions. + +2010-04-10 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-as-html): Remove empty lines at the + beginning of the exported text. + +2010-03-12 Chong Yidong <cyd@stupidchicken.com> + + * org.el (org): Remove from hypermedia group. + +2010-03-10 Chong Yidong <cyd@stupidchicken.com> + + * Branch for 23.2. + 2010-02-15 Chong Yidong <cyd@stupidchicken.com> * org-freemind.el (org-freemind-from-org-mode-node) @@ -37,8 +6630,8 @@ 2009-11-20 Carsten Dominik <carsten.dominik@gmail.com> - * org-agenda.el (org-agenda-diary-entry-in-org-file): Rebuild - agenda after adding new entry. + * org-agenda.el (org-agenda-diary-entry-in-org-file): + Rebuild agenda after adding new entry. * org-datetree.el (org-datetree-find-day-create): Fix regular expression. @@ -75,8 +6668,8 @@ * org-agenda.el (org-agenda-insert-diary-strategy): New variable. (org-agenda-insert-diary-as-top-level): New function. - (org-agenda-add-entry-to-org-agenda-diary-file): Call - `org-agenda-insert-diary-as-top-level'. + (org-agenda-add-entry-to-org-agenda-diary-file): + Call `org-agenda-insert-diary-as-top-level'. * org.el (org-occur-in-agenda-files): Make sure none of the buffers is narrowed. @@ -143,8 +6736,8 @@ * org-agenda.el (org-agenda-show-outline-path): New option. (org-agenda-do-context-action): New function. - (org-agenda-next-line, org-agenda-previous-line): Use - `org-agenda-do-context-action'. + (org-agenda-next-line, org-agenda-previous-line): + Use `org-agenda-do-context-action'. * org.el (org-use-speed-commands): Allow function value. (org-speed-commands-default): Make headline motion safe, so that @@ -221,8 +6814,8 @@ * org-latex.el (org-export-latex-links): Check for protectedness in the last matched character, not after the match. - * org-datetree.el (org-datetree-find-date-create): Respect - restriction when KEEP-RESTRICTION is set. + * org-datetree.el (org-datetree-find-date-create): + Respect restriction when KEEP-RESTRICTION is set. (org-datetree-file-entry-under): New function. (org-datetree-cleanup): New command. @@ -260,8 +6853,8 @@ * org-agenda.el (org-agenda-diary-entry-in-org-file) (org-agenda-add-entry-to-org-agenda-diary-file) (org-agenda-insert-diary-make-new-entry): New functions. - (org-agenda-diary-entry): Call - `org-agenda-diary-entry-in-org-file' when appropriate. + (org-agenda-diary-entry): + Call `org-agenda-diary-entry-in-org-file' when appropriate. * org.el (org-calendar-insert-diary-entry-key): New option. (org-agenda-diary-file): New option. @@ -312,16 +6905,15 @@ 2009-11-13 Dan Davison <davison@stats.ox.ac.uk> - * org-exp.el (org-export-format-source-code-or-example): restrict - scope of preserve-indentp to the let binding. - (org-src): require org-src, since org-src-preserve-indentation is used. + * org-exp.el (org-export-format-source-code-or-example): + Restrict scope of preserve-indentp to the let binding. + (org-src): Require org-src, since org-src-preserve-indentation is used. 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> * org-timer.el (org-timer-set-timer): Set variables org-timer-timer[123] correctly. - * org-mobile.el (org-mobile-files-alist): Make it work when `agenda-archives' is included in `org-agenda-text-search-extra-files'. @@ -334,14 +6926,14 @@ 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> - * org-icalendar.el (org-print-icalendar-entries): Use - org-icalendar-verify-function only if non-nil. + * org-icalendar.el (org-print-icalendar-entries): + Use org-icalendar-verify-function only if non-nil. * org.el (org-refile): Refile to clock only if the prefix arg is 2. (org-sparse-tree): Fix docstring to be in line with prompt. - (org-update-parent-todo-statistics): Call - `org-after-todo-statistics-hook' on each level. + (org-update-parent-todo-statistics): + Call `org-after-todo-statistics-hook' on each level. 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> @@ -372,8 +6964,8 @@ * org-clock.el (org-clock-play-sound): Expand file in org-clock-sound, to allow ~ for home. - * org-remember.el (org-remember-handler): Set - text-before-node-creation even if this already looks like a node, + * org-remember.el (org-remember-handler): + Set text-before-node-creation even if this already looks like a node, because the string might be needed on non-org-mode target files. * org-agenda.el (org-agenda-open-link): Make this work in agenda @@ -384,7 +6976,7 @@ 2009-11-13 James TD Smith <ahktenzero@mohorovi.cc> - * org-colview-xemacs.el: Add in changes from org-colview.el + * org-colview-xemacs.el: Add in changes from org-colview.el. 2009-11-13 Dan Davison <davison@stats.ox.ac.uk> @@ -402,12 +6994,12 @@ * org-src.el (org-src-preserve-indentation): Document that this variable is also used during export. - * org-exp.el (org-export-format-source-code-or-example): Preserve - indentation if a block has a -i option, or if + * org-exp.el (org-export-format-source-code-or-example): + Preserve indentation if a block has a -i option, or if `org-src-preserve-indentation' is set. - * org-exp-blocks.el (org-export-blocks-preprocess): Preserve - indentation if a block has a -i option, or if + * org-exp-blocks.el (org-export-blocks-preprocess): + Preserve indentation if a block has a -i option, or if `org-src-preserve-indentation' is set. 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> @@ -424,8 +7016,8 @@ (org-agenda-menu): Add the new archiving commands to the menu. (org-agenda-archive-default) (org-agenda-archive-default-with-confirmation): New commands. - (org-agenda-archive, org-agenda-archive-to-archive-sibling): Just - call `org-agenda-archive-with'. + (org-agenda-archive, org-agenda-archive-to-archive-sibling): + Just call `org-agenda-archive-with'. (org-agenda-archive-with): New function. * org-table.el (org-table-convert-region): Inert spaces around "|" @@ -445,8 +7037,8 @@ IF-EXISTS, which avoids creating the attachment directory if it does not yet exist. - * org-agenda.el (org-agenda, org-run-agenda-series): Evaluate - MATCH. + * org-agenda.el (org-agenda, org-run-agenda-series): + Evaluate MATCH. 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> @@ -525,12 +7117,12 @@ point. (org-columns-compile-map): There is now an extra position in each entry specifying the function to use to calculate the displayed - value for the non-calculated properties in the column, + value for the non-calculated properties in the column. (org-columns-compute-all): Set `org-columns-time' to the current time so time difference calculations will work. (org-columns-compute): Handle column operators where the values used are calculated from the underlying property. - (org-columns-number-to-string): Handle the 'age' column format + (org-columns-number-to-string): Handle the 'age' column format. (org-columns-string-to-number): Correct the function name (was org-column...). Add support for the 'age' column format. (org-columns-compile-format): Support the additional parameter in @@ -559,8 +7151,8 @@ 2009-11-13 John Wiegley <jwiegley@gmail.com> - * org-clock.el (org-clock-display, org-clock-put-overlay): Use - `org-time-clock-use-fractional'. + * org-clock.el (org-clock-display, org-clock-put-overlay): + Use `org-time-clock-use-fractional'. * org.el (org-time-clocksum-use-fractional) (org-time-clocksum-fractional-format): Two new customizable @@ -591,7 +7183,7 @@ called with either `org-scheduled-string' or `org-deadline-string'. - * org-clock.el (org-clock-auto-clock-resolution): Renamed + * org-clock.el (org-clock-auto-clock-resolution): Rename from `org-clock-disable-clock-resolution', since negatives don't sound good in customization variables. (org-clock-in): Don't use the auto-resolution logic if the user is @@ -633,14 +7225,14 @@ more general. (org-habit-parse-todo): Parse the new ".+N/N" style repeater. - * org-agenda.el (org-agenda-get-deadlines): Removed all mention of + * org-agenda.el (org-agenda-get-deadlines): Remove all mention of habits, since they don't use DEADLINE anymore. * org.el (org-repeat-re, org-display-custom-time) - (org-timestamp-change): Extended to support the new ".+N/N" + (org-timestamp-change): Extend to support the new ".+N/N" syntax, used for habits. - * org-clock.el (org-clock-resolve-clock): Fixed an incorrect + * org-clock.el (org-clock-resolve-clock): Fix an incorrect variable reference. * org-agenda.el (org-agenda-set-mode-name): Show Habit in the @@ -657,8 +7249,8 @@ * org-agenda.el (org-agenda-next-line): New command. (org-agenda-previous-line): New commands. - (org-agenda-show-and-scroll-up, org-agenda-show-scroll-down): New - commands. + (org-agenda-show-and-scroll-up, org-agenda-show-scroll-down): + New commands. (org-agenda-follow-mode): Do the follow immediately if the mode is turned on here. (previous-line, next-line): Replace keys with the corresponding @@ -674,7 +7266,7 @@ * org.el (org-file-tags): Fix docstring. (org-get-buffer-tags): Add the #+FILETAGS tags. - ("ecb"): Maks ecb show context after jumping into an Org file. + ("ecb"): Make ecb show context after jumping into an Org file. 2009-11-13 John Wiegley <johnw@newartisans.com> @@ -689,8 +7281,8 @@ 2009-11-13 John Wiegley <johnw@newartisans.com> - * org-clock.el (org-clock-disable-clock-resolution): New - customization variable that disable automatic clock resolution on + * org-clock.el (org-clock-disable-clock-resolution): + New customization variable that disable automatic clock resolution on clock in. (org-clock-in): If `org-clock-disable-clock-resolution' is set, do not automatically resolve anything. This is does not affect @@ -705,19 +7297,19 @@ (org-agenda-get-scheduled): Display consistency graphs when outputting habits into the agenda. The graphs are always relative to the current time. - (org-format-agenda-item): Added new parameter `habitp', which + (org-format-agenda-item): Add new parameter `habitp', which indicates whether we are formatting a habit or not. Do not display "extra" leading information if habitp is true. - * org.el (org-repeat-re): Improved regexp to include .+ and ++ + * org.el (org-repeat-re): Improve regexp to include .+ and ++ leaders for repeat strings. (org-get-repeat): Now takes a string parameter `tagline', so the caller can obtain the SCHEDULED repeat, or the DEADLINE repeat. 2009-11-13 John Wiegley <johnw@newartisans.com> - * org-agenda.el (org-agenda-auto-exclude-function): New - customization variable for allowing the user to create an "auto + * org-agenda.el (org-agenda-auto-exclude-function): + New customization variable for allowing the user to create an "auto exclusion" filter for doing context-aware auto tag filtering. (org-agenda-filter-by-tag): Changes to support the use of `org-agenda-auto-exclude-function'. See the new manual addition,. @@ -727,7 +7319,7 @@ * org.el (org-files-list): Don't attempt to return a file name for Org buffers which have no associated file. - * org-agenda.el (org-agenda-do-action): Fixed a typo. + * org-agenda.el (org-agenda-do-action): Fix a typo. 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> @@ -749,7 +7341,7 @@ * org-clock.el (org-clock-resolve, org-resolve-clocks) (org-emacs-idle-seconds): Use `org-float-time' instead of - `time-to-seconds' + `time-to-seconds'. 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> @@ -777,15 +7369,15 @@ currently active clock if the user has exceeded the time returned by `org-user-idle-seconds', based on the value of `org-clock-idle-time'. - (org-clock-in): If, after resolving clocks, + (org-clock-in): If, after resolving clocks, (???) (org-clock-out): Cancel the `org-clock-idle-timer' on clock out. * org-clock.el (org-clock-resolve-clock): New function that resolves a clock to a specific time, closing or resuming as need be, and possibly even starting a new clock. (org-clock-resolve): New function used by `org-resolve-clocks' - that sets up for the call to `org-clock-resolve-clock'. It - determines the time to resolve to based on a single-character + that sets up for the call to `org-clock-resolve-clock'. + It determines the time to resolve to based on a single-character selection from the user to either keep time, subtract away time or cancel the clock. (org-resolve-clocks): New user command which resolves dangling @@ -894,8 +7486,8 @@ 2009-11-13 Carsten Dominik <carsten.dominik@gmail.com> * org-src.el (org-edit-src-code) - (org-edit-src-find-region-and-lang, org-edit-src-exit): Handle - macro editing. + (org-edit-src-find-region-and-lang, org-edit-src-exit): + Handle macro editing. * org-agenda.el (org-prefix-category-max-length): New variable. (org-format-agenda-item): Use `org-prefix-category-max-length'. @@ -918,7 +7510,7 @@ * org-exp.el (org-export-select-backend-specific-text): Remove the region markers. - * org-inlinetask.el (org-inlinetask-export-handler): fix bug for + * org-inlinetask.el (org-inlinetask-export-handler): Fix bug for tasks without content. * org-clock.el: Make sure the clock-in target position does not @@ -1048,12 +7640,12 @@ (org-agenda-show-new-time, org-agenda-date-prompt) (org-agenda-schedule, org-agenda-deadline, org-agenda-action) (org-agenda-clock-in, org-agenda-bulk-mark) - (org-agenda-bulk-unmark, org-agenda-show-the-flagging-note): Use - `org-get-at-bol'. + (org-agenda-bulk-unmark, org-agenda-show-the-flagging-note): + Use `org-get-at-bol'. * org-colview.el (org-columns-display-here) - (org-columns-edit-allowed, org-agenda-columns): Use - `org-get-at-bol'. + (org-columns-edit-allowed, org-agenda-columns): + Use `org-get-at-bol'. 2009-10-01 Carsten Dominik <carsten.dominik@gmail.com> @@ -1088,13 +7680,13 @@ 2009-10-01 Carsten Dominik <carsten.dominik@gmail.com> - * org-agenda.el (org-prepare-agenda): Reset - `org-drawers-for-agenda'. + * org-agenda.el (org-prepare-agenda): + Reset `org-drawers-for-agenda'. (org-prepare-agenda): Uniquify list of drawers. * org.el (org-complex-heading-regexp-format): New variable. - (org-set-regexps-and-options): Define - `org-complex-heading-regexp-format'. + (org-set-regexps-and-options): + Define `org-complex-heading-regexp-format'. (org-drawers-for-agenda): New variable. (org-map-entries): Bind `org-drawers-for-agenda'. (org-prepare-agenda-buffers): Add to `org-drawers-for-agenda'. @@ -1139,10 +7731,10 @@ * org-archive.el (org-archive-set-tag) (org-archive-subtree-default): New commands. - * org-clock.el (org-clock-clocktable-default-properties): New - option. - (org-clock-report): Use - `org-clock-clocktable-default-properties'. + * org-clock.el (org-clock-clocktable-default-properties): + New option. + (org-clock-report): + Use `org-clock-clocktable-default-properties'. 2009-10-01 Carsten Dominik <carsten.dominik@gmail.com> @@ -1207,7 +7799,7 @@ 2009-10-01 Bastien Guerry <bzg@altern.org> - * org.el (org-check-agenda-file): Use a more explicit message + * org.el (org-check-agenda-file): Use a more explicit message. 2009-10-01 Carsten Dominik <carsten.dominik@gmail.com> @@ -1245,8 +7837,8 @@ 2009-10-01 Carsten Dominik <carsten.dominik@gmail.com> - * org-agenda.el (org-agenda-entry-text-exclude-regexps): New - variable. + * org-agenda.el (org-agenda-entry-text-exclude-regexps): + New variable. (org-agenda-entry-text-cleanup-hook): New hook. (org-agenda-get-some-entry-text): Remove matches of `org-agenda-entry-text-exclude-regexps' and run the hook @@ -1396,8 +7988,8 @@ 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> - * org.el (org-eval-in-calendar): Use - `org-select-frame-set-input-focus'. + * org.el (org-eval-in-calendar): + Use `org-select-frame-set-input-focus'. * org-compat.el (org-select-frame-set-input-focus): New function. @@ -1443,8 +8035,8 @@ (org-agenda-menu): Add effort setting commands to menu. (org-agenda-set-property, org-agenda-set-effort): New functions. - * org-latex.el (org-export-latex-tables): Fix - `org-table-last-alignment' and `org-table-last-column-widths' if + * org-latex.el (org-export-latex-tables): + Fix `org-table-last-alignment' and `org-table-last-column-widths' if the first column has been removed. 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> @@ -1466,8 +8058,8 @@ (org-get-last-sibling): New function. (org-refile): Use `org-get-next-sibling' instead of the outline version of this function. - (org-clean-visibility-after-subtree-move): Use - `org-get-next-sibling' and `org-get-last-sibling' instead of the + (org-clean-visibility-after-subtree-move): + Use `org-get-next-sibling' and `org-get-last-sibling' instead of the outline versions of these functions. 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> @@ -1495,8 +8087,8 @@ (org-table-get-specials, org-table-rotate-recalc-marks) (org-table-get-range, org-table-recalculate) (org-table-edit-formulas, org-table-fedit-convert-buffer) - (org-table-show-reference, org-table-highlight-rectangle): Don't - use `goto-line'. + (org-table-show-reference, org-table-highlight-rectangle): + Don't use `goto-line'. * org-src.el (org-edit-src-code, org-edit-fixed-width-region) (org-edit-src-exit): Don't use `goto-line'. @@ -1511,8 +8103,8 @@ * org-colview.el (org-columns, org-columns-redo) (org-agenda-columns): Don't use `goto-line'. - * org-colview-xemacs.el (org-columns, org-agenda-columns): Don't - use `goto-line'. + * org-colview-xemacs.el (org-columns, org-agenda-columns): + Don't use `goto-line'. * org-agenda.el (org-agenda-mode): Force visual line motion off. (org-agenda-add-entry-text-maxlines): Improve docstring. @@ -1554,8 +8146,8 @@ 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> * org-agenda.el (org-agenda-get-some-entry-text): New function. - (org-agenda-add-entry-text): Use - `org-agenda-get-some-entry-text'. + (org-agenda-add-entry-text): + Use `org-agenda-get-some-entry-text'. * org.el (org-cycle-separator-lines): Update docstring. (org-cycle-show-empty-lines): Handle negative values for @@ -1583,10 +8175,10 @@ 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> - * org-exp.el (org-export-format-source-code-or-example): Translate - language. + * org-exp.el (org-export-format-source-code-or-example): + Translate language. - * org-src.el (org-src-lang-modes): New variable + * org-src.el (org-src-lang-modes): New variable. (org-edit-src-code): Translate language. * org-exp.el (org-export-format-source-code-or-example): Deal wit @@ -1610,8 +8202,8 @@ 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> - * org-remember.el (org-remember-apply-template): Use - org-icompleting-read. + * org-remember.el (org-remember-apply-template): + Use org-icompleting-read. * org-publish.el (org-publish): Use org-icompleting-read. @@ -1619,11 +8211,11 @@ (org-insert-columns-dblock): Use org-icompleting-read. * org-colview-xemacs.el (org-columns-edit-value) - (org-columns-new, org-insert-columns-dblock): Use - org-icompleting-read. + (org-columns-new, org-insert-columns-dblock): + Use org-icompleting-read. - * org-attach.el (org-attach-delete-one, org-attach-open): Use - org-icompleting-read. + * org-attach.el (org-attach-delete-one, org-attach-open): + Use org-icompleting-read. 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> @@ -1632,8 +8224,8 @@ (org-org-menu): Add a menu entry for the new bug reporter. (org-submit-bug-report): New command. - * org-list.el (org-hierarchical-checkbox-statistics): Improve - docstring. + * org-list.el (org-hierarchical-checkbox-statistics): + Improve docstring. * org.el (org-emphasis-regexp-components): Add "`" to set of pre-emphasis characters. @@ -1642,16 +8234,16 @@ package. (org-export-latex-emphasis-alist): Use \st for strikethough. - * org-exp-blocks.el (org-export-blocks-preprocess): Use - `indent-code-rigidly' to indent. + * org-exp-blocks.el (org-export-blocks-preprocess): + Use `indent-code-rigidly' to indent. - * org-agenda.el (org-agenda-get-restriction-and-command): Remove - properties only if MATCH really is a string. + * org-agenda.el (org-agenda-get-restriction-and-command): + Remove properties only if MATCH really is a string. 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> - * org-latex.el (org-export-latex-packages-alist): Fix - customization type. + * org-latex.el (org-export-latex-packages-alist): + Fix customization type. * org.el (org-create-formula-image): Also use `org-export-latex-packages-alist'. @@ -1664,8 +8256,8 @@ * org.el (org-fast-tag-selection): Avoid text properties on tags in the alist. - * org-agenda.el (org-agenda-get-restriction-and-command): Avoid - text properties on the match element. + * org-agenda.el (org-agenda-get-restriction-and-command): + Avoid text properties on the match element. 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> @@ -1689,8 +8281,8 @@ 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> - * org.el (org-export-html-special-string-regexps): Definition - moved into org.el. + * org.el (org-export-html-special-string-regexps): + Definition moved into org.el. * org-exp.el (org-export-preprocess-apply-macros): Allow newlines in macro calls. @@ -1700,8 +8292,8 @@ * org-latex.el (org-export-latex-listings) (org-export-latex-listings-langs): New options. - * org-exp.el (org-export-format-source-code-or-example): Use - listing package if requested by the user. + * org-exp.el (org-export-format-source-code-or-example): + Use listing package if requested by the user. 2009-09-02 Bastien Guerry <bzg@altern.org> @@ -1714,7 +8306,7 @@ the markup is src or example. * org-agenda.el (org-agenda-skip-scheduled-if-deadline-is-shown): - New option + New option. (org-agenda-get-day-entries): Remember deadline results and pass them on into the function getting the scheduling information. (org-agenda-get-scheduled): Accept deadline results as parameters @@ -1724,8 +8316,8 @@ * org.el (org-insert-heading): When respecting content, do not convert current line to headline. - * org-clock.el (org-clock-save-markers-for-cut-and-paste): Also - cheeeeeck the hd marker + * org-clock.el (org-clock-save-markers-for-cut-and-paste): + Also cheeeeeck the hd marker. (org-clock-in): Also set the hd marker. (org-clock-out): Also set the hd marker. (org-clock-cancel): Reset markers. @@ -1735,13 +8327,13 @@ * org-faces.el (org-agenda-clocking): New face. * org-agenda.el (org-agenda-mark-clocking-task): New function. - (org-finalize-agenda): call `org-agenda-mark-clocking-task'. + (org-finalize-agenda): Call `org-agenda-mark-clocking-task'. * org.el (org-modules): Add org-track.el. * org-agenda.el (org-agenda-bulk-marked-p): New function. - (org-agenda-bulk-mark, org-agenda-bulk-unmark): Use - `org-agenda-bulk-marked-p'. + (org-agenda-bulk-mark, org-agenda-bulk-unmark): + Use `org-agenda-bulk-marked-p'. (org-agenda-bulk-toggle): New command. 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> @@ -1807,8 +8399,8 @@ 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.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'. @@ -1826,8 +8418,8 @@ (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-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. @@ -1870,8 +8462,8 @@ 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. + * 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> @@ -1913,8 +8505,8 @@ * 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-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. @@ -1947,9 +8539,9 @@ 2009-08-06 Bastien Guerry <bzg@altern.org> * org.el (org-make-link-regexps): Don't exclude parentheses from - `org-plain-link-re' + `org-plain-link-re'. (org-cycle-internal-local): When locally cycling, switch directly - from CHILDREN to FOLDED if there is no subtree + from CHILDREN to FOLDED if there is no subtree. (org-cycle): Update the docstring to document the new behavior of `org-cycle-internal-local'. @@ -1960,8 +8552,8 @@ 2009-08-06 Bastien Guerry <bzg@altern.org> - * org-protocol.el (org-protocol-default-template-key): New - option. + * 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'. @@ -1989,8 +8581,8 @@ * 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-timer-show-remaining-time, org-timer-set-timer): + New functions. * org-clock.el (org-show-notification): Update the docstring. @@ -2059,8 +8651,8 @@ * 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.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> @@ -2087,8 +8679,8 @@ * 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. + * 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> @@ -2134,8 +8726,8 @@ * 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-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. @@ -2152,8 +8744,8 @@ * 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-footnote-new, org-footnote-delete): + Call `org-footnote-auto-adjust-maybe'. * org.el (org-startup-options): Add new footnote-related keywords. @@ -2316,16 +8908,16 @@ 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-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-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. @@ -2357,8 +8949,8 @@ 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> - * org-icalendar.el (org-icalendar-include-bbdb-anniversaries): New - option. + * 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. @@ -2380,8 +8972,8 @@ * 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'. + * org-exp.el (org-export-format-source-code-or-example): + Run `org-src-mode-hook'. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -2398,8 +8990,8 @@ * 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-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. @@ -2422,8 +9014,8 @@ 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-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. @@ -2458,8 +9050,8 @@ * 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.el (org-clock-sum): Accept lists and strings as tstart + and tend. (org-clock-sum-current-item): Optional argument TSTART, pass it to org-clock-sum. (org-clock-get-sum-start): New function. @@ -2499,35 +9091,35 @@ (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.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-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-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-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. + (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-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. @@ -2540,24 +9132,24 @@ (org-set-font-lock-defaults): Call the new fontification function. - * org-faces.el (org-meta-line): New face + * 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-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-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. @@ -2580,8 +9172,8 @@ * org-latex.el (org-export-latex-low-levels): Fix customization type. - * org.el (org-priority, org-shiftup, org-shiftdown): Disable - priority commands. + * org.el (org-priority, org-shiftup, org-shiftdown): + Disable priority commands. * org-agenda.el (org-agenda-priority): Disable priority commands. @@ -2596,17 +9188,17 @@ * 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-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-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-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-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. @@ -2669,8 +9261,8 @@ * 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-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'. @@ -2704,7 +9296,7 @@ 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> - * org-icalendar.el (org-icalendar-include-todo): New allowedvalue + * org-icalendar.el (org-icalendar-include-todo): New allowed value `unblocked'. (org-print-icalendar-entries): Respect the new value of `org-icalendar-include-todo'. @@ -2753,8 +9345,8 @@ * 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.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 @@ -2770,14 +9362,14 @@ 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> * org-exp.el (org-export, org-export-visible): Support ASCII - export to buffer + 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): Move here from org-checklist.el. - (org-reset-checkbox-state-subtree): Call - `org-reset-checkbox-state-subtree'. + (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. @@ -2845,11 +9437,11 @@ * 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-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'. + * org-latex.el (org-export-as-pdf): + Use `org-latex-to-pdf-process'. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -2857,8 +9449,8 @@ * 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-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 @@ -2883,8 +9475,8 @@ * 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-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> @@ -2892,13 +9484,13 @@ * 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.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-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. @@ -2911,8 +9503,8 @@ 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-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 @@ -3093,15 +9685,15 @@ * 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. + (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.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. @@ -3125,7 +9717,7 @@ * org-mouse.el: XEmacs compatibility fixes. - * org.el (org-modules): Add org-inlinetasks.el + * 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. @@ -3135,7 +9727,7 @@ * org.el (org-emphasis-regexp-components): Allow braces in emphasis pre and post match. - * org-footnote.el (org-footnote-normalize): When only dorting, do + * org-footnote.el (org-footnote-normalize): When only sorting, do not insert inline notes at the end. * org.el (org-require-autoloaded-modules): Add org-docbook.el. @@ -3204,8 +9796,8 @@ * 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-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. @@ -3217,16 +9809,16 @@ (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. + (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.el (org-backward-sentence, org-forward-sentence): + New commands. - * org-colview.el (org-colview-initial-truncate-line-value): New - variable. + * 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'. @@ -3282,11 +9874,11 @@ 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-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-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 @@ -3301,8 +9893,8 @@ * org-latex.el (org-export-latex-preprocess): Implement the centering markup. - * org-exp.el (org-export-mark-blockquote-verse-center): Rename - from `org-export-mark-blockquote-and-verse'. + * org-exp.el (org-export-mark-blockquote-verse-center): + Rename from `org-export-mark-blockquote-and-verse'. (org-export-as-html): Implement the centering markup. * org-latex.el (org-export-latex-tables): Fix vertical @@ -3328,16 +9920,16 @@ 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> - * org-latex.el (org-export-latex-emphasis-alist): Better - defaults for verbose emphasis. + * 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-agenda-date-later-hours, org-agenda-date-earlier-hours): + New commands. * org.el (org-timestamp-change): Move end-time along with start time. @@ -3369,8 +9961,8 @@ (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. + * org-latex.el (org-export-latex-tables): + Use `org-split-string', for Emacs 21 compatibility. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -3383,13 +9975,13 @@ (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-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-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. @@ -3408,8 +10000,8 @@ `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. + (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> @@ -3426,8 +10018,8 @@ 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 + * 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. @@ -3446,8 +10038,8 @@ * 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-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. @@ -3466,8 +10058,8 @@ (org-agenda-fontify-priorities): Rename from org-fontify-priorities. - * org.el (org-set-font-lock-defaults): Call - `org-font-lock-add-priority-faces'. + * 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. @@ -3524,8 +10116,8 @@ * 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.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) @@ -3539,15 +10131,15 @@ * 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. + (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-format-agenda-item): + Honor `org-agenda-search-headline-for-time'. * org-table.el (orgtbl-self-insert-command): Cluster undo for 20 characters. @@ -3569,9 +10161,9 @@ (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-export-latex.el: Rename to org-latex.el. - * org-latex.el: renamed from org-export-latex.el. + * org-latex.el: Rename from org-export-latex.el. * org.el (orgstruct++-mode): New function. (turn-on-orgstruct++): Call `orgstruct++-mode'. @@ -3618,8 +10210,8 @@ 2009-02-19 Carsten Dominik <dominik@science.uva.nl> - * org.el (org-block-todo-from-children-or-siblings): Use - `org-up-heading-all' so that this will work correctly with hidden + * org.el (org-block-todo-from-children-or-siblings): + Use `org-up-heading-all' so that this will work correctly with hidden property drawers and entries. (org-end-of-line, org-beginning-of-line): Make prefix arg work, by falling back to normal, default command. @@ -3700,8 +10292,8 @@ * org-exp.el (org-export-html-footnotes-section): Make the div id consistent. - * org-export-latex.el (org-export-latex-classes): Remove - paper size option from LaTeX classes. + * org-export-latex.el (org-export-latex-classes): + Remove paper size option from LaTeX classes. 2009-01-31 Carsten Dominik <carsten.dominik@gmail.com> @@ -3784,8 +10376,8 @@ * org-agenda.el (org-agenda-todo): Call `org-todo' interactively, to get real errors from the blocker hook. - * org.el (org-shiftselect-error, org-call-for-shift-select): New - functions. + * org.el (org-shiftselect-error, org-call-for-shift-select): + New functions. (org-set-visibility-according-to-property): Turn off the setting of `org-show-entry-below', to avoid overruling a FOLDED visibility property. @@ -3802,13 +10394,13 @@ * org-footnote.el (org-footnote-normalize): Remove unnecessary variable. - (org-insert-footnote-reference-near-definition): Remove - unnecessary let form. + (org-insert-footnote-reference-near-definition): + Remove unnecessary let form. 2009-01-26 Carsten Dominik <dominik@science.uva.nl> - * org-export-latex.el (org-export-as-latex): Call - `org-export-latex-first-lines' with OPT-PLIST as a parameter. + * org-export-latex.el (org-export-as-latex): + Call `org-export-latex-first-lines' with OPT-PLIST as a parameter. (org-export-latex-first-lines): New parameter OPT-PLIST. * org.el (org-yank): Tell `delete-selection-mode' about @@ -3816,8 +10408,8 @@ * org-faces.el (org-clock-overlay): Fix face definition. - * org-export-latex.el (org-export-latex-first-lines): Pass - timestamp and footnote parameters to the preprocessor. + * org-export-latex.el (org-export-latex-first-lines): + Pass timestamp and footnote parameters to the preprocessor. * org-exp.el (org-export-remove-timestamps): Do not remove time stamps inside tables. @@ -3826,8 +10418,8 @@ * org-exp.el (org-export-as-html): Turn \par into a paragraph. - * org.el (org-agenda-tags-todo-honor-ignore-options): Declare - variable. + * org.el (org-agenda-tags-todo-honor-ignore-options): + Declare variable. * org-table.el (org-table-insert-hline): Fix typo in fuction call to `backward-char'. @@ -3835,21 +10427,21 @@ * org-exp.el (org-export-as-html): Remove the initial space from colon examples. - * org.el (org-scan-tags): Call - `org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item'. + * org.el (org-scan-tags): + Call `org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item'. - * org-agenda.el (org-agenda-todo-list, org-agenda-match-view): New - customization groups. + * org-agenda.el (org-agenda-todo-list, org-agenda-match-view): + New customization groups. (org-agenda-tags-todo-honor-ignore-options): New option. (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item): New function. - (org-agenda-get-todos): Use - `org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item'. + (org-agenda-get-todos): + Use `org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item'. 2009-01-25 Carsten Dominik <carsten.dominik@gmail.com> - * org-exp.el (org-export-format-source-code-or-example): Escape - HTML characters also in examples that anre not treated with + * org-exp.el (org-export-format-source-code-or-example): + Escape HTML characters also in examples that anre not treated with htmlize. Also, just switch to EXAMPLE processing if we do not have a good version of htmlize. @@ -3905,8 +10497,8 @@ 2009-01-25 Carsten Dominik <carsten.dominik@gmail.com> - * org-export-latex.el (org-export-latex-quotation-marks): Use - `org-if-unprotected-1'. + * org-export-latex.el (org-export-latex-quotation-marks): + Use `org-if-unprotected-1'. (org-export-latex-set-initial-vars): Check for class definition in property. @@ -3916,8 +10508,8 @@ * org-compat.el (org-count-lines): New function. - * org-exp.el (org-export-format-source-code-or-example): Handle - switches related to text areas. + * org-exp.el (org-export-format-source-code-or-example): + Handle switches related to text areas. * org.el (org-activate-footnote-links): Don't allow match inside a link. @@ -3952,17 +10544,17 @@ * org.el (org-image-file-name-regexp, org-file-image-p): Allow the list of extensions to be a parameter. - * org-exp.el (org-export-html-inline-image-extensions): New - variable. + * org-exp.el (org-export-html-inline-image-extensions): + New variable. - * org-agenda.el (org-prepare-agenda): Use - `org-agenda-block-separator'. + * org-agenda.el (org-prepare-agenda): + Use `org-agenda-block-separator'. (org-agenda-block-separator): New option. 2009-01-25 Carsten Dominik <carsten.dominik@gmail.com> - * org-export-latex.el (org-export-latex-tables): Call - `org-table-clean-before-export' with the new optional argument. + * org-export-latex.el (org-export-latex-tables): + Call `org-table-clean-before-export' with the new optional argument. * org-exp.el (org-table-clean-before-export): New optional parameter MAYBE-QUOTED, allows for quoted characters like \# in @@ -3973,8 +10565,8 @@ * org-plot.el (org-plot/gnuplot): Fix text-ind parameter for histograms. - * org-colview.el (org-colview-construct-allowed-dates): Better - error catching when a date/time property does not have allowed + * org-colview.el (org-colview-construct-allowed-dates): + Better error catching when a date/time property does not have allowed values defined. * org-colview-xemacs.el (org-colview-construct-allowed-dates): @@ -4003,8 +10595,8 @@ 2009-01-25 Carsten Dominik <carsten.dominik@gmail.com> - * org-compat.el (org-fit-window-to-buffer): Use - `window-full-width-p'. + * org-compat.el (org-fit-window-to-buffer): + Use `window-full-width-p'. * org-export-latex.el (org-export-latex-fixed-width): Enforce the space after the colon in short examples. @@ -4060,8 +10652,8 @@ (org-timer-stop): New command. (org-timer-seconds): Return correct time when timer is paused. (org-timer-mode-line-timer): New variable. - (org-timer-set-mode-line, org-timer-update-mode-line): New - functions. + (org-timer-set-mode-line, org-timer-update-mode-line): + New functions. * org.el (org-insert-heading): Handle new value `auto' for `org-blank-before-new-entry'. @@ -4110,19 +10702,19 @@ * org-exp.el (org-export-preprocess-string): Remove clock lines and timestamps already in the preprocesor. - (org-export-remove-timestamps, org-export-remove-clock-lines): New - functions. + (org-export-remove-timestamps, org-export-remove-clock-lines): + New functions. (org-export-as-ascii, org-export-as-html): Add the timestamps parameter to the preprocessor parameter list. * org-list.el (org-list-parse-list): Parse for checkboxes. (org-list-to-generic): Introduce and handle new parameters :cbon and :cboff. - (org-list-to-latex, org-list-to-html, org-list-to-texinfo): Add - optional parameter PARAMS. + (org-list-to-latex, org-list-to-html, org-list-to-texinfo): + Add optional parameter PARAMS. - * org-export-latex.el (org-export-latex-special-chars): Fix - problems with interpreting dollar signs. + * org-export-latex.el (org-export-latex-special-chars): + Fix problems with interpreting dollar signs. (org-inside-latex-math-p): New function. (org-export-latex-preprocess): Protect all the math fragments. @@ -4134,8 +10726,8 @@ * org-agenda.el (org-run-agenda-series): Have series options set when finalizing the agenda. - * org-exp.el (org-export-format-source-code-or-example): Protect - the converted examples. + * org-exp.el (org-export-format-source-code-or-example): + Protect the converted examples. * org.el (org-set-regexps-and-options): Fix the regexp `org-complex-heading-regexp'. @@ -4179,8 +10771,8 @@ * org-macs.el (org-re): Handle the [:word:] class. - * org-exp.el (org-export-preprocess-string): Call - `org-export-protect-colon-examples'. + * org-exp.el (org-export-preprocess-string): + Call `org-export-protect-colon-examples'. (org-export-protect-colon-examples): Rename from `org-export-protect-examples', and scope limited to lines starting with a colon. @@ -4210,8 +10802,8 @@ (org-export-latex-preprocess): Treat multiple references to a footnote. - * org-exp.el (org-export-preprocess-string): Call - `org-footnote-normalize'. + * org-exp.el (org-export-preprocess-string): + Call `org-footnote-normalize'. (org-export-as-ascii, org-export-as-html): Pass footnote variable to preprocessor. (org-export-as-html): Treat multiple references to a footnote. @@ -4222,8 +10814,8 @@ links. * org.el (org-bracket-link-analytic-regexp++): New variable. - (org-make-link-regexps): Initialize - `org-bracket-link-analytic-regexp++'. + (org-make-link-regexps): + Initialize `org-bracket-link-analytic-regexp++'. (org-store-link): Implement special case in edit-src buffer. (org-insert-link): No use of ide to insert stored links. (org-link-search): Implement special case for coderefs. @@ -4251,8 +10843,8 @@ 2009-01-16 Glenn Morris <rgm@gnu.org> - * org-mouse.el (org-mouse-show-context-menu): Use - mouse-menu-major-mode-map, if defined, rather than the obsolete + * org-mouse.el (org-mouse-show-context-menu): + Use mouse-menu-major-mode-map, if defined, rather than the obsolete mouse-major-mode-menu. 2008-12-23 Carsten Dominik <dominik@science.uva.nl> @@ -4277,8 +10869,8 @@ 2008-12-20 Carsten Dominik <carsten.dominik@gmail.com> - * org.el (org-get-refile-targets, org-refile-get-location): Use - expanded file name to improve comparison. + * org.el (org-get-refile-targets, org-refile-get-location): + Use expanded file name to improve comparison. 2008-12-20 Carsten Dominik <carsten.dominik@gmail.com> @@ -4290,12 +10882,12 @@ * org-export-latex.el (org-export-latex-links): Fix bug with undefined label. - * org-table.el (org-table-get-specials): Set - `org-table-current-last-data-line'. + * org-table.el (org-table-get-specials): + Set `org-table-current-last-data-line'. (org-table-current-last-data-line): New variable. (org-table-insert-column, org-table-delete-column) - (org-table-move-column, org-table-fix-formulas): Call - `org-table-fix-formulas' a second time to fix the $LR references. + (org-table-move-column, org-table-fix-formulas): + Call `org-table-fix-formulas' a second time to fix the $LR references. (org-table-get-specials): Add the $LR references to the tables. (org-table-get-formula): Do not offer last-row names as LHS of formulas. @@ -4349,8 +10941,8 @@ * org.el (org-refile): Avoid refiling to within the region to be refiled. - * org-export-latex.el (org-export-latex-special-chars): Replace - special characters also in tables. + * org-export-latex.el (org-export-latex-special-chars): + Replace special characters also in tables. * org-agenda.el (org-agenda-change-all-lines): New argument FORCE-TAGS. @@ -4398,8 +10990,8 @@ (org-export-as-latex): Pass RBEG to `org-export-latex-first-lines'. (org-export-latex-make-header): Add some hard space after the table of contents. - (org-export-latex-first-lines): Accept RBEG argument. Mark - exported text so that it will be excuded in further steps. + (org-export-latex-first-lines): Accept RBEG argument. + Mark exported text so that it will be excuded in further steps. * org-table.el (org-table-get-specials): Make @0 reference the last line in a table. @@ -4419,8 +11011,8 @@ * org-exp.el (org-export-html-style-default): Add style definitions for the figure div. - (org-export-preprocess-string, org-export-as-html): Implement - attribute, label, and caption handling. + (org-export-preprocess-string, org-export-as-html): + Implement attribute, label, and caption handling. (org-export-attach-captions-and-attributes): New function. (org-export-html-format-image): New function. (org-format-org-table-html): Implement attribute, label, and @@ -4508,8 +11100,8 @@ * org-w3m.el (w3m-minor-mode-hook): Also add the special copy command to the `w3m-minor-mode-map'. - * org-archive.el (org-archive-to-archive-sibling): Protect - `this-command' to avoid appending kills during archiving. + * org-archive.el (org-archive-to-archive-sibling): + Protect `this-command' to avoid appending kills during archiving. * org-exp.el (org-export-with-priority): New variable. (org-export-add-options-to-plist): Use `org-export-plist-vars' @@ -4537,8 +11129,8 @@ 2008-12-07 Carsten Dominik <carsten.dominik@gmail.com> * org.el (org-tags-exclude-from-inheritance): New option. - (org-tag-inherit-p, org-remove-uniherited-tags): Respect - `org-tags-exclude-from-inheritance'. + (org-tag-inherit-p, org-remove-uniherited-tags): + Respect `org-tags-exclude-from-inheritance'. * org-agenda.el (org-agenda-show-inherited-tags): New option. (org-format-agenda-item): Add inherited tags to the agenda line @@ -4596,8 +11188,8 @@ accidentially overwritten by last commit to Emacs. * org.el (org-outline-path-complete-in-steps): New option. - (org-refile-get-location): Honor - `org-outline-path-complete-in-steps'. + (org-refile-get-location): + Honor `org-outline-path-complete-in-steps'. (org-agenda-change-all-lines, org-tags-sparse-tree) (org-time-string-to-absolute, org-small-year-to-year) (org-link-escape): Re-apply changes accidentially overwritten @@ -4620,8 +11212,8 @@ line before the first headline to always be included. This is to not miss a commented target. - * org-mouse.el (org-mouse-insert-item): Call - `org-indent-to-column' instead of `indent-to', for XEmacs + * org-mouse.el (org-mouse-insert-item): + Call `org-indent-to-column' instead of `indent-to', for XEmacs compatibility. * org.el (org-refile-targets): Fix customize definition so @@ -4644,18 +11236,18 @@ 2008-11-23 Carsten Dominik <carsten.dominik@gmail.com> - * org-remember.el (org-remember-apply-template): Use - `org-substring-no-properties'. + * org-remember.el (org-remember-apply-template): + Use `org-substring-no-properties'. * org-compat.el (org-substring-no-properties): New function. - * org-remember.el (org-remember-apply-template): Use - `org-substring-no-properties' for compatibility. + * org-remember.el (org-remember-apply-template): + Use `org-substring-no-properties' for compatibility. - * org-list.el (org-list-two-spaces-after-bullet-regexp): New - option. - (org-fix-bullet-type): respect - `org-list-two-spaces-after-bullet-regexp'. + * org-list.el (org-list-two-spaces-after-bullet-regexp): + New option. + (org-fix-bullet-type): + Respect `org-list-two-spaces-after-bullet-regexp'. * org-clock.el (org-clock-load): Clean up the code. @@ -4720,8 +11312,8 @@ (org-set-property, org-delete-property) (org-delete-property-globally): Use `org-ido-completing-read'. - * org-remember.el (org-remember-apply-template): Use - `org-ido-completing-read'. + * org-remember.el (org-remember-apply-template): + Use `org-ido-completing-read'. * org-publish.el (org-publish): Use `org-ido-completing-read'. @@ -4729,14 +11321,14 @@ (org-insert-columns-dblock): Use `org-ido-completing-read'. * org-colview-xemacs.el (org-columns-edit-value) - (org-columns-new, org-insert-columns-dblock): Use - `org-ido-completing-read'. + (org-columns-new, org-insert-columns-dblock): + Use `org-ido-completing-read'. - * org-attach.el (org-attach-delete-one, org-attach-open): Use - `org-ido-completing-read'. + * org-attach.el (org-attach-delete-one, org-attach-open): + Use `org-ido-completing-read'. - * org-agenda.el (org-todo-list, org-agenda-filter-by-tag): Use - `org-ido-completing-read'. + * org-agenda.el (org-todo-list, org-agenda-filter-by-tag): + Use `org-ido-completing-read'. * org.el (org-time-today): New function. (org-matcher-time): Use `org-time-today'. Add special treatment @@ -4751,8 +11343,8 @@ 2008-11-23 Carsten Dominik <carsten.dominik@gmail.com> - * org-export-latex.el (org-export-latex-subcontent): Interprete - target aliases as additonal labels. + * org-export-latex.el (org-export-latex-subcontent): + Interprete target aliases as additonal labels. * org-exp.el (org-export-target-aliases): New variable. (org-export-preprocess-string) @@ -4799,8 +11391,8 @@ * org-vm.el (org-vm-follow-link): Require `vm-search'. - * org.el (org-up-heading-safe, org-forward-same-level): Always - call `org-back-to-heading' instead of `outline-back-to-heading'. + * org.el (org-up-heading-safe, org-forward-same-level): + Always call `org-back-to-heading' instead of `outline-back-to-heading'. (org-back-to-heading): New wrapper around outline-back-to-heading, with a useful error message telling where the error happened. @@ -4906,8 +11498,8 @@ * org.el (org-link-abbrev-alist): Improve customization type. - * org-attach.el (org-attach-expand-link, org-attach-expand): New - functions. + * org-attach.el (org-attach-expand-link, org-attach-expand): + New functions. * org-agenda.el (org-agenda-get-progress): Rename from `org-get-closed'. Implement searching for state changes as well. @@ -4946,8 +11538,8 @@ * org-exp.el (org-export-as-html): Make sure that <hr/> is between paragraphs, not inside. - * org.el (org-todo): Quote - `org-agenda-headline-snapshot-before-repeat'. + * org.el (org-todo): + Quote `org-agenda-headline-snapshot-before-repeat'. * org-exp.el (org-export-as-html): Fully process link descriptions. (org-export-html-format-desc): New function. @@ -4962,14 +11554,14 @@ really, a preliminary and incomplete version was present earlier, but not used). - * org.el (org-fast-todo-selection, org-fast-tag-selection): Use - `org-fit-window-to-buffer'. + * org.el (org-fast-todo-selection, org-fast-tag-selection): + Use `org-fit-window-to-buffer'. * org-exp.el (org-export): Use `org-fit-window-to-buffer'. * org-agenda.el (org-agenda-get-restriction-and-command) - (org-fit-agenda-window, org-agenda-convert-date): Use - `org-fit-window-to-buffer'. + (org-fit-agenda-window, org-agenda-convert-date): + Use `org-fit-window-to-buffer'. * org-exp.el (org-export-as-html): Process href links through `org-export-html-format-href'. @@ -4992,8 +11584,8 @@ (org-export-html-style-default): Mark style definitions as unparsed CDATA. - * org-publish.el (org-publish-validate-link): Function - re-introduced. + * org-publish.el (org-publish-validate-link): + Function re-introduced. 2008-11-12 Charles Sebold <csebold@gmail.com> @@ -5031,7 +11623,7 @@ * org-agenda.el (org-agenda-remove-marked-text): New function. (org-agenda-mark-filtered-text) (org-agenda-unmark-filtered-text): New functions. - (org-write-agenda): Remove fltered text. + (org-write-agenda): Remove filtered text. * org.el (org-make-tags-matcher): Give access to TODO "property" without speed penalty. @@ -5128,7 +11720,7 @@ * org.el (org-insert-heading-respect-content): Force heading creation. - (org-insert-heading): keep the folding state of the heading before + (org-insert-heading): Keep the folding state of the heading before the inserted one. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> @@ -5138,8 +11730,8 @@ 2008-10-26 Bastien Guerry <bzg@altern.org> - * org-export-latex.el (org-export-latex-classes): Add - \usepackage{graphicx} to the default list of packages. + * org-export-latex.el (org-export-latex-classes): + Add \usepackage{graphicx} to the default list of packages. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> @@ -5153,8 +11745,8 @@ (org-add-log-note): Mask prefix argument when immediately storing the note. - * org-agenda.el (org-agenda-filter-effort-default-operator): New - option. + * org-agenda.el (org-agenda-filter-effort-default-operator): + New option. 2008-10-26 James TD Smith <ahktenzero@mohorovi.cc> @@ -5187,8 +11779,8 @@ 2008-10-26 Carsten Dominik <dominik@science.uva.nl> - * org.el (org-add-log-setup): Respect - `org-log-state-notes-insert-after-drawers'. + * org.el (org-add-log-setup): + Respect `org-log-state-notes-insert-after-drawers'. (org-log-state-notes-insert-after-drawers): New option. (org-todo-trigger-tag-changes): New function. (org-todo): Call `org-todo-trigger-tag-changes'. @@ -5199,7 +11791,7 @@ immediately after the scheduling keywords. * org-clock.el (org-clock-in-switch-to-state): Allow this to be a - function + function. (org-clock-in): If `org-clock-in-switch-to-state' is a function, call it with the current todo state to get the state to switch to when clocking in. @@ -5223,8 +11815,8 @@ 2008-10-26 Carsten Dominik <dominik@science.uva.nl> - * org-export-latex.el (org-export-latex-preprocess): Improve - quoting of LaTeX environments. + * org-export-latex.el (org-export-latex-preprocess): + Improve quoting of LaTeX environments. 2008-10-19 Eli Zaretskii <eliz@gnu.org> @@ -5279,8 +11871,8 @@ * org-attach.el (org-attach-auto-tag): New option. (org-attach-tag, org-attach-untag): New functions. - (org-attach-attach, org-attach-new, org-attach-sync): Call - `org-attach-tag'. + (org-attach-attach, org-attach-new, org-attach-sync): + Call `org-attach-tag'. (org-attach-delete): Call `org-attach-untag'. * org-table.el (orgtbl-self-insert-command): Make this work for @@ -5307,8 +11899,8 @@ * org-exp.el (org-infile-export-plist): Put the content of #+LATEX_HEADER: into the property :latex-header-extra. - * org-colview.el (org-columns-get-format-and-top-level): Remove - resetting the marker. + * org-colview.el (org-columns-get-format-and-top-level): + Remove resetting the marker. * org-colview-xemacs.el (org-columns-get-format-and-top-level): Remove resetting the marker. @@ -5320,8 +11912,8 @@ * org-exp.el (org-infile-export-plist): Allow multiple STYLE lines. * org.el (org-entry-get-multivalued-property) - (org-entry-protect-space, org-entry-restore-space): New - functions. + (org-entry-protect-space, org-entry-restore-space): + New functions. (org-file-apps-defaults-macosx): Let postscript files be opened by preview. (org-time-stamp-inactive): Call `org-time-stamp'. @@ -5356,8 +11948,8 @@ * org-bbdb.el (org-bbdb-anniversaries): Require bbdb in `org-bbdb-anniversaries'. - * org.el (org-get-next-sibling, org-forward-same-level): New - functions, similar to the outline versions, but invisible headings + * org.el (org-get-next-sibling, org-forward-same-level): + New functions, similar to the outline versions, but invisible headings are OK. 2008-10-12 Bastien Guerry <bzg@altern.org> @@ -5402,7 +11994,7 @@ line. * org.el (org-get-refile-targets): Replace links with their - descriptions + descriptions. (org-imenu-get-tree): Replace links with their descriptions. * org-remember.el (org-remember-apply-template): Add a new @@ -5411,7 +12003,7 @@ * org.el (org-add-log-setup): Skip over drawers (properties, clocks etc) when adding notes. - * org-agenda.el (org-agenda-get-closed): show durations of clocked + * org-agenda.el (org-agenda-get-closed): Show durations of clocked items as well as the start and end times. * org-compat.el (org-get-x-clipboard-compat): Add a compat @@ -5423,7 +12015,7 @@ set-text-properties to remove text properties from the clipboard value. - * lisp/org-clock.el (org-update-mode-line): Support limiting the + * org-clock.el (org-update-mode-line): Support limiting the modeline clock string, and display the full todo value in the tooltip. Set a local keymap so mouse-3 on the clock string goes to the currently clocked task. @@ -5437,7 +12029,7 @@ 2008-10-12 Bastien Guerry <bzg@altern.org> - * org-export-latex.el (org-export-latex-tables): protect exported + * org-export-latex.el (org-export-latex-tables): Protect exported tables from further special chars conversion. (org-export-latex-preprocess): Preserve LaTeX environments. (org-list-parse-list): Parse descriptive lists. @@ -5446,7 +12038,7 @@ (org-quote-chars): Remove. (org-export-latex-keywords-maybe): Use `replace-regexp-in-string'. (org-export-latex-list-beginning-re): Rename to - `org-list-beginning-re' + `org-list-beginning-re'. (org-list-item-begin): Rename to `org-list-item-beginning'. 2008-10-12 Eric Schulte <schulte.eric@gmail.com> @@ -5482,15 +12074,15 @@ (org-entries-lessp): Implement sorting by TODO state. (org-cmp-todo-state): New defsubst. - * org-colview.el (org-colview-construct-allowed-dates): New - function. - (org-columns-next-allowed-value): Use - `org-colview-construct-allowed-dates'. + * org-colview.el (org-colview-construct-allowed-dates): + New function. + (org-columns-next-allowed-value): + Use `org-colview-construct-allowed-dates'. - * org-colview-xemacs.el (org-colview-construct-allowed-dates): New - function. - (org-columns-next-allowed-value): Use - `org-colview-construct-allowed-dates'. + * org-colview-xemacs.el (org-colview-construct-allowed-dates): + New function. + (org-columns-next-allowed-value): + Use `org-colview-construct-allowed-dates'. * org.el (org-protect-slash): New function. (org-get-refile-targets): Use `org-protect-slash'. @@ -5498,8 +12090,8 @@ * org-agenda.el (org-global-tags-completion-table): New variable. * org-exp.el (org-export-handle-export-tags): New function. - (org-export-preprocess-string): Call - `org-export-handle-export-tags'. + (org-export-preprocess-string): + Call `org-export-handle-export-tags'. * org-publish.el (org-publish-expand-components): Function removed. (org-publish-expand-projects): Allow components to have components. @@ -5509,8 +12101,8 @@ (org-yank-and-fold-if-subtree): New function. * org-agenda.el (org-agenda-todayp): New function. - (org-agenda-get-deadlines, org-agenda-get-scheduled): Use - `org-agenda-todayp'. + (org-agenda-get-deadlines, org-agenda-get-scheduled): + Use `org-agenda-todayp'. * org.el (org-insert-heading-respect-content) (org-insert-todo-heading-respect-content): New commands. @@ -5618,11 +12210,11 @@ * org-agenda.el (org-agenda-align-tags): Fix bug with malformed face property. - * org-colview.el (org-columns-display-here): Use - `org-columns-modify-value-for-display-function'. + * org-colview.el (org-columns-display-here): + Use `org-columns-modify-value-for-display-function'. - * org-colview-xemacs.el (org-columns-display-here): Use - `org-columns-modify-value-for-display-function'. + * org-colview-xemacs.el (org-columns-display-here): + Use `org-columns-modify-value-for-display-function'. * org.el (org-columns-modify-value-for-display-function): New option. @@ -5679,14 +12271,14 @@ 2008-07-24 Carsten Dominik <dominik@science.uva.nl> - * org-exp.el (org-export-region-as-html, org-export-as-html): Make - sure that calls from `org-export-region-as-html' do not do the + * org-exp.el (org-export-region-as-html, org-export-as-html): + Make sure that calls from `org-export-region-as-html' do not do the special check for a subtree. * org-agenda.el (org-batch-store-agenda-views): Fix parsing bug. - * org.el (org-open-file): Use - `org-open-directory-means-index-dot-org'. + * org.el (org-open-file): + Use `org-open-directory-means-index-dot-org'. (org-open-directory-means-index-dot-org): New option. * org.el (org-make-link-string): Remove link attributes from @@ -5702,8 +12294,8 @@ * org.el (org-narrow-to-subtree): Do not include the final newline into the narrowed region. - * org-agenda.el (org-agenda-custom-commands-local-options): Fix - bug with user-define skipping condition. + * org-agenda.el (org-agenda-custom-commands-local-options): + Fix bug with user-define skipping condition. * org-agenda.el (org-agenda-get-restriction-and-command): Fix typo. @@ -5722,8 +12314,8 @@ * org-publish.el (org-publish-find-title): Bug fix. (org-publish-org-index): Implement new :index-style option. - * org-publish.el (org-publish-timestamp-filename): Use - SHA1-encoded file names in the timestamp directory. + * org-publish.el (org-publish-timestamp-filename): + Use SHA1-encoded file names in the timestamp directory. * org-publish.el (org-publish-needed-p): Be verbose about files published and files skipped. @@ -5781,7 +12373,7 @@ (org-map-entries): Make sure org-agenda-archives-mode is nil. (org-agenda-files): Functionality of second arg changed. - * org-agenda.el (org-agenda-archives-mode): New variable + * org-agenda.el (org-agenda-archives-mode): New variable. (org-write-agenda, org-prepare-agenda, org-agenda-list) (org-search-view, org-todo-list, org-tags-view) (org-agenda-list-stuck-projects): Call `org-agenda-files' with @@ -5865,8 +12457,8 @@ `org-diary-to-ical-string' out of the loop, and kill the buffer afterwords. - * org-remember.el (org-remember-visit-immediately): Position - cursor after moving to the note. + * org-remember.el (org-remember-visit-immediately): + Position cursor after moving to the note. (org-remember-apply-template): Use a text property to record the cursor position. (org-remember-handler): Align tags after pasting the note. @@ -5909,8 +12501,8 @@ 2008-06-17 Carsten Dominik <dominik@science.uva.nl> * org-remember.el (org-jump-to-target-location): New variable. - (org-remember-apply-template): Set - `org-remember-apply-template' if requested by template. + (org-remember-apply-template): + Set `org-remember-apply-template' if requested by template. (org-remember-handler): Start an idle timer to jump to remember location. @@ -5960,8 +12552,8 @@ 2008-06-17 Carsten Dominik <dominik@science.uva.nl> - * org-agenda.el (org-agenda-columns-remove-prefix-from-item): New - option. + * org-agenda.el (org-agenda-columns-remove-prefix-from-item): + New option. * org-colview.el (org-agenda-columns-cleanup-item): New function. @@ -6082,11 +12674,11 @@ * org-clock.el (org-clock-display, org-clock-out) (org-update-mode-line): Use `org-time-clocksum-format'. - * org-colview-xemacs.el (org-columns-number-to-string): Use - `org-time-clocksum-format'. + * org-colview-xemacs.el (org-columns-number-to-string): + Use `org-time-clocksum-format'. - * org-colview.el (org-columns-number-to-string): Use - `org-time-clocksum-format'. + * org-colview.el (org-columns-number-to-string): + Use `org-time-clocksum-format'. 2008-06-17 Carsten Dominik <dominik@science.uva.nl> @@ -6114,8 +12706,8 @@ (org-export-preprocess-string): Implement the COMMENT environment. - * org-export-latex.el (org-export-latex-preprocess): Implement - VERSE environment. + * org-export-latex.el (org-export-latex-preprocess): + Implement VERSE environment. 2008-06-17 Carsten Dominik <dominik@science.uva.nl> @@ -6170,8 +12762,8 @@ 2008-06-17 Carsten Dominik <dominik@science.uva.nl> - * org.el (org-remove-double-quotes, org-file-contents): New - functions. + * org.el (org-remove-double-quotes, org-file-contents): + New functions. * org-exp.el (org-infile-export-plist): Also parse the contents of #+SETUPFILE files, recursively. @@ -6180,8 +12772,8 @@ contents of #+SETUPFILE files, recursively. * org-exp.el (org-export-handle-include-files): New function. - (org-export-preprocess-string): Call - `org-export-handle-include-files'. + (org-export-preprocess-string): + Call `org-export-handle-include-files'. * org.el (org-delete-property-globally) (org-delete-property, org-set-property): Ignore case during @@ -6209,8 +12801,8 @@ * org.el (org-set-font-lock-defaults): Make the description tag bold. - * org-exp.el (org-export-as-html, org-close-li): Implement - description lists. + * org-exp.el (org-export-as-html, org-close-li): + Implement description lists. 2008-06-17 Jason Riedy <jason@acm.org> diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el new file mode 100644 index 00000000000..da0e76894f1 --- /dev/null +++ b/lisp/org/ob-C.el @@ -0,0 +1,194 @@ +;;; ob-C.el --- org-babel functions for C and similar languages + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating C code. +;; +;; very limited implementation: +;; - currently only support :results output +;; - not much in the way of error feedback + +;;; Code: +(require 'ob) +(require 'ob-eval) +(require 'cc-mode) + +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) + +(add-to-list 'org-babel-tangle-lang-exts '("c++" . "cpp")) + +(defvar org-babel-default-header-args:C '()) + +(defvar org-babel-C-compiler "gcc" + "Command used to compile a C source code file into an + executable.") + +(defvar org-babel-c++-compiler "g++" + "Command used to compile a c++ source code file into an + executable.") + +(defvar org-babel-c-variant nil + "Internal variable used to hold which type of C (e.g. C or C++) +is currently being evaluated.") + +(defun org-babel-execute:cpp (body params) + "Execute BODY according to PARAMS. This function calls +`org-babel-execute:C'." + (org-babel-execute:C body params)) + +(defun org-babel-execute:c++ (body params) + "Execute a block of C++ code with org-babel. This function is +called by `org-babel-execute-src-block'." + (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) + +(defun org-babel-expand-body:c++ (body params) + "Expand a block of C++ code with org-babel according to it's +header arguments (calls `org-babel-C-expand')." + (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params))) + +(defun org-babel-execute:C (body params) + "Execute a block of C code with org-babel. This function is +called by `org-babel-execute-src-block'." + (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params))) + +(defun org-babel-expand-body:c (body params) + "Expand a block of C code with org-babel according to it's +header arguments (calls `org-babel-C-expand')." + (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params))) + +(defun org-babel-C-execute (body params) + "This function should only be called by `org-babel-execute:C' +or `org-babel-execute:c++'." + (let* ((tmp-src-file (org-babel-temp-file + "C-src-" + (cond + ((equal org-babel-c-variant 'c) ".c") + ((equal org-babel-c-variant 'cpp) ".cpp")))) + (tmp-bin-file (org-babel-temp-file "C-bin-")) + (cmdline (cdr (assoc :cmdline params))) + (flags (cdr (assoc :flags params))) + (full-body (org-babel-C-expand body params)) + (compile + (progn + (with-temp-file tmp-src-file (insert full-body)) + (org-babel-eval + (format "%s -o %s %s %s" + (cond + ((equal org-babel-c-variant 'c) org-babel-C-compiler) + ((equal org-babel-c-variant 'cpp) org-babel-c++-compiler)) + (org-babel-process-file-name tmp-bin-file) + (mapconcat 'identity + (if (listp flags) flags (list flags)) " ") + (org-babel-process-file-name tmp-src-file)) "")))) + ((lambda (results) + (org-babel-reassemble-table + (if (member "vector" (cdr (assoc :result-params params))) + (let ((tmp-file (org-babel-temp-file "c-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file)) + (org-babel-read results)) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) + (org-babel-trim + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) + +(defun org-babel-C-expand (body params) + "Expand a block of C or C++ code with org-babel according to +it's header arguments." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (main-p (not (string= (cdr (assoc :main params)) "no"))) + (includes (or (cdr (assoc :includes params)) + (org-babel-read (org-entry-get nil "includes" t)))) + (defines (org-babel-read + (or (cdr (assoc :defines params)) + (org-babel-read (org-entry-get nil "defines" t)))))) + (mapconcat 'identity + (list + ;; includes + (mapconcat + (lambda (inc) (format "#include %s" inc)) + (if (listp includes) includes (list includes)) "\n") + ;; defines + (mapconcat + (lambda (inc) (format "#define %s" inc)) + (if (listp defines) defines (list defines)) "\n") + ;; variables + (mapconcat 'org-babel-C-var-to-C vars "\n") + ;; body + (if main-p + (org-babel-C-ensure-main-wrap body) + body) "\n") "\n"))) + +(defun org-babel-C-ensure-main-wrap (body) + "Wrap body in a \"main\" function call if none exists." + (if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body) + body + (format "int main() {\n%s\n}\n" body))) + +(defun org-babel-prep-session:C (session params) + "This function does nothing as C is a compiled language with no +support for sessions" + (error "C is a compiled languages -- no support for sessions")) + +(defun org-babel-load-session:C (session body params) + "This function does nothing as C is a compiled language with no +support for sessions" + (error "C is a compiled languages -- no support for sessions")) + +;; helper functions + +(defun org-babel-C-var-to-C (pair) + "Convert an elisp val into a string of C code specifying a var +of the same value." + ;; TODO list support + (let ((var (car pair)) + (val (cdr pair))) + (when (symbolp val) + (setq val (symbol-name val)) + (when (= (length val) 1) + (setq val (string-to-char val)))) + (cond + ((integerp val) + (format "int %S = %S;" var val)) + ((floatp val) + (format "double %S = %S;" var val)) + ((or (characterp val)) + (format "char %S = '%S';" var val)) + ((stringp val) + (format "char %S[%d] = \"%s\";" + var (+ 1 (length val)) val)) + (t + (format "u32 %S = %S;" var val))))) + + +(provide 'ob-C) + +;; arch-tag: 8f49e462-54e3-417b-9a8d-423864893b37 + +;;; ob-C.el ends here diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el new file mode 100644 index 00000000000..1f4fd87b0a3 --- /dev/null +++ b/lisp/org/ob-R.el @@ -0,0 +1,303 @@ +;;; ob-R.el --- org-babel functions for R code evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research, R, statistics +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating R code + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function orgtbl-to-tsv "org-table" (table params)) +(declare-function R "ext:essd-r" (&optional start-args)) +(declare-function inferior-ess-send-input "ext:ess-inf" ()) +(declare-function ess-make-buffer-current "ext:ess-inf" ()) +(declare-function ess-eval-buffer "ext:ess-inf" (vis)) +(declare-function org-number-sequence "org-compat" (from &optional to inc)) + +(defconst org-babel-header-arg-names:R + '(width height bg units pointsize antialias quality compression + res type family title fonts version paper encoding + pagecentre colormodel useDingbats horizontal) + "R-specific header arguments.") + +(defvar org-babel-default-header-args:R '()) + +(defvar org-babel-R-command "R --slave --no-save" + "Name of command to use for executing R code.") + +(defun org-babel-expand-body:R (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((out-file (cdr (assoc :file params)))) + (mapconcat + #'identity + ((lambda (inside) + (if out-file + (append + (list (org-babel-R-construct-graphics-device-call out-file params)) + inside + (list "dev.off()")) + inside)) + (append (org-babel-variable-assignments:R params) + (list body))) "\n"))) + +(defun org-babel-execute:R (body params) + "Execute a block of R code. +This function is called by `org-babel-execute-src-block'." + (save-excursion + (let* ((result-type (cdr (assoc :result-type params))) + (session (org-babel-R-initiate-session + (cdr (assoc :session params)) params)) + (colnames-p (cdr (assoc :colnames params))) + (rownames-p (cdr (assoc :rownames params))) + (out-file (cdr (assoc :file params))) + (full-body (org-babel-expand-body:R body params)) + (result + (org-babel-R-evaluate + session full-body result-type + (or (equal "yes" colnames-p) + (org-babel-pick-name + (cdr (assoc :colname-names params)) colnames-p)) + (or (equal "yes" rownames-p) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) rownames-p))))) + (message "result is %S" result) + (or out-file result)))) + +(defun org-babel-prep-session:R (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-R-initiate-session session params)) + (var-lines (org-babel-variable-assignments:R params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:R (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:R session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:R (params) + "Return list of R statements assigning the block's variables" + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (mapcar + (lambda (pair) + (org-babel-R-assign-elisp + (car pair) (cdr pair) + (equal "yes" (cdr (assoc :colnames params))) + (equal "yes" (cdr (assoc :rownames params))))) + (mapcar + (lambda (i) + (cons (car (nth i vars)) + (org-babel-reassemble-table + (cdr (nth i vars)) + (cdr (nth i (cdr (assoc :colname-names params)))) + (cdr (nth i (cdr (assoc :rowname-names params))))))) + (org-number-sequence 0 (1- (length vars))))))) + +(defun org-babel-R-quote-tsv-field (s) + "Quote field S for export to R." + (if (stringp s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") + (format "%S" s))) + +(defun org-babel-R-assign-elisp (name value colnames-p rownames-p) + "Construct R code assigning the elisp VALUE to a variable named NAME." + (if (listp value) + (let ((transition-file (org-babel-temp-file "R-import-"))) + ;; ensure VALUE has an orgtbl structure (depth of at least 2) + (unless (listp (car value)) (setq value (list value))) + (with-temp-file transition-file + (insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))) + (insert "\n")) + (format "%s <- read.table(\"%s\", header=%s, row.names=%s, sep=\"\\t\", as.is=TRUE)" + name (org-babel-process-file-name transition-file 'noquote) + (if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE") + (if rownames-p "1" "NULL"))) + (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) + +(defvar ess-ask-for-ess-directory nil) +(defun org-babel-R-initiate-session (session params) + "If there is not a current R process then create one." + (unless (string= session "none") + (let ((session (or session "*R*")) + (ess-ask-for-ess-directory + (and ess-ask-for-ess-directory (not (cdr (assoc :dir params)))))) + (if (org-babel-comint-buffer-livep session) + session + (save-window-excursion + (require 'ess) (R) + (rename-buffer + (if (bufferp session) + (buffer-name session) + (if (stringp session) + session + (buffer-name)))) + (current-buffer)))))) + +(defvar ess-local-process-name nil) +(defun org-babel-R-associate-session (session) + "Associate R code buffer with an R session. +Make SESSION be the inferior ESS process associated with the +current code buffer." + (setq ess-local-process-name + (process-name (get-buffer-process session))) + (ess-make-buffer-current)) + +(defun org-babel-R-construct-graphics-device-call (out-file params) + "Construct the call to the graphics device." + (let ((devices + '((:bmp . "bmp") + (:jpg . "jpeg") + (:jpeg . "jpeg") + (:tiff . "tiff") + (:png . "png") + (:svg . "svg") + (:pdf . "pdf") + (:ps . "postscript") + (:postscript . "postscript"))) + (allowed-args '(:width :height :bg :units :pointsize + :antialias :quality :compression :res + :type :family :title :fonts :version + :paper :encoding :pagecentre :colormodel + :useDingbats :horizontal)) + (device (and (string-match ".+\\.\\([^.]+\\)" out-file) + (match-string 1 out-file))) + (extra-args (cdr (assq :R-dev-args params))) filearg args) + (setq device (or (and device (cdr (assq (intern (concat ":" device)) + devices))) "png")) + (setq filearg + (if (member device '("pdf" "postscript" "svg")) "file" "filename")) + (setq args (mapconcat + (lambda (pair) + (if (member (car pair) allowed-args) + (format ",%s=%s" + (substring (symbol-name (car pair)) 1) + (cdr pair)) "")) + params "")) + (format "%s(%s=\"%s\"%s%s%s)" + device filearg out-file args + (if extra-args "," "") (or extra-args "")))) + +(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") +(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") +(defvar org-babel-R-write-object-command "{function(object, transfer.file) {invisible(if(inherits(try(write.table(object, file=transfer.file, sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE), silent=TRUE),\"try-error\")) {if(!file.exists(transfer.file)) file.create(transfer.file)})}}(object=%s, transfer.file=\"%s\")") + +(defun org-babel-R-evaluate + (session body result-type column-names-p row-names-p) + "Evaluate R code in BODY." + (if session + (org-babel-R-evaluate-session + session body result-type column-names-p row-names-p) + (org-babel-R-evaluate-external-process + body result-type column-names-p row-names-p))) + +(defun org-babel-R-evaluate-external-process + (body result-type column-names-p row-names-p) + "Evaluate BODY in external R process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (value + (let ((tmp-file (org-babel-temp-file "R-"))) + (org-babel-eval org-babel-R-command + (format org-babel-R-write-object-command + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE") + (format "{function ()\n{\n%s\n}}()" body) + (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file tmp-file '(16)) column-names-p))) + (output (org-babel-eval org-babel-R-command body)))) + +(defun org-babel-R-evaluate-session + (session body result-type column-names-p row-names-p) + "Evaluate BODY in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (value + (with-temp-buffer + (insert (org-babel-chomp body)) + (let ((ess-local-process-name + (process-name (get-buffer-process session)))) + (ess-eval-buffer nil))) + (let ((tmp-file (org-babel-temp-file "R-"))) + (org-babel-comint-eval-invisibly-and-wait-for-file + session tmp-file + (format org-babel-R-write-object-command + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE") + ".Last.value" (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file tmp-file '(16)) column-names-p))) + (output + (mapconcat + #'org-babel-chomp + (butlast + (delq nil + (mapcar + (lambda (line) (when (> (length line) 0) line)) + (mapcar + (lambda (line) ;; cleanup extra prompts left in output + (if (string-match + "^\\([ ]*[>+][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line) + (substring line (match-end 1)) + line)) + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat #'org-babel-chomp + (list body org-babel-R-eoe-indicator) + "\n")) + (inferior-ess-send-input)))))) "\n")))) + +(defun org-babel-R-process-value-result (result column-names-p) + "R-specific processing of return value. +Insert hline if column names in output have been requested." + (if column-names-p + (cons (car result) (cons 'hline (cdr result))) + result)) + +(provide 'ob-R) + +;; arch-tag: cd4c7298-503b-450f-a3c2-f3e74b630237 + +;;; ob-R.el ends here diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el new file mode 100644 index 00000000000..ab2abda28d8 --- /dev/null +++ b/lisp/org/ob-asymptote.el @@ -0,0 +1,164 @@ +;;; ob-asymptote.el --- org-babel functions for asymptote evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating asymptote source code. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in asymptote +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments, if file +;; is omitted then the -V option is passed to the asy command for +;; interactive viewing + +;;; Requirements: + +;; - The asymptote program :: http://asymptote.sourceforge.net/ +;; +;; - asy-mode :: Major mode for editing asymptote files + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function org-combine-plists "org" (&rest plists)) + +(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy")) + +(defvar org-babel-default-header-args:asymptote + '((:results . "file") (:exports . "results")) + "Default arguments when evaluating an Asymptote source block.") + +(defun org-babel-execute:asymptote (body params) + "Execute a block of Asymptote code. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (format (or (and out-file + (string-match ".+\\.\\(.+\\)" out-file) + (match-string 1 out-file)) + "pdf")) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "asymptote-")) + (cmd + (concat "asy " + (if out-file + (concat + "-globalwrite -f " format + " -o " (org-babel-process-file-name out-file)) + "-V") + " " cmdline + " " (org-babel-process-file-name in-file)))) + (with-temp-file in-file + (insert (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:asymptote params)))) + (message cmd) (shell-command cmd) + out-file)) + +(defun org-babel-prep-session:asymptote (session params) + "Return an error if the :session header argument is set. +Asymptote does not support sessions" + (error "Asymptote does not support sessions")) + +(defun org-babel-variable-assignments:asymptote (params) + "Return list of asymptote statements assigning the block's variables" + (mapcar #'org-babel-asymptote-var-to-asymptote + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-asymptote-var-to-asymptote (pair) + "Convert an elisp value into an Asymptote variable. +The elisp value PAIR is converted into Asymptote code specifying +a variable of the same value." + (let ((var (car pair)) + (val (if (symbolp (cdr pair)) + (symbol-name (cdr pair)) + (cdr pair)))) + (cond + ((integerp val) + (format "int %S=%S;" var val)) + ((floatp val) + (format "real %S=%S;" var val)) + ((stringp val) + (format "string %S=\"%s\";" var val)) + ((listp val) + (let* ((dimension-2-p (not (null (cdr val)))) + (dim (if dimension-2-p "[][]" "[]")) + (type (org-babel-asymptote-define-type val)) + (array (org-babel-asymptote-table-to-array + val + (if dimension-2-p '(:lstart "{" :lend "}," :llend "}"))))) + (format "%S%s %S=%s;" type dim var array)))))) + +(defun org-babel-asymptote-table-to-array (table params) + "Convert values of an elisp table into a string of an asymptote array. +Empty cells are ignored." + (labels ((atom-to-string (table) + (cond + ((null table) '()) + ((not (listp (car table))) + (cons (if (and (stringp (car table)) + (not (string= (car table) ""))) + (format "\"%s\"" (car table)) + (format "%s" (car table))) + (atom-to-string (cdr table)))) + (t + (cons (atom-to-string (car table)) + (atom-to-string (cdr table)))))) + ;; Remove any empty row + (fix-empty-lines (table) + (delq nil (mapcar (lambda (l) (delq "" l)) table)))) + (orgtbl-to-generic + (fix-empty-lines (atom-to-string table)) + (org-combine-plists '(:hline nil :sep "," :tstart "{" :tend "}") params)))) + +(defun org-babel-asymptote-define-type (data) + "Determine type of DATA. +DATA is a list. Type symbol is returned as 'symbol. The type is +usually the type of the first atom encountered, except for arrays +of int, where every cell must be of int type." + (labels ((anything-but-int (el) + (cond + ((null el) nil) + ((not (listp (car el))) + (cond + ((floatp (car el)) 'real) + ((stringp (car el)) 'string) + (t + (anything-but-int (cdr el))))) + (t + (or (anything-but-int (car el)) + (anything-but-int (cdr el))))))) + (or (anything-but-int data) 'int))) + +(provide 'ob-asymptote) + +;; arch-tag: f2f5bd0d-78e8-412b-8e6c-6dadc94cc06b + +;;; ob-asymptote.el ends here diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el new file mode 100644 index 00000000000..287bad31a29 --- /dev/null +++ b/lisp/org/ob-calc.el @@ -0,0 +1,97 @@ +;;; ob-calc.el --- org-babel functions for calc code evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating calc code + +;;; Code: +(require 'ob) +(require 'calc) +(require 'calc-trail) +(eval-when-compile (require 'ob-comint)) + +(defvar org-babel-default-header-args:calc nil + "Default arguments for evaluating an calc source block.") + +(defun org-babel-expand-body:calc (body params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:calc (body params) + "Execute a block of calc code with Babel." + (unless (get-buffer "*Calculator*") + (save-window-excursion (calc) (calc-quit))) + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (var-syms (mapcar #'car vars)) + (var-names (mapcar #'symbol-name var-syms))) + (mapc + (lambda (pair) + (calc-push-list (list (cdr pair))) + (calc-store-into (car pair))) + vars) + (mapc + (lambda (line) + (when (> (length line) 0) + (cond + ;; simple variable name + ((member line var-names) (calc-recall (intern line))) + ;; stack operation + ((string= "'" (substring line 0 1)) + (funcall (lookup-key calc-mode-map (substring line 1)) nil)) + ;; complex expression + (t + (calc-push-list + (list ((lambda (res) + (cond + ((numberp res) res) + ((math-read-number res) (math-read-number res)) + ((listp res) (error "calc error \"%s\" on input \"%s\"" + (cadr res) line)) + (t (calc-eval + (math-evaluate-expr + ;; resolve user variables, calc built in + ;; variables are handled automatically + ;; upstream by calc + (mapcar (lambda (el) + (if (and (consp el) (equal 'var (car el)) + (member (cadr el) var-syms)) + (progn + (calc-recall (cadr el)) + (prog1 (calc-top 1) + (calc-pop 1))) + el)) + ;; parse line into calc objects + (car (math-read-exprs line)))))))) + (calc-eval line)))))))) + (mapcar #'org-babel-trim + (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) + (save-excursion + (with-current-buffer (get-buffer "*Calculator*") + (calc-eval (calc-top 1))))) + +(provide 'ob-calc) + +;; arch-tag: 5c57a3b7-5818-4c6c-acda-7a94831a6449 + +;;; ob-calc.el ends here diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el new file mode 100644 index 00000000000..d88c54b6dbe --- /dev/null +++ b/lisp/org/ob-clojure.el @@ -0,0 +1,88 @@ +;;; ob-clojure.el --- org-babel functions for clojure evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Joel Boehland, Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; support for evaluating clojure code, relies on slime for all eval + +;;; Requirements: + +;;; - clojure (at least 1.2.0) +;;; - clojure-mode +;;; - slime +;;; - swank-clojure + +;;; By far, the best way to install these components is by following +;;; the directions as set out by Phil Hagelberg (Technomancy) on the +;;; web page: http://technomancy.us/126 + +;;; Code: +(require 'ob) + +(declare-function slime-eval "ext:slime" (sexp &optional package)) + +(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) + +(defvar org-babel-default-header-args:clojure '()) +(defvar org-babel-header-arg-names:clojure '(package)) + +(defun org-babel-expand-body:clojure (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :result-params params))) + (print-level nil) (print-length nil) + (body (org-babel-trim + (if (> (length vars) 0) + (concat "(let [" + (mapconcat + (lambda (var) + (format "%S (quote %S)" (car var) (cdr var))) + vars "\n ") + "]\n" body ")") + body)))) + (if (or (member "code" result-params) + (member "pp" result-params)) + (format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)]" + "(clojure.pprint/with-pprint-dispatch %s-dispatch" + "(clojure.pprint/pprint %s org-mode-print-catcher)" + "(str org-mode-print-catcher)))") + (if (member "code" result-params) "code" "simple") body) + body))) + +(defun org-babel-execute:clojure (body params) + "Execute a block of Clojure code with Babel." + (require 'slime) (require 'swank-clojure) + (with-temp-buffer + (insert (org-babel-expand-body:clojure body params)) + (read + (slime-eval + `(swank:interactive-eval-region + ,(buffer-substring-no-properties (point-min) (point-max))) + (cdr (assoc :package params)))))) + +(provide 'ob-clojure) + +;; arch-tag: a43b33f2-653e-46b1-ac56-2805cf05b7d1 + +;;; ob-clojure.el ends here diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el new file mode 100644 index 00000000000..064aad539c2 --- /dev/null +++ b/lisp/org/ob-comint.el @@ -0,0 +1,163 @@ +;;; ob-comint.el --- org-babel functions for interaction with comint buffers + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, comint +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; These functions build on comint to ease the sending and receiving +;; of commands and results from comint buffers. + +;; Note that the buffers in this file are analogous to sessions in +;; org-babel at large. + +;;; Code: +(require 'ob) +(require 'comint) +(eval-when-compile (require 'cl)) +(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) +(declare-function tramp-flush-directory-property "tramp" (vec directory)) + +(defun org-babel-comint-buffer-livep (buffer) + "Check if BUFFER is a comint buffer with a live process." + (let ((buffer (if buffer (get-buffer buffer)))) + (and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer))) + +(defmacro org-babel-comint-in-buffer (buffer &rest body) + "Check BUFFER and execute BODY. +BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is +executed inside the protection of `save-excursion' and +`save-match-data'." + (declare (indent 1)) + `(save-excursion + (save-match-data + (unless (org-babel-comint-buffer-livep ,buffer) + (error "buffer %s doesn't exist or has no process" ,buffer)) + (set-buffer ,buffer) + ,@body))) + +(defmacro org-babel-comint-with-output (meta &rest body) + "Evaluate BODY in BUFFER and return process output. +Will wait until EOE-INDICATOR appears in the output, then return +all process output. If REMOVE-ECHO and FULL-BODY are present and +non-nil, then strip echo'd body from the returned output. META +should be a list containing the following where the last two +elements are optional. + + (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY) + +This macro ensures that the filter is removed in case of an error +or user `keyboard-quit' during execution of body." + (declare (indent 1)) + (let ((buffer (car meta)) + (eoe-indicator (cadr meta)) + (remove-echo (cadr (cdr meta))) + (full-body (cadr (cdr (cdr meta))))) + `(org-babel-comint-in-buffer ,buffer + (let ((string-buffer "") dangling-text raw) + (flet ((my-filt (text) + (setq string-buffer (concat string-buffer text)))) + ;; setup filter + (add-hook 'comint-output-filter-functions 'my-filt) + (unwind-protect + (progn + ;; got located, and save dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (let ((start (point)) + (end (point-max))) + (setq dangling-text (buffer-substring start end)) + (delete-region start end)) + ;; pass FULL-BODY to process + ,@body + ;; wait for end-of-evaluation indicator + (while (progn + (goto-char comint-last-input-end) + (not (save-excursion + (and (re-search-forward + comint-prompt-regexp nil t) + (re-search-forward + (regexp-quote ,eoe-indicator) nil t))))) + (accept-process-output (get-buffer-process (current-buffer))) + ;; thought the following this would allow async + ;; background running, but I was wrong... + ;; (run-with-timer .5 .5 'accept-process-output + ;; (get-buffer-process (current-buffer))) + ) + ;; replace cut dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert dangling-text)) + ;; remove filter + (remove-hook 'comint-output-filter-functions 'my-filt))) + ;; remove echo'd FULL-BODY from input + (if (and ,remove-echo ,full-body + (string-match + (replace-regexp-in-string + "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) + string-buffer)) + (setq raw (substring string-buffer (match-end 0)))) + (split-string string-buffer comint-prompt-regexp))))) + +(defun org-babel-comint-input-command (buffer cmd) + "Pass CMD to BUFFER. +The input will not be echoed." + (org-babel-comint-in-buffer buffer + (goto-char (process-mark (get-buffer-process buffer))) + (insert cmd) + (comint-send-input) + (org-babel-comint-wait-for-output buffer))) + +(defun org-babel-comint-wait-for-output (buffer) + "Wait until output arrives from BUFFER. +Note: this is only safe when waiting for the result of a single +statement (not large blocks of code)." + (org-babel-comint-in-buffer buffer + (while (progn + (goto-char comint-last-input-end) + (not (and (re-search-forward comint-prompt-regexp nil t) + (goto-char (match-beginning 0)) + (string= (face-name (face-at-point)) + "comint-highlight-prompt")))) + (accept-process-output (get-buffer-process buffer))))) + +(defun org-babel-comint-eval-invisibly-and-wait-for-file + (buffer file string &optional period) + "Evaluate STRING in BUFFER invisibly. +Don't return until FILE exists. Code in STRING must ensure that +FILE exists at end of evaluation." + (unless (org-babel-comint-buffer-livep buffer) + (error "buffer %s doesn't exist or has no process" buffer)) + (if (file-exists-p file) (delete-file file)) + (process-send-string + (get-buffer-process buffer) + (if (string-match "\n$" string) string (concat string "\n"))) + ;; From Tramp 2.1.19 the following cache flush is not necessary + (if (file-remote-p default-directory) + (let (v) + (with-parsed-tramp-file-name default-directory nil + (tramp-flush-directory-property v "")))) + (while (not (file-exists-p file)) (sit-for (or period 0.25)))) + +(provide 'ob-comint) + +;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889 + +;;; ob-comint.el ends here diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el new file mode 100644 index 00000000000..48ea9e3f937 --- /dev/null +++ b/lisp/org/ob-css.el @@ -0,0 +1,49 @@ +;;; ob-css.el --- org-babel functions for css evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Since CSS can't be executed, this file exists solely for tangling +;; CSS from org-mode files. + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:css '()) + +(defun org-babel-execute:css (body params) + "Execute a block of CSS code. +This function is called by `org-babel-execute-src-block'." + body) + +(defun org-babel-prep-session:css (session params) + "Return an error if the :session header argument is set. +CSS does not support sessions." + (error "CSS sessions are nonsensical")) + +(provide 'ob-css) + +;; arch-tag: f4447e8c-50ab-41f9-b322-b7b9574d9fbe + +;;; ob-css.el ends here diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el new file mode 100644 index 00000000000..097f938e92d --- /dev/null +++ b/lisp/org/ob-ditaa.el @@ -0,0 +1,74 @@ +;;; ob-ditaa.el --- org-babel functions for ditaa evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating ditaa source code. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in ditaa +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments +;; +;; 4) there are no variables (at least for now) + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:ditaa + '((:results . "file") (:exports . "results")) + "Default arguments for evaluating a ditaa source block.") + +(defvar org-ditaa-jar-path) +(defun org-babel-execute:ditaa (body params) + "Execute a block of Ditaa code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "ditaa-")) + (cmd (concat "java -jar " + (shell-quote-argument + (expand-file-name org-ditaa-jar-path)) + " " cmdline + " " (org-babel-process-file-name in-file) + " " (org-babel-process-file-name out-file)))) + (unless (file-exists-p org-ditaa-jar-path) + (error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) + (with-temp-file in-file (insert body)) + (message cmd) (shell-command cmd) + out-file)) + +(defun org-babel-prep-session:ditaa (session params) + "Return an error because ditaa does not support sessions." + (error "Ditaa does not support sessions")) + +(provide 'ob-ditaa) + +;; arch-tag: 492cd006-07d9-4fac-bef6-5bb60b48842e + +;;; ob-ditaa.el ends here diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el new file mode 100644 index 00000000000..36baddb1cd3 --- /dev/null +++ b/lisp/org/ob-dot.el @@ -0,0 +1,90 @@ +;;; ob-dot.el --- org-babel functions for dot evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating dot source code. +;; +;; For information on dot see http://www.graphviz.org/ +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in dot +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments +;; +;; 4) there are no variables (at least for now) + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:dot + '((:results . "file") (:exports . "results")) + "Default arguments to use when evaluating a dot source block.") + +(defun org-babel-expand-body:dot (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (mapc + (lambda (pair) + (let ((name (symbol-name (car pair))) + (value (cdr pair))) + (setq body + (replace-regexp-in-string + (concat "\$" (regexp-quote name)) + (if (stringp value) value (format "%S" value)) + body)))) + vars) + body)) + +(defun org-babel-execute:dot (body params) + "Execute a block of Dot code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (cdr (assoc :result-params params))) + (out-file (cdr (assoc :file params))) + (cmdline (or (cdr (assoc :cmdline params)) + (format "-T%s" (file-name-extension out-file)))) + (cmd (or (cdr (assoc :cmd params)) "dot")) + (in-file (org-babel-temp-file "dot-"))) + (with-temp-file in-file + (insert (org-babel-expand-body:dot body params))) + (org-babel-eval + (concat cmd + " " (org-babel-process-file-name in-file) + " " cmdline + " -o " (org-babel-process-file-name out-file)) "") + out-file)) + +(defun org-babel-prep-session:dot (session params) + "Return an error because Dot does not support sessions." + (error "Dot does not support sessions")) + +(provide 'ob-dot) + +;; arch-tag: 817d0516-7b47-4f77-a8b2-2aadd8e4d0e2 + +;;; ob-dot.el ends here diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el new file mode 100644 index 00000000000..df6f505ffea --- /dev/null +++ b/lisp/org/ob-emacs-lisp.el @@ -0,0 +1,71 @@ +;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating emacs-lisp code + +;;; Code: +(require 'ob) +(eval-when-compile (require 'ob-comint)) + +(defvar org-babel-default-header-args:emacs-lisp + '((:hlines . "yes") (:colnames . "no")) + "Default arguments for evaluating an emacs-lisp source block.") + +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defun org-babel-expand-body:emacs-lisp (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :result-params params))) + (print-level nil) (print-length nil) + (body (if (> (length vars) 0) + (concat "(let (" + (mapconcat + (lambda (var) + (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body ")") + body))) + (if (or (member "code" result-params) + (member "pp" result-params)) + (concat "(pp " body ")") body))) + +(defun org-babel-execute:emacs-lisp (body params) + "Execute a block of emacs-lisp code with Babel." + (save-window-excursion + (org-babel-reassemble-table + (eval (read (format "(progn %s)" + (org-babel-expand-body:emacs-lisp body params)))) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params)))))) + +(provide 'ob-emacs-lisp) + +;; arch-tag: e9a3acca-dc84-472a-9f5a-23c35befbcd6 + +;;; ob-emacs-lisp.el ends here diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el new file mode 100644 index 00000000000..a71cb0dd691 --- /dev/null +++ b/lisp/org/ob-eval.el @@ -0,0 +1,262 @@ +;;; ob-eval.el --- org-babel functions for external code evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, comint +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; These functions build existing Emacs support for executing external +;; shell commands. + +;;; Code: +(eval-when-compile (require 'cl)) + +(defvar org-babel-error-buffer-name "*Org-Babel Error Output*") + +(defun org-babel-eval-error-notify (exit-code stderr) + "Open a buffer to display STDERR and a message with the value of EXIT-CODE." + (let ((buf (get-buffer-create org-babel-error-buffer-name))) + (with-current-buffer buf + (goto-char (point-max)) + (save-excursion (insert stderr))) + (display-buffer buf)) + (message "Babel evaluation exited with code %S" exit-code)) + +(defun org-babel-eval (cmd body) + "Run CMD on BODY. +If CMD succeeds then return its results, otherwise display +STDERR with `org-babel-eval-error-notify'." + (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code) + (with-current-buffer err-buff (erase-buffer)) + (with-temp-buffer + (insert body) + (setq exit-code + (org-babel-shell-command-on-region + (point-min) (point-max) cmd t 'replace err-buff)) + (if (or (not (numberp exit-code)) (> exit-code 0)) + (progn + (with-current-buffer err-buff + (org-babel-eval-error-notify exit-code (buffer-string))) + nil) + (buffer-string))))) + +(defun org-babel-eval-read-file (file) + "Return the contents of FILE as a string." + (with-temp-buffer (insert-file-contents file) + (buffer-string))) + +(defun org-babel-shell-command-on-region (start end command + &optional output-buffer replace + error-buffer display-error-buffer) + "Execute COMMAND in an inferior shell with region as input. + +Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region' + +Normally display output (if any) in temp buffer `*Shell Command Output*'; +Prefix arg means replace the region with it. Return the exit code of +COMMAND. + +To specify a coding system for converting non-ASCII characters in +the input and output to the shell command, use +\\[universal-coding-system-argument] before this command. By +default, the input (from the current buffer) is encoded in the +same coding system that will be used to save the file, +`buffer-file-coding-system'. If the output is going to replace +the region, then it is decoded from that same coding system. + +The noninteractive arguments are START, END, COMMAND, +OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER. +Noninteractive callers can specify coding systems by binding +`coding-system-for-read' and `coding-system-for-write'. + +If the command generates output, the output may be displayed +in the echo area or in a buffer. +If the output is short enough to display in the echo area +\(determined by the variable `max-mini-window-height' if +`resize-mini-windows' is non-nil), it is shown there. Otherwise +it is displayed in the buffer `*Shell Command Output*'. The output +is available in that buffer in both cases. + +If there is output and an error, a message about the error +appears at the end of the output. + +If there is no output, or if output is inserted in the current buffer, +then `*Shell Command Output*' is deleted. + +If the optional fourth argument OUTPUT-BUFFER is non-nil, +that says to put the output in some other buffer. +If OUTPUT-BUFFER is a buffer or buffer name, put the output there. +If OUTPUT-BUFFER is not a buffer and not nil, +insert output in the current buffer. +In either case, the output is inserted after point (leaving mark after it). + +If REPLACE, the optional fifth argument, is non-nil, that means insert +the output in place of text from START to END, putting point and mark +around it. + +If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer +or buffer name to which to direct the command's standard error output. +If it is nil, error output is mingled with regular output. +If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there +were any errors. (This is always t, interactively.) +In an interactive call, the variable `shell-command-default-error-buffer' +specifies the value of ERROR-BUFFER." + (interactive (let (string) + (unless (mark) + (error "The mark is not set now, so there is no region")) + ;; Do this before calling region-beginning + ;; and region-end, in case subprocess output + ;; relocates them while we are in the minibuffer. + (setq string (read-shell-command "Shell command on region: ")) + ;; call-interactively recognizes region-beginning and + ;; region-end specially, leaving them in the history. + (list (region-beginning) (region-end) + string + current-prefix-arg + current-prefix-arg + shell-command-default-error-buffer + t))) + (let ((error-file + (if error-buffer + (make-temp-file + (expand-file-name "scor" + (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory))) + nil)) + exit-status) + (if (or replace + (and output-buffer + (not (or (bufferp output-buffer) (stringp output-buffer))))) + ;; Replace specified region with output from command. + (let ((swap (and replace (< start end)))) + ;; Don't muck with mark unless REPLACE says we should. + (goto-char start) + (and replace (push-mark (point) 'nomsg)) + (setq exit-status + (call-process-region start end shell-file-name t + (if error-file + (list output-buffer error-file) + t) + nil shell-command-switch command)) + ;; It is rude to delete a buffer which the command is not using. + ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) + ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) + ;; (kill-buffer shell-buffer))) + ;; Don't muck with mark unless REPLACE says we should. + (and replace swap (exchange-point-and-mark))) + ;; No prefix argument: put the output in a temp buffer, + ;; replacing its entire contents. + (let ((buffer (get-buffer-create + (or output-buffer "*Shell Command Output*")))) + (unwind-protect + (if (eq buffer (current-buffer)) + ;; If the input is the same buffer as the output, + ;; delete everything but the specified region, + ;; then replace that region with the output. + (progn (setq buffer-read-only nil) + (delete-region (max start end) (point-max)) + (delete-region (point-min) (min start end)) + (setq exit-status + (call-process-region (point-min) (point-max) + shell-file-name t + (if error-file + (list t error-file) + t) + nil shell-command-switch + command))) + ;; Clear the output buffer, then run the command with + ;; output there. + (let ((directory default-directory)) + (with-current-buffer buffer + (setq buffer-read-only nil) + (if (not output-buffer) + (setq default-directory directory)) + (erase-buffer))) + (setq exit-status + (call-process-region start end shell-file-name nil + (if error-file + (list buffer error-file) + buffer) + nil shell-command-switch command))) + ;; Report the output. + (with-current-buffer buffer + (setq mode-line-process + (cond ((null exit-status) + " - Error") + ((stringp exit-status) + (format " - Signal [%s]" exit-status)) + ((not (equal 0 exit-status)) + (format " - Exit [%d]" exit-status))))) + (if (with-current-buffer buffer (> (point-max) (point-min))) + ;; There's some output, display it + (display-message-or-buffer buffer) + ;; No output; error? + (let ((output + (if (and error-file + (< 0 (nth 7 (file-attributes error-file)))) + "some error output" + "no output"))) + (cond ((null exit-status) + (message "(Shell command failed with error)")) + ((equal 0 exit-status) + (message "(Shell command succeeded with %s)" + output)) + ((stringp exit-status) + (message "(Shell command killed by signal %s)" + exit-status)) + (t + (message "(Shell command failed with code %d and %s)" + exit-status output)))) + ;; Don't kill: there might be useful info in the undo-log. + ;; (kill-buffer buffer) + )))) + + (when (and error-file (file-exists-p error-file)) + (if (< 0 (nth 7 (file-attributes error-file))) + (with-current-buffer (get-buffer-create error-buffer) + (let ((pos-from-end (- (point-max) (point)))) + (or (bobp) + (insert "\f\n")) + ;; Do no formatting while reading error file, + ;; because that can run a shell command, and we + ;; don't want that to cause an infinite recursion. + (format-insert-file error-file nil) + ;; Put point after the inserted errors. + (goto-char (- (point-max) pos-from-end))) + (and display-error-buffer + (display-buffer (current-buffer))))) + (delete-file error-file)) + exit-status)) + +(defun org-babel-eval-wipe-error-buffer () + "Delete the contents of the Org code block error buffer. +This buffer is named by `org-babel-error-buffer-name'." + (when (get-buffer org-babel-error-buffer-name) + (with-current-buffer org-babel-error-buffer-name + (delete-region (point-min) (point-max))))) + +(provide 'ob-eval) + +;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d + +;;; ob-eval.el ends here diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el new file mode 100644 index 00000000000..8b6914c903c --- /dev/null +++ b/lisp/org/ob-exp.el @@ -0,0 +1,328 @@ +;;; ob-exp.el --- Exportation of org-babel source blocks + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; See the online documentation for more information +;; +;; http://orgmode.org/worg/org-contrib/babel/ + +;;; Code: +(require 'ob) +(require 'org-exp-blocks) +(eval-when-compile + (require 'cl)) + +(defvar obe-marker nil) +(defvar org-current-export-file) +(defvar org-babel-lob-one-liner-regexp) +(defvar org-babel-ref-split-regexp) +(declare-function org-babel-lob-get-info "ob-lob" ()) +(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) +(add-to-list 'org-export-interblocks '(src org-babel-exp-inline-src-blocks)) +(add-to-list 'org-export-interblocks '(lob org-babel-exp-lob-one-liners)) +(add-hook 'org-export-blocks-postblock-hook 'org-exp-res/src-name-cleanup) + +(org-export-blocks-add-block '(src org-babel-exp-src-blocks nil)) + +(defcustom org-export-babel-evaluate t + "Switch controlling code evaluation during export. +When set to nil no code will be evaluated as part of the export +process." + :group 'org-babel + :type 'boolean) +(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) + +(defvar org-babel-function-def-export-keyword "function" + "The keyword to substitute for the source name line on export. +When exporting a source block function, this keyword will +appear in the exported version in the place of source name +line. A source block is considered to be a source block function +if the source name is present and is followed by a parenthesized +argument list. The parentheses may be empty or contain +whitespace. An example is the following which generates n random +\(uniform) numbers. + +#+source: rand(n) +#+begin_src R + runif(n) +#+end_src") + +(defvar org-babel-function-def-export-indent 4 + "Number of characters to indent a source block on export. +When exporting a source block function, the block contents will +be indented by this many characters. See +`org-babel-function-def-export-name' for the definition of a +source block function.") + +(defmacro org-babel-exp-in-export-file (&rest body) + `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" lang))) + (heading (nth 4 (ignore-errors (org-heading-components)))) + (link (when org-current-export-file + (org-make-link-string + (if heading + (concat org-current-export-file "::" heading) + org-current-export-file)))) + (export-buffer (current-buffer)) results) + (when link + ;; resolve parameters in the original file so that + ;; headline and file-wide parameters are included, attempt + ;; to go to the same heading in the original file + (set-buffer (get-file-buffer org-current-export-file)) + (save-restriction + (condition-case nil + (org-open-link-from-string link) + (error (when heading + (goto-char (point-min)) + (re-search-forward (regexp-quote heading) nil t)))) + (setq results ,@body)) + (set-buffer export-buffer) + results))) + +(defun org-babel-exp-src-blocks (body &rest headers) + "Process source block for export. +Depending on the 'export' headers argument in replace the source +code block with... + +both ---- display the code and the results + +code ---- the default, display the code inside the block but do + not process + +results - just like none only the block is run on export ensuring + that it's results are present in the org-mode buffer + +none ----- do not display either code or results upon export" + (interactive) + (message "org-babel-exp processing...") + (save-excursion + (goto-char (match-beginning 0)) + (let* ((info (org-babel-get-src-block-info 'light)) + (lang (nth 0 info)) + (raw-params (nth 2 info))) + ;; bail if we couldn't get any info from the block + (when info + (org-babel-exp-in-export-file + (setf (nth 2 info) + (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties lang) + (if (boundp lang-headers) (eval lang-headers) nil) + raw-params))) + ;; expand noweb references in the original file + (setf (nth 1 info) + (if (and (cdr (assoc :noweb (nth 2 info))) + (string= "yes" (cdr (assoc :noweb (nth 2 info))))) + (org-babel-expand-noweb-references + info (get-file-buffer org-current-export-file)) + (nth 1 info))) + (org-babel-exp-do-export info 'block))))) + +(defun org-babel-exp-inline-src-blocks (start end) + "Process inline source blocks between START and END for export. +See `org-babel-exp-src-blocks' for export options, currently the +options and are taken from `org-babel-default-inline-header-args'." + (interactive) + (save-excursion + (goto-char start) + (while (and (< (point) end) + (re-search-forward org-babel-inline-src-block-regexp end t)) + (let* ((info (save-match-data (org-babel-parse-inline-src-block-match))) + (params (nth 2 info)) + (replacement + (save-match-data + (if (org-babel-in-example-or-verbatim) + (buffer-substring (match-beginning 0) (match-end 0)) + ;; expand noweb references in the original file + (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references + info (get-file-buffer org-current-export-file)) + (nth 1 info))) + (org-babel-exp-do-export info 'inline))))) + (setq end (+ end (- (length replacement) (length (match-string 1))))) + (replace-match replacement t t nil 1))))) + +(defun org-exp-res/src-name-cleanup () + "Clean up #+results and #+srcname lines for export. +This function should only be called after all block processing +has taken place." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (org-re-search-forward-unprotected + (concat + "\\("org-babel-src-name-regexp"\\|"org-babel-result-regexp"\\)") + nil t) + (delete-region + (progn (beginning-of-line) (point)) + (progn (end-of-line) (+ 1 (point))))))) + +(defun org-babel-in-example-or-verbatim () + "Return true if point is in example or verbatim code. +Example and verbatim code include escaped portions of +an org-mode buffer code that should be treated as normal +org-mode text." + (or (org-in-indented-comment-line) + (save-excursion + (save-match-data + (goto-char (point-at-bol)) + (looking-at "[ \t]*:[ \t]"))) + (org-in-regexps-block-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src"))) + +(defun org-babel-exp-lob-one-liners (start end) + "Process Library of Babel calls between START and END for export. +See `org-babel-exp-src-blocks' for export options. Currently the +options are taken from `org-babel-default-header-args'." + (interactive) + (let (replacement) + (save-excursion + (goto-char start) + (while (and (< (point) end) + (re-search-forward org-babel-lob-one-liner-regexp nil t)) + (setq replacement + (let ((lob-info (org-babel-lob-get-info))) + (save-match-data + (org-babel-exp-do-export + (list "emacs-lisp" "results" + (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-babel-clean-text-properties + (concat ":var results=" + (mapconcat #'identity + (butlast lob-info) " "))))) + (car (last lob-info))) + 'lob)))) + (setq end (+ end (- (length replacement) (length (match-string 0))))) + (replace-match replacement t t))))) + +(defun org-babel-exp-do-export (info type) + "Return a string with the exported content of a code block. +The function respects the value of the :exports header argument." + (flet ((silently () (let ((session (cdr (assoc :session (nth 2 info))))) + (when (and session + (not (equal "none" session))) + (org-babel-exp-results info type 'silent)))) + (clean () (org-babel-remove-result info))) + (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) + ('none (silently) (clean) "") + ('code (silently) (clean) (org-babel-exp-code info type)) + ('results (org-babel-exp-results info type)) + ('both (concat (org-babel-exp-code info type) + "\n\n" + (org-babel-exp-results info type)))))) + +(defvar backend) +(defun org-babel-exp-code (info type) + "Prepare and return code in the current code block for export. +Code is prepared in a manner suitable for export by +org-mode. This function is called by `org-babel-exp-do-export'. +The code block is not evaluated." + (let ((lang (nth 0 info)) + (body (nth 1 info)) + (switches (nth 3 info)) + (name (nth 4 info)) + (args (mapcar #'cdr (org-babel-get-header (nth 2 info) :var)))) + (case type + ('inline (format "=%s=" body)) + ('block + (let ((str + (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body + (if (and body (string-match "\n$" body)) + "" "\n")))) + (when name + (add-text-properties + 0 (length str) + (list 'org-caption + (format "%s(%s)" + name + (mapconcat #'identity args ", "))) + str)) + str)) + ('lob + (let ((call-line (and (string-match "results=" (car args)) + (substring (car args) (match-end 0))))) + (cond + ((eq backend 'html) + (format "\n#+HTML: <label class=\"org-src-name\">%s</label>\n" + call-line)) + ((format ": %s\n" call-line)))))))) + +(defun org-babel-exp-results (info type &optional silent) + "Evaluate and return the results of the current code block for export. +Results are prepared in a manner suitable for export by org-mode. +This function is called by `org-babel-exp-do-export'. The code +block will be evaluated. Optional argument SILENT can be used to +inhibit insertion of results into the buffer." + (or + (when org-export-babel-evaluate + (let ((lang (nth 0 info)) + (body (nth 1 info))) + (setf (nth 2 info) (org-babel-exp-in-export-file + (org-babel-process-params (nth 2 info)))) + ;; skip code blocks which we can't evaluate + (when (fboundp (intern (concat "org-babel-execute:" lang))) + (org-babel-eval-wipe-error-buffer) + (if (equal type 'inline) + (let ((raw (org-babel-execute-src-block + nil info '((:results . "silent")))) + (result-params (split-string + (cdr (assoc :results (nth 2 info)))))) + (unless silent + (cond ;; respect the value of the :results header argument + ((member "file" result-params) + (org-babel-result-to-file raw)) + ((or (member "raw" result-params) + (member "org" result-params)) + (format "%s" raw)) + ((member "code" result-params) + (format "src_%s{%s}" lang raw)) + (t + (if (stringp raw) + (if (= 0 (length raw)) "=(no results)=" + (format "%s" raw)) + (format "%S" raw)))))) + (prog1 nil + (setf (nth 2 info) + (org-babel-merge-params + (nth 2 info) + `((:results . ,(if silent "silent" "replace"))))) + (cond + ((equal type 'block) (org-babel-execute-src-block nil info)) + ((equal type 'lob) + (save-excursion + (re-search-backward org-babel-lob-one-liner-regexp nil t) + (org-babel-execute-src-block nil info))))))))) + "")) + +(provide 'ob-exp) + +;; arch-tag: 523abf4c-76d1-44ed-9f27-e3bddf34bf0f + +;;; ob-exp.el ends here diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el new file mode 100644 index 00000000000..423e47e8669 --- /dev/null +++ b/lisp/org/ob-gnuplot.el @@ -0,0 +1,235 @@ +;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating gnuplot source code. +;; +;; This differs from most standard languages in that +;; +;; 1) we are generally only going to return results of type "file" +;; +;; 2) we are adding the "file" and "cmdline" header arguments + +;;; Requirements: + +;; - gnuplot :: http://www.gnuplot.info/ +;; +;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(eval-when-compile (require 'cl)) + +(declare-function org-time-string-to-time "org" (s)) +(declare-function org-combine-plists "org" (&rest plists)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function gnuplot-mode "ext:gnuplot-mode" ()) +(declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt)) +(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ()) + +(defvar org-babel-default-header-args:gnuplot + '((:results . "file") (:exports . "results") (:session . nil)) + "Default arguments to use when evaluating a gnuplot source block.") + +(defvar org-babel-gnuplot-timestamp-fmt nil) + +(defun org-babel-gnuplot-process-vars (params) + "Extract variables from PARAMS and process the variables. +Dumps all vectors into files and returns an association list +of variable names and the related value to be used in the gnuplot +code." + (mapcar + (lambda (pair) + (cons + (car pair) ;; variable name + (if (listp (cdr pair)) ;; variable value + (org-babel-gnuplot-table-to-data + (cdr pair) (org-babel-temp-file "gnuplot-") params) + (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-expand-body:gnuplot (body params) + "Expand BODY according to PARAMS, return the expanded body." + (save-window-excursion + (let* ((vars (org-babel-gnuplot-process-vars params)) + (out-file (cdr (assoc :file params))) + (term (or (cdr (assoc :term params)) + (when out-file (file-name-extension out-file)))) + (cmdline (cdr (assoc :cmdline params))) + (title (plist-get params :title)) + (lines (plist-get params :line)) + (sets (plist-get params :set)) + (x-labels (plist-get params :xlabels)) + (y-labels (plist-get params :ylabels)) + (timefmt (plist-get params :timefmt)) + (time-ind (or (plist-get params :timeind) + (when timefmt 1))) + output) + (flet ((add-to-body (text) + (setq body (concat text "\n" body)))) + ;; append header argument settings to body + (when title (add-to-body (format "set title '%s'" title))) ;; title + (when lines (mapc (lambda (el) (add-to-body el)) lines)) ;; line + (when sets + (mapc (lambda (el) (add-to-body (format "set %s" el))) sets)) + (when x-labels + (add-to-body + (format "set xtics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + x-labels ", ")))) + (when y-labels + (add-to-body + (format "set ytics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + y-labels ", ")))) + (when time-ind + (add-to-body "set xdata time") + (add-to-body (concat "set timefmt \"" + (or timefmt + "%Y-%m-%d-%H:%M:%S") "\""))) + (when out-file (add-to-body (format "set output \"%s\"" out-file))) + (when term (add-to-body (format "set term %s" term))) + ;; insert variables into code body: this should happen last + ;; placing the variables at the *top* of the code in case their + ;; values are used later + (add-to-body (mapconcat #'identity + (org-babel-variable-assignments:gnuplot params) + "\n")) + ;; replace any variable names preceded by '$' with the actual + ;; value of the variable + (mapc (lambda (pair) + (setq body (replace-regexp-in-string + (format "\\$%s" (car pair)) (cdr pair) body))) + vars)) + body))) + +(defun org-babel-execute:gnuplot (body params) + "Execute a block of Gnuplot code. +This function is called by `org-babel-execute-src-block'." + (require 'gnuplot) + (let ((session (cdr (assoc :session params))) + (result-type (cdr (assoc :results params))) + (out-file (cdr (assoc :file params))) + (body (org-babel-expand-body:gnuplot body params)) + output) + (save-window-excursion + ;; evaluate the code body with gnuplot + (if (string= session "none") + (let ((script-file (org-babel-temp-file "gnuplot-script-"))) + (with-temp-file script-file + (insert (concat body "\n"))) + (message "gnuplot \"%s\"" script-file) + (setq output + (shell-command-to-string + (format + "gnuplot \"%s\"" + (org-babel-process-file-name script-file)))) + (message output)) + (with-temp-buffer + (insert (concat body "\n")) + (gnuplot-mode) + (gnuplot-send-buffer-to-gnuplot))) + (if (member "output" (split-string result-type)) + output + out-file)))) + +(defun org-babel-prep-session:gnuplot (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (let* ((session (org-babel-gnuplot-initiate-session session)) + (var-lines (org-babel-variable-assignments:gnuplot params))) + (message "%S" session) + (org-babel-comint-in-buffer session + (mapc (lambda (var-line) + (insert var-line) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines)) + session)) + +(defun org-babel-load-session:gnuplot (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:gnuplot session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +(defun org-babel-variable-assignments:gnuplot (params) + "Return list of gnuplot statements assigning the block's variables" + (mapcar + (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) + (org-babel-gnuplot-process-vars params))) + +(defvar gnuplot-buffer) +(defun org-babel-gnuplot-initiate-session (&optional session params) + "Initiate a gnuplot session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session. The current +`gnuplot-mode' doesn't provide support for multiple sessions." + (require 'gnuplot) + (unless (string= session "none") + (save-window-excursion + (gnuplot-send-string-to-gnuplot "" "line") + gnuplot-buffer))) + +(defun org-babel-gnuplot-quote-timestamp-field (s) + "Convert S from timestamp to Unix time and export to gnuplot." + (format-time-string org-babel-gnuplot-timestamp-fmt (org-time-string-to-time s))) + +(defvar org-table-number-regexp) +(defvar org-ts-regexp3) +(defun org-babel-gnuplot-quote-tsv-field (s) + "Quote S for export to gnuplot." + (unless (stringp s) + (setq s (format "%s" s))) + (if (string-match org-table-number-regexp s) s + (if (string-match org-ts-regexp3 s) + (org-babel-gnuplot-quote-timestamp-field s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")))) + +(defun org-babel-gnuplot-table-to-data (table data-file params) + "Export TABLE to DATA-FILE in a format readable by gnuplot. +Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." + (with-temp-file data-file + (make-local-variable 'org-babel-gnuplot-timestamp-fmt) + (setq org-babel-gnuplot-timestamp-fmt (or + (plist-get params :timefmt) + "%Y-%m-%d-%H:%M:%S")) + (insert (orgtbl-to-generic + table + (org-combine-plists + '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field) + params)))) + data-file) + +(provide 'ob-gnuplot) + +;; arch-tag: 50490ace-a9e1-4b29-a6e5-0db9f16c610b + +;;; ob-gnuplot.el ends here diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el new file mode 100644 index 00000000000..734e1f6c891 --- /dev/null +++ b/lisp/org/ob-haskell.el @@ -0,0 +1,217 @@ +;;; ob-haskell.el --- org-babel functions for haskell evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating haskell source code. This one will +;; be sort of tricky because haskell programs must be compiled before +;; they can be run, but haskell code can also be run through an +;; interactive interpreter. +;; +;; For now lets only allow evaluation using the haskell interpreter. + +;;; Requirements: + +;; - haskell-mode :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode +;; +;; - inf-haskell :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode +;; +;; - (optionally) lhs2tex :: http://people.cs.uu.nl/andres/lhs2tex/ + +;;; Code: +(require 'ob) +(require 'ob-comint) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function haskell-mode "ext:haskell-mode" ()) +(declare-function run-haskell "ext:inf-haskell" (&optional arg)) +(declare-function inferior-haskell-load-file + "ext:inf-haskell" (&optional reload)) + +(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) + +(defvar org-babel-default-header-args:haskell '()) + +(defvar org-babel-haskell-lhs2tex-command "lhs2tex") + +(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"") + +(defun org-babel-execute:haskell (body params) + "Execute a block of Haskell code." + (let* ((session (cdr (assoc :session params))) + (vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:haskell params))) + (session (org-babel-haskell-initiate-session session params)) + (raw (org-babel-comint-with-output + (session org-babel-haskell-eoe t full-body) + (insert (org-babel-trim full-body)) + (comint-send-input nil t) + (insert org-babel-haskell-eoe) + (comint-send-input nil t))) + (results (mapcar + #'org-babel-haskell-read-string + (cdr (member org-babel-haskell-eoe + (reverse (mapcar #'org-babel-trim raw))))))) + (org-babel-reassemble-table + (cond + ((equal result-type 'output) + (mapconcat #'identity (reverse (cdr results)) "\n")) + ((equal result-type 'value) + (org-babel-haskell-table-or-string (car results)))) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colname-names params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rowname-names params)))))) + +(defun org-babel-haskell-read-string (string) + "Strip \\\"s from around a haskell string." + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(defun org-babel-haskell-initiate-session (&optional session params) + "Initiate a haskell session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session." + (require 'inf-haskell) + (or (get-buffer "*haskell*") + (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer)))) + +(defun org-babel-load-session:haskell (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let* ((buffer (org-babel-prep-session:haskell session params)) + (load-file (concat (org-babel-temp-file "haskell-load-") ".hs"))) + (with-temp-buffer + (insert body) (write-file load-file) + (haskell-mode) (inferior-haskell-load-file)) + buffer))) + +(defun org-babel-prep-session:haskell (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (save-window-excursion + (let ((buffer (org-babel-haskell-initiate-session session))) + (org-babel-comint-in-buffer buffer + (mapc (lambda (line) + (insert line) + (comint-send-input nil t)) + (org-babel-variable-assignments:haskell params))) + (current-buffer)))) + +(defun org-babel-variable-assignments:haskell (params) + "Return list of haskell statements assigning the block's variables" + (mapcar (lambda (pair) + (format "let %s = %s" + (car pair) + (org-babel-haskell-var-to-haskell (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-haskell-table-or-string (results) + "Convert RESULTS to an Emacs-lisp table or string. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + +(defun org-babel-haskell-var-to-haskell (var) + "Convert an elisp value VAR into a haskell variable. +The elisp VAR is converted to a string of haskell source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]") + (format "%S" var))) + +(defvar org-src-preserve-indentation) +(defun org-babel-haskell-export-to-lhs (&optional arg) + "Export to a .lhs file with all haskell code blocks escaped. +When called with a prefix argument the resulting +.lhs file will be exported to a .tex file. This function will +create two new files, base-name.lhs and base-name.tex where +base-name is the name of the current org-mode file. + +Note that all standard Babel literate programming +constructs (header arguments, no-web syntax etc...) are ignored." + (interactive "P") + (let* ((contents (buffer-string)) + (haskell-regexp + (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)?[\r\n]" + "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*")) + (base-name (file-name-sans-extension (buffer-file-name))) + (tmp-file (org-babel-temp-file "haskell-")) + (tmp-org-file (concat tmp-file ".org")) + (tmp-tex-file (concat tmp-file ".tex")) + (lhs-file (concat base-name ".lhs")) + (tex-file (concat base-name ".tex")) + (command (concat org-babel-haskell-lhs2tex-command + " " (org-babel-process-file-name lhs-file) + " > " (org-babel-process-file-name tex-file))) + (preserve-indentp org-src-preserve-indentation) + indentation) + ;; escape haskell source-code blocks + (with-temp-file tmp-org-file + (insert contents) + (goto-char (point-min)) + (while (re-search-forward haskell-regexp nil t) + (save-match-data (setq indentation (length (match-string 1)))) + (replace-match (save-match-data + (concat + "#+begin_latex\n\\begin{code}\n" + (if (or preserve-indentp + (string-match "-i" (match-string 2))) + (match-string 3) + (org-remove-indentation (match-string 3))) + "\n\\end{code}\n#+end_latex\n")) + t t) + (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) + (save-excursion + ;; export to latex w/org and save as .lhs + (find-file tmp-org-file) (funcall 'org-export-as-latex nil) + (kill-buffer) + (delete-file tmp-org-file) + (find-file tmp-tex-file) + (goto-char (point-min)) (forward-line 2) + (insert "%include polycode.fmt\n") + ;; ensure all \begin/end{code} statements start at the first column + (while (re-search-forward "^[ \t]+\\\\begin{code}[^\000]+\\\\end{code}" nil t) + (replace-match (save-match-data (org-remove-indentation (match-string 0))) + t t)) + (setq contents (buffer-string)) + (save-buffer) (kill-buffer)) + (delete-file tmp-tex-file) + ;; save org exported latex to a .lhs file + (with-temp-file lhs-file (insert contents)) + (if (not arg) + (find-file lhs-file) + ;; process .lhs file with lhs2tex + (message "running %s" command) (shell-command command) (find-file tex-file)))) + +(provide 'ob-haskell) + +;; arch-tag: b53f75f3-ba1a-4b05-82d9-a2a0d4e70804 + +;;; ob-haskell.el ends here diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el new file mode 100644 index 00000000000..05f8ea41754 --- /dev/null +++ b/lisp/org/ob-js.el @@ -0,0 +1,165 @@ +;;; ob-js.el --- org-babel functions for Javascript + +;; Copyright (C) 2010 Free Software Foundation + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, js +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Now working with SBCL for both session and external evaluation. +;; +;; This certainly isn't optimally robust, but it seems to be working +;; for the basic use cases. + +;;; Requirements: + +;; - a non-browser javascript engine such as node.js http://nodejs.org/ +;; or mozrepl http://wiki.github.com/bard/mozrepl/ +;; +;; - for session based evaluation mozrepl and moz.el are required see +;; http://wiki.github.com/bard/mozrepl/emacs-integration for +;; configuration instructions + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function run-mozilla "ext:moz" (arg)) + +(defvar org-babel-default-header-args:js '() + "Default header arguments for js code blocks.") + +(defvar org-babel-js-eoe "org-babel-js-eoe" + "String to indicate that evaluation has completed.") + +(defcustom org-babel-js-cmd "node" + "Name of command used to evaluate js blocks." + :group 'org-babel + :type 'string) + +(defvar org-babel-js-function-wrapper + "require('sys').print(require('sys').inspect(function(){%s}()));" + "Javascript code to print value of body.") + +(defun org-babel-execute:js (body params) + "Execute a block of Javascript code with org-babel. +This function is called by `org-babel-execute-src-block'" + (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd)) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:js params)))) + (org-babel-js-read + (if (not (string= (cdr (assoc :session params)) "none")) + ;; session evaluation + (let ((session (org-babel-prep-session:js + (cdr (assoc :session params)) params))) + (nth 1 + (org-babel-comint-with-output + (session (format "%S" org-babel-js-eoe) t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body (format "%S" org-babel-js-eoe)))))) + ;; external evaluation + (let ((script-file (org-babel-temp-file "js-script-"))) + (with-temp-file script-file + (insert + ;; return the value or the output + (if (string= result-type "value") + (format org-babel-js-function-wrapper full-body) + full-body))) + (org-babel-eval + (format "%s %s" org-babel-js-cmd + (org-babel-process-file-name script-file)) "")))))) + +(defun org-babel-js-read (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-js-var-to-js (var) + "Convert VAR into a js variable. +Convert an elisp value into a string of js source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-js-var-to-js var ", ") "]") + (format "%S" var))) + +(defun org-babel-prep-session:js (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-js-initiate-session session)) + (var-lines (org-babel-variable-assignments:js params))) + (when session + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines))) + session)) + +(defun org-babel-variable-assignments:js (params) + "Return list of Javascript statements assigning the block's variables" + (mapcar + (lambda (pair) (format "var %s=%s;" + (car pair) (org-babel-js-var-to-js (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-js-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (unless (string= session "none") + (cond + ((string= "mozrepl" org-babel-js-cmd) + (require 'moz) + (let ((session-buffer (save-window-excursion + (run-mozilla nil) + (rename-buffer session) + (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-js-initiate-session session)))) + ((string= "node" org-babel-js-cmd ) + (error "session evaluation with node.js is not supported")) + (t + (error "sessions are only supported with mozrepl add \":cmd mozrepl\""))))) + +(provide 'ob-js) + +;; arch-tag: 84401fb3-b8d9-4bb6-9a90-cbe2d103d494 + +;;; ob-js.el ends here diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el new file mode 100644 index 00000000000..af8190692cd --- /dev/null +++ b/lisp/org/ob-keys.el @@ -0,0 +1,98 @@ +;;; ob-keys.el --- key bindings for org-babel + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Add org-babel keybindings to the org-mode keymap for exposing +;; org-babel functions. These will all share a common prefix. See +;; the value of `org-babel-key-bindings' for a list of interactive +;; functions and their associated keys. + +;;; Code: +(require 'ob) + +(defvar org-babel-key-prefix "\C-c\C-v" + "The key prefix for Babel interactive key-bindings. +See `org-babel-key-bindings' for the list of interactive babel +functions which are assigned key bindings, and see +`org-babel-map' for the actual babel keymap.") + +(defvar org-babel-map (make-sparse-keymap) + "The keymap for interactive Babel functions.") + +;;;###autoload +(defun org-babel-describe-bindings () + "Describe all keybindings behind `org-babel-key-prefix'." + (interactive) + (describe-bindings org-babel-key-prefix)) + +(defvar org-babel-key-bindings + '(("p" . org-babel-previous-src-block) + ("\C-p" . org-babel-previous-src-block) + ("n" . org-babel-next-src-block) + ("\C-n" . org-babel-next-src-block) + ("e" . org-babel-execute-maybe) + ("\C-e" . org-babel-execute-maybe) + ("o" . org-babel-open-src-block-result) + ("\C-o" . org-babel-open-src-block-result) + ("\C-v" . org-babel-expand-src-block) + ("v" . org-babel-expand-src-block) + ("u" . org-babel-goto-src-block-head) + ("\C-u" . org-babel-goto-src-block-head) + ("g" . org-babel-goto-named-src-block) + ("r" . org-babel-goto-named-result) + ("\C-r" . org-babel-goto-named-result) + ("\C-b" . org-babel-execute-buffer) + ("b" . org-babel-execute-buffer) + ("\C-s" . org-babel-execute-subtree) + ("s" . org-babel-execute-subtree) + ("\C-d" . org-babel-demarcate-block) + ("d" . org-babel-demarcate-block) + ("\C-t" . org-babel-tangle) + ("t" . org-babel-tangle) + ("\C-f" . org-babel-tangle-file) + ("f" . org-babel-tangle-file) + ("\C-l" . org-babel-load-in-session) + ("l" . org-babel-load-in-session) + ("\C-i" . org-babel-lob-ingest) + ("i" . org-babel-lob-ingest) + ("\C-z" . org-babel-switch-to-session) + ("z" . org-babel-switch-to-session-with-code) + ("\C-a" . org-babel-sha1-hash) + ("a" . org-babel-sha1-hash) + ("h" . org-babel-describe-bindings) + ("\C-x" . org-babel-do-key-sequence-in-edit-buffer) + ("x" . org-babel-do-key-sequence-in-edit-buffer) + ("\C-\M-h" . org-babel-mark-block)) + "Alist of key bindings and interactive Babel functions. +This list associates interactive Babel functions +with keys. Each element of this list will add an entry to the +`org-babel-map' using the letter key which is the `car' of the +a-list placed behind the generic `org-babel-key-prefix'.") + +(provide 'ob-keys) + +;; arch-tag: 01e348ee-4906-46fa-839a-6b7b6f989048 + +;;; ob-keys.el ends here diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el new file mode 100644 index 00000000000..96afbcd92a6 --- /dev/null +++ b/lisp/org/ob-latex.el @@ -0,0 +1,180 @@ +;;; ob-latex.el --- org-babel functions for latex "evaluation" + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating LaTeX source code. +;; +;; Currently on evaluation this returns raw LaTeX code, unless a :file +;; header argument is given in which case small png or pdf files will +;; be created directly form the latex source code. + +;;; Code: +(require 'ob) + +(declare-function org-create-formula-image "org" (string tofile options buffer)) +(declare-function org-splice-latex-header "org" + (tpl def-pkg pkg snippets-p &optional extra)) +(declare-function org-export-latex-fix-inputenc "org-latex" ()) +(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) + +(defvar org-format-latex-header) +(defvar org-format-latex-header-extra) +(defvar org-export-latex-packages-alist) +(defvar org-export-latex-default-packages-alist) +(defvar org-export-pdf-logfiles) +(defvar org-latex-to-pdf-process) +(defvar org-export-pdf-remove-logfiles) +(defvar org-format-latex-options) +(defvar org-export-latex-packages-alist) + +(defvar org-babel-default-header-args:latex + '((:results . "latex") (:exports . "results")) + "Default arguments to use when evaluating a LaTeX source block.") + +(defun org-babel-expand-body:latex (body params) + "Expand BODY according to PARAMS, return the expanded body." + (mapc (lambda (pair) ;; replace variables + (setq body + (replace-regexp-in-string + (regexp-quote (format "%S" (car pair))) + (if (stringp (cdr pair)) + (cdr pair) (format "%S" (cdr pair))) + body))) (mapcar #'cdr (org-babel-get-header params :var))) + (org-babel-trim body)) + +(defun org-babel-execute:latex (body params) + "Execute a block of Latex code with Babel. +This function is called by `org-babel-execute-src-block'." + (setq body (org-babel-expand-body:latex body params)) + (if (cdr (assoc :file params)) + (let* ((out-file (cdr (assoc :file params))) + (tex-file (org-babel-temp-file "latex-" ".tex")) + (border (cdr (assoc :border params))) + (fit (or (cdr (assoc :fit params)) border)) + (height (and fit (cdr (assoc :pdfheight params)))) + (width (and fit (cdr (assoc :pdfwidth params)))) + (headers (cdr (assoc :headers params))) + (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) + (org-export-latex-packages-alist + (append (cdr (assoc :packages params)) + org-export-latex-packages-alist))) + (cond + ((string-match "\\.png$" out-file) + (org-create-formula-image + body out-file org-format-latex-options in-buffer)) + ((string-match "\\.pdf$" out-file) + (require 'org-latex) + (with-temp-file tex-file + (insert + (org-splice-latex-header + org-format-latex-header + (delq + nil + (mapcar + (lambda (el) + (unless (and (listp el) (string= "hyperref" (cadr el))) + el)) + org-export-latex-default-packages-alist)) + org-export-latex-packages-alist + org-format-latex-header-extra) + (if fit "\n\\usepackage[active, tightpage]{preview}\n" "") + (if border (format "\\setlength{\\PreviewBorder}{%s}" border) "") + (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") + (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "") + (if headers + (concat "\n" + (if (listp headers) + (mapconcat #'identity headers "\n") + headers) "\n") + "") + (if org-format-latex-header-extra + (concat "\n" org-format-latex-header-extra) + "") + (if fit + (concat "\n\\begin{document}\n\\begin{preview}\n" body + "\n\\end{preview}\n\\end{document}\n") + (concat "\n\\begin{document}\n" body "\n\\end{document}\n"))) + (org-export-latex-fix-inputenc)) + (when (file-exists-p out-file) (delete-file out-file)) + (rename-file (org-babel-latex-tex-to-pdf tex-file) out-file)) + ((string-match "\\.\\([^\\.]+\\)$" out-file) + (error "can not create %s files, please specify a .png or .pdf file" + (match-string 1 out-file)))) + out-file) + body)) + +(defun org-babel-latex-tex-to-pdf (file) + "Generate a pdf file according to the contents FILE. +Extracted from `org-export-as-pdf' in org-latex.el." + (let* ((wconfig (current-window-configuration)) + (default-directory (file-name-directory file)) + (base (file-name-sans-extension file)) + (pdffile (concat base ".pdf")) + (cmds org-latex-to-pdf-process) + (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) + output-dir cmd) + (with-current-buffer outbuf (erase-buffer)) + (message (concat "Processing LaTeX file " file "...")) + (setq output-dir (file-name-directory file)) + (if (and cmds (symbolp cmds)) + (funcall cmds (shell-quote-argument file)) + (while cmds + (setq cmd (pop cmds)) + (while (string-match "%b" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument base)) + t t cmd))) + (while (string-match "%f" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument file)) + t t cmd))) + (while (string-match "%o" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument output-dir)) + t t cmd))) + (shell-command cmd outbuf))) + (message (concat "Processing LaTeX file " file "...done")) + (if (not (file-exists-p pdffile)) + (error (concat "PDF file " pdffile " was not produced")) + (set-window-configuration wconfig) + (when org-export-pdf-remove-logfiles + (dolist (ext org-export-pdf-logfiles) + (setq file (concat base "." ext)) + (and (file-exists-p file) (delete-file file)))) + (message "Exporting to PDF...done") + pdffile))) + +(defun org-babel-prep-session:latex (session params) + "Return an error because LaTeX doesn't support sesstions." + (error "LaTeX does not support sessions")) + +(provide 'ob-latex) + +;; arch-tag: 1f13f7e2-26de-4c24-9274-9f331d4c6ff3 + +;;; ob-latex.el ends here diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el new file mode 100644 index 00000000000..a02eb6fec86 --- /dev/null +++ b/lisp/org/ob-ledger.el @@ -0,0 +1,72 @@ +;;; ob-ledger.el --- org-babel functions for ledger evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric S Fraga +;; Keywords: literate programming, reproducible research, accounting +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating ledger entries. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in ledger +;; +;; 2) we are generally only going to return output from the leger program +;; +;; 3) we are adding the "cmdline" header argument +;; +;; 4) there are no variables + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:ledger + '((:results . "output") (:cmdline . "bal")) + "Default arguments to use when evaluating a ledger source block.") + +(defun org-babel-execute:ledger (body params) + "Execute a block of Ledger entries with org-babel. This function is +called by `org-babel-execute-src-block'." + (message "executing Ledger source code block") + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "ledger-")) + (out-file (org-babel-temp-file "ledger-output-"))) + (with-temp-file in-file (insert body)) + (message (concat "ledger" + " -f " (org-babel-process-file-name in-file) + " " cmdline)) + (with-output-to-string + (shell-command (concat "ledger" + " -f " (org-babel-process-file-name in-file) + " " cmdline + " > " (org-babel-process-file-name out-file)))) + (with-temp-buffer (insert-file-contents out-file) (buffer-string)))) + +(defun org-babel-prep-session:ledger (session params) + (error "Ledger does not support sessions")) + +(provide 'ob-ledger) + +;; arch-tag: 7bbb529e-95a1-4236-9d29-b0000b918c7c + +;;; ob-ledger.el ends here diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el new file mode 100644 index 00000000000..600b79ee7af --- /dev/null +++ b/lisp/org/ob-lisp.el @@ -0,0 +1,113 @@ +;;; ob-lisp.el --- org-babel functions for Common Lisp + +;; Copyright (C) 2010 Free Software Foundation + +;; Author: David T. O'Toole <dto@gnu.org>, Eric Schulte +;; Keywords: literate programming, reproducible research, lisp +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Now working with SBCL for both session and external evaluation. +;; +;; This certainly isn't optimally robust, but it seems to be working +;; for the basic use cases. + +;;; Requirements: + +;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.) +;; See http://common-lisp.net/project/slime/ + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) + +(declare-function slime-eval "ext:slime" (sexp &optional package)) +(declare-function slime-process "ext:slime" (&optional connection)) +(declare-function slime-connected-p "ext:slime" ()) + +(defvar org-babel-default-header-args:lisp '() + "Default header arguments for lisp code blocks.") + +(defcustom org-babel-lisp-cmd "sbcl --script" + "Name of command used to evaluate lisp blocks." + :group 'org-babel + :type 'string) + +(defun org-babel-expand-body:lisp (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (if (> (length vars) 0) + (concat "(let (" + (mapconcat + (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body ")") + body))) + +(defun org-babel-execute:lisp (body params) + "Execute a block of Lisp code with org-babel. +This function is called by `org-babel-execute-src-block'" + (require 'slime) + (message "executing Lisp source code block") + (let* ((session (org-babel-lisp-initiate-session + (cdr (assoc :session params)))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:lisp body params))) + (read + (if session + ;; session evaluation + (save-window-excursion + (cadr (slime-eval `(swank:eval-and-grab-output ,full-body)))) + ;; external evaluation + (let ((script-file (org-babel-temp-file "lisp-script-"))) + (with-temp-file script-file + (insert + ;; return the value or the output + (if (string= result-type "value") + (format "(print %s)" full-body) + full-body))) + (org-babel-eval + (format "%s %s" org-babel-lisp-cmd + (org-babel-process-file-name script-file)) "")))))) + +;; This function should be used to assign any variables in params in +;; the context of the session environment. +(defun org-babel-prep-session:lisp (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "not yet implemented")) + +(defun org-babel-lisp-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (require 'slime) + (unless (string= session "none") + (save-window-excursion + (or (slime-connected-p) + (slime-process))))) + +(provide 'ob-lisp) + +;; arch-tag: 18086168-009f-4947-bbb5-3532375d851d + +;;; ob-lisp.el ends here diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el new file mode 100644 index 00000000000..137a6bce9a3 --- /dev/null +++ b/lisp/org/ob-lob.el @@ -0,0 +1,124 @@ +;;; ob-lob.el --- functions supporting the Library of Babel + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; See the online documentation for more information +;; +;; http://orgmode.org/worg/org-contrib/babel/ + +;;; Code: +(require 'ob) +(require 'ob-table) + +(defvar org-babel-library-of-babel nil + "Library of source-code blocks. +This is an association list. Populate the library by adding +files to `org-babel-lob-files'.") + +(defcustom org-babel-lob-files '() + "Files used to populate the `org-babel-library-of-babel'. +To add files to this list use the `org-babel-lob-ingest' command." + :group 'org-babel + :type 'list) + +;;;###autoload +(defun org-babel-lob-ingest (&optional file) + "Add all named source-blocks defined in FILE to +`org-babel-library-of-babel'." + (interactive "f") + (let ((lob-ingest-count 0)) + (org-babel-map-src-blocks file + (let* ((info (org-babel-get-src-block-info 'light)) + (source-name (nth 4 info))) + (when source-name + (setq source-name (intern source-name) + org-babel-library-of-babel + (cons (cons source-name info) + (assq-delete-all source-name org-babel-library-of-babel)) + lob-ingest-count (1+ lob-ingest-count))))) + (message "%d src block%s added to Library of Babel" + lob-ingest-count (if (> lob-ingest-count 1) "s" "")) + lob-ingest-count)) + +(defconst org-babel-lob-call-aliases '("lob" "call") + "Aliases to call a source block function. +If you change the value of this variable then your files may + become unusable by other org-babel users, and vice versa.") + +(defconst org-babel-lob-one-liner-regexp + (concat + "^\\([ \t]*\\)#\\+\\(?:" + (mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|") + "\\):[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)" + "\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\([^\n]*\\)") + "Regexp to match calls to predefined source block functions.") + +;; functions for executing lob one-liners +;;;###autoload +(defun org-babel-lob-execute-maybe () + "Execute a Library of Babel source block, if appropriate. +Detect if this is context for a Library Of Babel source block and +if so then run the appropriate source block from the Library." + (interactive) + (let ((info (org-babel-lob-get-info))) + (if (nth 0 info) (progn (org-babel-lob-execute info) t) nil))) + +;;;###autoload +(defun org-babel-lob-get-info () + "Return a Library of Babel function call as a string." + (let ((case-fold-search t)) + (save-excursion + (beginning-of-line 1) + (if (looking-at org-babel-lob-one-liner-regexp) + (append + (mapcar #'org-babel-clean-text-properties + (list + (format "%s%s(%s)%s" + (match-string 2) + (if (match-string 4) + (concat "[" (match-string 4) "]") "") + (or (match-string 6) "") (match-string 7)) + (match-string 8))) + (list (length (match-string 1)))))))) + +(defun org-babel-lob-execute (info) + "Execute the lob call specified by INFO." + (let ((params (org-babel-process-params + (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-babel-clean-text-properties + (concat ":var results=" + (mapconcat #'identity (butlast info) " ")))))))) + (org-babel-execute-src-block + nil (list "emacs-lisp" "results" params nil nil (nth 2 info))))) + +(provide 'ob-lob) + +;; arch-tag: ce0712c9-2147-4019-ba3f-42341b8b474b + +;;; ob-lob.el ends here diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el new file mode 100644 index 00000000000..192c73d9081 --- /dev/null +++ b/lisp/org/ob-matlab.el @@ -0,0 +1,48 @@ +;;; ob-matlab.el --- org-babel support for matlab evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Functions that are common to org-babel support for matlab and +;; octave are in org-babel-octave.el + +;;; Requirements: + +;; Matlab + +;; matlab.el required for interactive emacs sessions and matlab-mode +;; major mode for source code editing buffer +;; http://matlab-emacs.sourceforge.net/ + +;;; Code: +(require 'ob) +(require 'ob-octave) + +;; see ob-octave for matlab implementation + +(provide 'ob-matlab) + +;; arch-tag: 6b234299-c1f7-4eb1-ace8-7b93344065ac + +;;; ob-matlab.el ends here diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el new file mode 100644 index 00000000000..98230da56a3 --- /dev/null +++ b/lisp/org/ob-mscgen.el @@ -0,0 +1,86 @@ +;;; ob-msc.el --- org-babel functions for mscgen evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Juan Pechiar +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This software provides EMACS org-babel export support for message +;; sequence charts. The mscgen utility is used for processing the +;; sequence definition, and must therefore be installed in the system. +;; +;; Mscgen is available and documented at +;; http://www.mcternan.me.uk/mscgen/index.html +;; +;; This code is directly inspired by Eric Schulte's ob-dot.el +;; +;; Example: +;; +;; #+begin_src mscgen :file example.png +;; msc { +;; A,B; +;; A -> B [ label = "send message" ]; +;; A <- B [ label = "get answer" ]; +;; } +;; #+end_src +;; +;; Header for alternative file type: +;; +;; #+begin_src mscgen :file ex2.svg :filetype svg + +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in mscgen +;; 2) we are generally only going to return results of type "file" +;; 3) we are adding the "file" and "filetype" header arguments +;; 4) there are no variables + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:mscgen + '((:results . "file") (:exports . "results")) + "Default arguments to use when evaluating a mscgen source block.") + +(defun org-babel-execute:mscgen (body params) + "Execute a block of Mscgen code with Babel. +This function is called by `org-babel-execute-src-block'. +Default filetype is png. Modify by setting :filetype parameter to +mscgen supported formats." + (let* ((out-file (or (cdr (assoc :file params)) "output.png" )) + (filetype (or (cdr (assoc :filetype params)) "png" ))) + (unless (cdr (assoc :file params)) + (error " +ERROR: no output file specified. Add \":file name.png\" to the src header")) + (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) + out-file)) + +(defun org-babel-prep-session:mscgen (session params) + "Raise an error because Mscgen doesn't support sessions." + (error "Mscgen does not support sessions")) + +(provide 'ob-mscgen) + +;; arch-tag: 74695b1e-715f-4b5a-a3a9-d78ee39ba5c8 + +;;; ob-msc.el ends here diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el new file mode 100644 index 00000000000..459dcf336f7 --- /dev/null +++ b/lisp/org/ob-ocaml.el @@ -0,0 +1,157 @@ +;;; ob-ocaml.el --- org-babel functions for ocaml evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating ocaml source code. This one will +;; be sort of tricky because ocaml programs must be compiled before +;; they can be run, but ocaml code can also be run through an +;; interactive interpreter. +;; +;; For now lets only allow evaluation using the ocaml interpreter. + +;;; Requirements: + +;; - tuareg-mode :: http://www-rocq.inria.fr/~acohen/tuareg/ + +;;; Code: +(require 'ob) +(require 'ob-comint) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function tuareg-run-caml "ext:tuareg" ()) +(declare-function tuareg-interactive-send-input "ext:tuareg" ()) + +(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml")) + +(defvar org-babel-default-header-args:ocaml '()) + +(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;") +(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe") + +(defun org-babel-execute:ocaml (body params) + "Execute a block of Ocaml code with Babel." + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (full-body (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:ocaml params))) + (session (org-babel-prep-session:ocaml + (cdr (assoc :session params)) params)) + (raw (org-babel-comint-with-output + (session org-babel-ocaml-eoe-output t full-body) + (insert + (concat + (org-babel-chomp full-body)"\n"org-babel-ocaml-eoe-indicator)) + (tuareg-interactive-send-input))) + (clean + (car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out) + (delq nil (mapcar (lambda (line) + (if out + (progn (setq out nil) line) + (when (string-match re line) + (progn (setq out t) nil)))) + (mapcar #'org-babel-trim (reverse raw)))))))) + (org-babel-reassemble-table + (org-babel-ocaml-parse-output (org-babel-trim clean)) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + +(defvar tuareg-interactive-buffer-name) +(defun org-babel-prep-session:ocaml (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (require 'tuareg) + (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none")) + (not (string= session "default")) + (stringp session)) + session + tuareg-interactive-buffer-name))) + (save-window-excursion (tuareg-run-caml) + (get-buffer tuareg-interactive-buffer-name)))) + +(defun org-babel-variable-assignments:ocaml (params) + "Return list of ocaml statements assigning the block's variables" + (mapcar + (lambda (pair) (format "let %s = %s;;" (car pair) + (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-ocaml-elisp-to-ocaml (val) + "Return a string of ocaml code which evaluates to VAL." + (if (listp val) + (concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]") + (format "%S" val))) + +(defun org-babel-ocaml-parse-output (output) + "Parse OUTPUT. +OUTPUT is string output from an ocaml process." + (let ((regexp "%s = \\(.+\\)$")) + (cond + ((string-match (format regexp "string") output) + (org-babel-read (match-string 1 output))) + ((or (string-match (format regexp "int") output) + (string-match (format regexp "float") output)) + (string-to-number (match-string 1 output))) + ((string-match (format regexp "list") output) + (org-babel-ocaml-read-list (match-string 1 output))) + ((string-match (format regexp "array") output) + (org-babel-ocaml-read-array (match-string 1 output))) + (t (message "don't recognize type of %s" output) output)))) + +(defun org-babel-ocaml-read-list (results) + "Convert RESULTS into an elisp table or string. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + "; " " " (replace-regexp-in-string + "'" "\"" results))))) + results))) + +(defun org-babel-ocaml-read-array (results) + "Convert RESULTS into an elisp table or string. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat + "'" (replace-regexp-in-string + "\\[|" "(" (replace-regexp-in-string + "|\\]" ")" (replace-regexp-in-string + "; " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(provide 'ob-ocaml) + +;; arch-tag: 2e815f4d-365e-4d69-b1df-dd17fdd7b7b7 + +;;; ob-ocaml.el ends here diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el new file mode 100644 index 00000000000..9fcd825f91e --- /dev/null +++ b/lisp/org/ob-octave.el @@ -0,0 +1,264 @@ +;;; ob-octave.el --- org-babel functions for octave and matlab evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Requirements: + +;; octave +;; octave-mode.el and octave-inf.el come with GNU emacs + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function matlab-shell "ext:matlab-mode") +(declare-function matlab-shell-run-region "ext:matlab-mode") + +(defvar org-babel-default-header-args:matlab '()) +(defvar org-babel-default-header-args:octave '()) + +(defvar org-babel-matlab-shell-command "matlab -nosplash" + "Shell command to run matlab as an external process.") +(defvar org-babel-octave-shell-command "octave -q" + "Shell command to run octave as an external process.") + +(defvar org-babel-matlab-with-emacs-link nil + "If non-nil use matlab-shell-run-region for session evaluation. + This will use EmacsLink if (matlab-with-emacs-link) evaluates + to a non-nil value.") + +(defvar org-babel-matlab-emacs-link-wrapper-method + "%s +if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); +else, save -ascii %s ans +end +delete('%s') +") +(defvar org-babel-octave-wrapper-method + "%s +if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); +else, dlmwrite('%s', ans, '\\t') +end") + +(defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'") + +(defvar org-babel-octave-eoe-output "ans = org_babel_eoe") + +(defun org-babel-execute:matlab (body params) + "Execute a block of matlab code with Babel." + (org-babel-execute:octave body params 'matlab)) + +(defun org-babel-execute:octave (body params &optional matlabp) + "Execute a block of octave code with Babel." + (let* ((session + (funcall (intern (format "org-babel-%s-initiate-session" + (if matlabp "matlab" "octave"))) + (cdr (assoc :session params)) params)) + (vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (out-file (cdr (assoc :file params))) + (full-body + (org-babel-expand-body:generic + body params (org-babel-variable-assignments:octave params))) + (result (org-babel-octave-evaluate + session full-body result-type matlabp))) + (or out-file + (org-babel-reassemble-table + result + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + +(defun org-babel-prep-session:matlab (session params) + "Prepare SESSION according to PARAMS." + (org-babel-prep-session:octave session params 'matlab)) + +(defun org-babel-variable-assignments:octave (params) + "Return list of octave statements assigning the block's variables" + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-octave-var-to-octave (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defalias 'org-babel-variable-assignments:matlab + 'org-babel-variable-assignments:octave) + +(defun org-babel-octave-var-to-octave (var) + "Convert an emacs-lisp value into an octave variable. +Converts an emacs-lisp variable into a string of octave code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-octave-var-to-octave var + (if (listp (car var)) "; " ",")) "]") + (format "%s" (or var "nil")))) + +(defun org-babel-prep-session:octave (session params &optional matlabp) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-octave-initiate-session session params matlabp)) + (var-lines (org-babel-variable-assignments:octave params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-matlab-initiate-session (&optional session params) + "Create a matlab inferior process buffer. +If there is not a current inferior-process-buffer in SESSION then +create. Return the initialized session." + (org-babel-octave-initiate-session session params 'matlab)) + +(defun org-babel-octave-initiate-session (&optional session params matlabp) + "Create an octave inferior process buffer. +If there is not a current inferior-process-buffer in SESSION then +create. Return the initialized session." + (if matlabp (require 'matlab) (require 'octave-inf)) + (unless (string= session "none") + (let ((session (or session + (if matlabp "*Inferior Matlab*" "*Inferior Octave*")))) + (if (org-babel-comint-buffer-livep session) session + (save-window-excursion + (if matlabp (unless org-babel-matlab-with-emacs-link (matlab-shell)) + (run-octave)) + (rename-buffer (if (bufferp session) (buffer-name session) + (if (stringp session) session (buffer-name)))) + (current-buffer)))))) + +(defun org-babel-octave-evaluate + (session body result-type &optional matlabp) + "Pass BODY to the octave process in SESSION. +If RESULT-TYPE equals 'output then return the outputs of the +statements in BODY, if RESULT-TYPE equals 'value then return the +value of the last statement in BODY, as elisp." + (if session + (org-babel-octave-evaluate-session session body result-type matlabp) + (org-babel-octave-evaluate-external-process body result-type matlabp))) + +(defun org-babel-octave-evaluate-external-process (body result-type matlabp) + "Evaluate BODY in an external octave process." + (let ((cmd (if matlabp + org-babel-matlab-shell-command + org-babel-octave-shell-command))) + (case result-type + (output (org-babel-eval cmd body)) + (value (let ((tmp-file (org-babel-temp-file "octave-"))) + (org-babel-eval + cmd + (format org-babel-octave-wrapper-method body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-octave-import-elisp-from-file tmp-file)))))) + +(defun org-babel-octave-evaluate-session + (session body result-type &optional matlabp) + "Evaluate BODY in SESSION." + (let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-"))) + (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-")) + (full-body + (case result-type + (output + (mapconcat + #'org-babel-chomp + (list body org-babel-octave-eoe-indicator) "\n")) + (value + (if (and matlabp org-babel-matlab-with-emacs-link) + (concat + (format org-babel-matlab-emacs-link-wrapper-method + body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote) wait-file) "\n") + (mapconcat + #'org-babel-chomp + (list (format org-babel-octave-wrapper-method + body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote)) + org-babel-octave-eoe-indicator) "\n"))))) + (raw (if (and matlabp org-babel-matlab-with-emacs-link) + (save-window-excursion + (with-temp-buffer + (insert full-body) + (write-region "" 'ignored wait-file nil nil nil 'excl) + (matlab-shell-run-region (point-min) (point-max)) + (message "Waiting for Matlab Emacs Link") + (while (file-exists-p wait-file) (sit-for 0.01)) + "")) ;; matlab-shell-run-region doesn't seem to + ;; make *matlab* buffer contents easily + ;; available, so :results output currently + ;; won't work + (org-babel-comint-with-output + (session + (if matlabp + org-babel-octave-eoe-indicator + org-babel-octave-eoe-output) + t full-body) + (insert full-body) (comint-send-input nil t)))) results) + (case result-type + (value + (org-babel-octave-import-elisp-from-file tmp-file)) + (output + (progn + (setq results + (if matlabp + (cdr (reverse (delq "" (mapcar + #'org-babel-octave-read-string + (mapcar #'org-babel-trim raw))))) + (cdr (member org-babel-octave-eoe-output + (reverse (mapcar + #'org-babel-octave-read-string + (mapcar #'org-babel-trim raw))))))) + (mapconcat #'identity (reverse results) "\n")))))) + +(defun org-babel-octave-import-elisp-from-file (file-name) + "Import data from FILE-NAME. +This removes initial blank and comment lines and then calls +`org-babel-import-elisp-from-file'." + (let ((temp-file (org-babel-temp-file "octave-matlab-")) beg end) + (with-temp-file temp-file + (insert-file-contents file-name) + (re-search-forward "^[ \t]*[^# \t]" nil t) + (if (< (setq beg (point-min)) + (setq end (point-at-bol))) + (delete-region beg end))) + (org-babel-import-elisp-from-file temp-file '(16)))) + +(defun org-babel-octave-read-string (string) + "Strip \\\"s from around octave string" + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(provide 'ob-octave) + +;; arch-tag: d8e5f68b-ba13-440a-a495-b653e989e704 + +;;; ob-octave.el ends here diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el new file mode 100644 index 00000000000..c03fa07602a --- /dev/null +++ b/lisp/org/ob-org.el @@ -0,0 +1,62 @@ +;;; ob-org.el --- org-babel functions for org code block evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This is the simplest of code blocks, where upon evaluation the +;; contents of the code block are returned in a raw result. + +;;; Code: +(require 'ob) + +(declare-function org-export-string "org-exp" (string fmt &optional dir)) + +(defvar org-babel-default-header-args:org + '((:results . "raw silent") (:exports . "results")) + "Default arguments for evaluating a org source block.") + +(defvar org-babel-org-default-header + "#+TITLE: default empty header\n" + "Default header inserted during export of org blocks.") + +(defun org-babel-execute:org (body params) + "Execute a block of Org code with. +This function is called by `org-babel-execute-src-block'." + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (body (replace-regexp-in-string "^," "" body))) + (cond + ((member "latex" result-params) (org-export-string body "latex")) + ((member "html" result-params) (org-export-string body "html")) + ((member "ascii" result-params) (org-export-string body "ascii")) + (t body)))) + +(defun org-babel-prep-session:org (session params) + "Return an error because org does not support sessions." + (error "Org does not support sessions")) + +(provide 'ob-org) + +;; arch-tag: 130af5fe-cc56-46bd-9508-fa0ebd94cb1f + +;;; ob-org.el ends here diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el new file mode 100644 index 00000000000..1e0cecb1af0 --- /dev/null +++ b/lisp/org/ob-perl.el @@ -0,0 +1,117 @@ +;;; ob-perl.el --- org-babel functions for perl evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Dan Davison, Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating perl source code. + +;;; Code: +(require 'ob) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl")) + +(defvar org-babel-default-header-args:perl '()) + +(defvar org-babel-perl-command "perl" + "Name of command to use for executing perl code.") + +(defun org-babel-execute:perl (body params) + "Execute a block of Perl code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (cdr (assoc :session params))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:perl params))) + (session (org-babel-perl-initiate-session session))) + (org-babel-reassemble-table + (org-babel-perl-evaluate session full-body result-type) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:perl (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (error "Sessions are not supported for Perl.")) + +(defun org-babel-variable-assignments:perl (params) + "Return list of perl statements assigning the block's variables" + (mapcar + (lambda (pair) + (format "$%s=%s;" + (car pair) + (org-babel-perl-var-to-perl (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +;; helper functions + +(defun org-babel-perl-var-to-perl (var) + "Convert an elisp value to a perl variable. +The elisp value, VAR, is converted to a string of perl source code +specifying a var of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-perl-var-to-perl var ", ") "]") + (format "%S" var))) + +(defvar org-babel-perl-buffers '(:default . nil)) + +(defun org-babel-perl-initiate-session (&optional session params) + "Return nil because sessions are not supported by perl" +nil) + +(defvar org-babel-perl-wrapper-method + " +sub main { +%s +} +@r = main; +open(o, \">%s\"); +print o join(\"\\n\", @r), \"\\n\"") + +(defvar org-babel-perl-pp-wrapper-method + nil) + +(defun org-babel-perl-evaluate (session body &optional result-type) + "Pass BODY to the Perl process in SESSION. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (when session (error "Sessions are not supported for Perl.")) + (case result-type + (output (org-babel-eval org-babel-perl-command body)) + (value (let ((tmp-file (org-babel-temp-file "perl-"))) + (org-babel-eval + org-babel-perl-command + (format org-babel-perl-wrapper-method body + (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-eval-read-file tmp-file))))) + +(provide 'ob-perl) + +;; arch-tag: 88ef9396-d857-4dc3-8946-5a72bdfa2337 + +;;; ob-perl.el ends here diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el new file mode 100644 index 00000000000..fb81dc8e60d --- /dev/null +++ b/lisp/org/ob-plantuml.el @@ -0,0 +1,83 @@ +;;; ob-plantuml.el --- org-babel functions for plantuml evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Zhang Weize +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating plantuml script. +;; +;; Inspired by Ian Yang's org-export-blocks-format-plantuml +;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el + +;;; Requirements: + +;; plantuml | http://plantuml.sourceforge.net/ +;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:plantuml + '((:results . "file") (:exports . "results")) + "Default arguments for evaluating a plantuml source block.") + +(defcustom org-plantuml-jar-path nil + "Path to the plantuml.jar file." + :group 'org-babel + :type 'string) + +(defun org-babel-execute:plantuml (body params) + "Execute a block of plantuml code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (or (cdr (assoc :file params)) + (error "plantuml requires a \":file\" header argument"))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "plantuml-")) + (cmd (if (not org-plantuml-jar-path) + (error "`org-plantuml-jar-path' is not set") + (concat "java -jar " + (shell-quote-argument + (expand-file-name org-plantuml-jar-path)) + (if (string= (file-name-extension out-file) "svg") + " -tsvg" "") + " -p " cmdline " < " + (org-babel-process-file-name in-file) + " > " + (org-babel-process-file-name out-file))))) + (unless (file-exists-p org-plantuml-jar-path) + (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) + (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) + (message "%s" cmd) (org-babel-eval cmd "") + out-file)) + +(defun org-babel-prep-session:plantuml (session params) + "Return an error because plantuml does not support sessions." + (error "Plantuml does not support sessions")) + +(provide 'ob-plantuml) + +;; arch-tag: 451f50c5-e779-407e-ad64-70e0e8f161d1 + +;;; ob-plantuml.el ends here diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el new file mode 100644 index 00000000000..27b69bff5ab --- /dev/null +++ b/lisp/org/ob-python.el @@ -0,0 +1,282 @@ +;;; ob-python.el --- org-babel functions for python evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating python source code. + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function org-remove-indentation "org" ) +(declare-function py-shell "ext:python-mode" (&optional argprompt)) +(declare-function run-python "ext:python" (&optional cmd noshow new)) + +(add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) + +(defvar org-babel-default-header-args:python '()) + +(defvar org-babel-python-command "python" + "Name of command for executing python code.") + +(defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python) + "Preferred python mode for use in running python interactively.") + +(defvar org-src-preserve-indentation) + +(defun org-babel-execute:python (body params) + "Execute a block of Python code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (org-babel-python-initiate-session + (cdr (assoc :session params)))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (return-val (when (and (eq result-type 'value) (not session)) + (cdr (assoc :return params)))) + (preamble (cdr (assoc :preamble params))) + (full-body + (org-babel-expand-body:generic + (concat body (if return-val (format "return %s" return-val) "")) + params (org-babel-variable-assignments:python params))) + (result (org-babel-python-evaluate + session full-body result-type result-params preamble))) + (or (cdr (assoc :file params)) + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params))))))) + +(defun org-babel-prep-session:python (session params) + "Prepare SESSION according to the header arguments in PARAMS. +VARS contains resolved variable references" + (let* ((session (org-babel-python-initiate-session session)) + (var-lines + (org-babel-variable-assignments:python params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:python (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:python session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:python (params) + "Return list of python statements assigning the block's variables" + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-python-var-to-python (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-python-var-to-python (var) + "Convert an elisp value to a python variable. +Convert an elisp value, VAR, into a string of python source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]") + (if (equal var 'hline) + "None" + (format + (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S") + var)))) + +(defun org-babel-python-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If the results look like a list or tuple, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + +(defvar org-babel-python-buffers '((:default . nil))) + +(defun org-babel-python-session-buffer (session) + "Return the buffer associated with SESSION." + (cdr (assoc session org-babel-python-buffers))) + +(defun org-babel-python-initiate-session-by-key (&optional session) + "Initiate a python session. +If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (require org-babel-python-mode) + (save-window-excursion + (let* ((session (if session (intern session) :default)) + (python-buffer (org-babel-python-session-buffer session))) + (cond + ((and (eq 'python org-babel-python-mode) + (fboundp 'run-python)) ; python.el + (run-python)) + ((and (eq 'python-mode org-babel-python-mode) + (fboundp 'py-shell)) ; python-mode.el + ;; `py-shell' creates a buffer whose name is the value of + ;; `py-which-bufname' with '*'s at the beginning and end + (let* ((bufname (if python-buffer + (replace-regexp-in-string ;; zap surrounding * + "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) + (concat "Python-" (symbol-name session)))) + (py-which-bufname bufname)) + (py-shell) + (setq python-buffer (concat "*" bufname "*")))) + (t + (error "No function available for running an inferior python."))) + (setq org-babel-python-buffers + (cons (cons session python-buffer) + (assq-delete-all session org-babel-python-buffers))) + session))) + +(defun org-babel-python-initiate-session (&optional session params) + "Create a session named SESSION according to PARAMS." + (unless (string= session "none") + (org-babel-python-session-buffer + (org-babel-python-initiate-session-by-key session)))) + +(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'" + "A string to indicate that evaluation has completed.") +(defvar org-babel-python-wrapper-method + " +def main(): +%s + +open('%s', 'w').write( str(main()) )") +(defvar org-babel-python-pp-wrapper-method + " +import pprint +def main(): +%s + +open('%s', 'w').write( pprint.pformat(main()) )") + +(defun org-babel-python-evaluate + (session body &optional result-type result-params preamble) + "Evaluate BODY as python code." + (if session + (org-babel-python-evaluate-session + session body result-type result-params) + (org-babel-python-evaluate-external-process + body result-type result-params preamble))) + +(defun org-babel-python-evaluate-external-process + (body &optional result-type result-params preamble) + "Evaluate BODY in external python process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (output (org-babel-eval org-babel-python-command + (concat (if preamble (concat preamble "\n") "") body))) + (value (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-eval org-babel-python-command + (concat + (if preamble (concat preamble "\n") "") + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-babel-trim body)) + "[\r\n]") "\n") + (org-babel-process-file-name tmp-file 'noquote)))) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-python-table-or-string raw))) + (org-babel-eval-read-file tmp-file)))))) + +(defun org-babel-python-evaluate-session + (session body &optional result-type result-params) + "Pass BODY to the Python process in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (flet ((dump-last-value + (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (comint-send-input)) + (if pp + (list + "import pprint" + (format "open('%s', 'w').write(pprint.pformat(_))" + (org-babel-process-file-name tmp-file 'noquote))) + (list (format "open('%s', 'w').write(str(_))" + (org-babel-process-file-name tmp-file 'noquote)))))) + (input-body (body) + (mapc (lambda (statement) (insert statement) (comint-send-input)) + (split-string (org-babel-trim body) "[\r\n]+")) + (comint-send-input) (comint-send-input))) + (case result-type + (output + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) 2) "\n")) + (value + ((lambda (results) + (if (or (member "code" result-params) (member "pp" result-params)) + results + (org-babel-python-table-or-string results))) + (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (dump-last-value tmp-file (member "pp" result-params)) + (comint-send-input) (comint-send-input) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) + (org-babel-eval-read-file tmp-file))))))) + +(defun org-babel-python-read-string (string) + "Strip 's from around python string" + (if (string-match "^'\\([^\000]+\\)'$" string) + (match-string 1 string) + string)) + +(provide 'ob-python) + +;; arch-tag: f19b6c3d-dfcb-4a1a-9ce0-45ade1ebc212 + +;;; ob-python.el ends here diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el new file mode 100644 index 00000000000..2ca99ca651c --- /dev/null +++ b/lisp/org/ob-ref.el @@ -0,0 +1,229 @@ +;;; ob-ref.el --- org-babel functions for referencing external data + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Functions for referencing data from the header arguments of a +;; org-babel block. The syntax of such a reference should be + +;; #+VAR: variable-name=file:resource-id + +;; - variable-name :: the name of the variable to which the value +;; will be assigned + +;; - file :: path to the file containing the resource, or omitted if +;; resource is in the current file + +;; - resource-id :: the id or name of the resource + +;; So an example of a simple src block referencing table data in the +;; same file would be + +;; #+TBLNAME: sandbox +;; | 1 | 2 | 3 | +;; | 4 | org-babel | 6 | +;; +;; #+begin_src emacs-lisp :var table=sandbox +;; (message table) +;; #+end_src + +;;; Code: +(require 'ob) +(eval-when-compile + (require 'org-list) + (require 'cl)) + +(declare-function org-remove-if-not "org" (predicate seq)) +(declare-function org-at-table-p "org" (&optional table-type)) +(declare-function org-count "org" (CL-ITEM CL-SEQ)) +(declare-function org-in-item-p "org-list" ()) + +(defvar org-babel-ref-split-regexp + "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*") + +(defun org-babel-ref-parse (assignment) + "Parse a variable ASSIGNMENT in a header argument. +If the right hand side of the assignment has a literal value +return that value, otherwise interpret as a reference to an +external resource and find it's value using +`org-babel-ref-resolve'. Return a list with two elements. The +first element of the list will be the name of the variable, and +the second will be an emacs-lisp representation of the value of +the variable." + (when (string-match org-babel-ref-split-regexp assignment) + (let ((var (match-string 1 assignment)) + (ref (match-string 2 assignment))) + (cons (intern var) + (let ((out (org-babel-read ref))) + (if (equal out ref) + (if (string-match "^\".+\"$" ref) + (read ref) + (org-babel-ref-resolve ref)) + out)))))) + +(defvar org-babel-library-of-babel) +(defun org-babel-ref-resolve (ref) + "Resolve the reference REF and return its value." + (save-excursion + (let ((case-fold-search t) + type args new-refere new-header-args new-referent result + lob-info split-file split-ref index index-row index-col) + ;; if ref is indexed grab the indices -- beware nested indices + (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) + (let ((str (substring ref 0 (match-beginning 0)))) + (= (org-count ?( str) (org-count ?) str)))) + (setq index (match-string 1 ref)) + (setq ref (substring ref 0 (match-beginning 0)))) + ;; assign any arguments to pass to source block + (when (string-match + "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref) + (setq new-refere (match-string 1 ref)) + (setq new-header-args (match-string 3 ref)) + (setq new-referent (match-string 5 ref)) + (when (> (length new-refere) 0) + (when (> (length new-referent) 0) + (setq args (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args new-referent)))) + (when (> (length new-header-args) 0) + (setq args (append (org-babel-parse-header-arguments new-header-args) + args))) + (setq ref new-refere))) + (when (string-match "^\\(.+\\):\\(.+\\)$" ref) + (setq split-file (match-string 1 ref)) + (setq split-ref (match-string 2 ref)) + (find-file split-file) (setq ref split-ref)) + (save-restriction + (widen) + (goto-char (point-min)) + (if (let ((result_regexp (concat "^[ \t]*#\\+\\(TBLNAME\\|RESNAME" + "\\|RESULTS\\):[ \t]*" + (regexp-quote ref) "[ \t]*$")) + (regexp (concat org-babel-src-name-regexp + (regexp-quote ref) "\\(\(.*\)\\)?" "[ \t]*$"))) + ;; goto ref in the current buffer + (or (and (not args) + (or (re-search-forward result_regexp nil t) + (re-search-backward result_regexp nil t))) + (re-search-forward regexp nil t) + (re-search-backward regexp nil t) + ;; check the Library of Babel + (setq lob-info (cdr (assoc (intern ref) + org-babel-library-of-babel))))) + (unless lob-info (goto-char (match-beginning 0))) + ;; ;; TODO: allow searching for names in other buffers + ;; (setq id-loc (org-id-find ref 'marker) + ;; buffer (marker-buffer id-loc) + ;; loc (marker-position id-loc)) + ;; (move-marker id-loc nil) + (error "reference '%s' not found in this buffer" ref)) + (if lob-info + (setq type 'lob) + (while (not (setq type (org-babel-ref-at-ref-p))) + (forward-line 1) + (beginning-of-line) + (if (or (= (point) (point-min)) (= (point) (point-max))) + (error "reference not found")))) + (let ((params (append args '((:results . "silent"))))) + (setq result + (case type + ('results-line (org-babel-read-result)) + ('table (org-babel-read-table)) + ('list (org-babel-read-list)) + ('file (org-babel-read-link)) + ('source-block (org-babel-execute-src-block nil nil params)) + ('lob (org-babel-execute-src-block nil lob-info params))))) + (if (symbolp result) + (format "%S" result) + (if (and index (listp result)) + (org-babel-ref-index-list index result) + result)))))) + +(defun org-babel-ref-index-list (index lis) + "Return the subset of LIS indexed by INDEX. + +Indices are 0 based and negative indices count from the end of +LIS, so 0 references the first element of LIS and -1 references +the last. If INDEX is separated by \",\"s then each \"portion\" +is assumed to index into the next deepest nesting or dimension. + +A valid \"portion\" can consist of either an integer index, two +integers separated by a \":\" in which case the entire range is +returned, or an empty string or \"*\" both of which are +interpreted to mean the entire range and as such are equivalent +to \"0:-1\"." + (if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index)) + (let ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)") + (length (length lis)) + (portion (match-string 1 index)) + (remainder (substring index (match-end 0)))) + (flet ((wrap (num) (if (< num 0) (+ length num) num)) + (open (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls))) + (open + (mapcar + (lambda (sub-lis) (org-babel-ref-index-list remainder sub-lis)) + (if (or (= 0 (length portion)) (string-match ind-re portion)) + (mapcar + (lambda (n) (nth n lis)) + (apply 'org-number-sequence + (if (and (> (length portion) 0) (match-string 2 portion)) + (list + (wrap (string-to-number (match-string 2 portion))) + (wrap (string-to-number (match-string 3 portion)))) + (list (wrap 0) (wrap -1))))) + (list (nth (wrap (string-to-number portion)) lis))))))) + lis)) + +(defun org-babel-ref-split-args (arg-string) + "Split ARG-STRING into top-level arguments of balanced parenthesis." + (let ((index 0) (depth 0) (buffer "") holder return) + ;; crawl along string, splitting at any ","s which are on the top level + (while (< index (length arg-string)) + (setq holder (substring arg-string index (+ 1 index))) + (setq buffer (concat buffer holder)) + (setq index (+ 1 index)) + (cond + ((string= holder ",") + (when (= depth 0) + (setq return (reverse (cons (substring buffer 0 -1) return))) + (setq buffer ""))) + ((or (string= holder "(") (string= holder "[")) (setq depth (+ depth 1))) + ((or (string= holder ")") (string= holder "]")) (setq depth (- depth 1))))) + (mapcar #'org-babel-trim (reverse (cons buffer return))))) + +(defvar org-bracket-link-regexp) +(defun org-babel-ref-at-ref-p () + "Return the type of reference located at point. +Return nil if none of the supported reference types are found. +Supported reference types are tables and source blocks." + (cond ((org-at-table-p) 'table) + ((org-in-item-p) 'list) + ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block) + ((looking-at org-bracket-link-regexp) 'file) + ((looking-at org-babel-result-regexp) 'results-line))) + +(provide 'ob-ref) + +;; arch-tag: ace4a4f4-ea38-4dac-8fe6-6f52fcc43b6d + +;;; ob-ref.el ends here diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el new file mode 100644 index 00000000000..3f2af394603 --- /dev/null +++ b/lisp/org/ob-ruby.el @@ -0,0 +1,239 @@ +;;; ob-ruby.el --- org-babel functions for ruby evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating ruby source code. + +;;; Requirements: + +;; - ruby and irb executables :: http://www.ruby-lang.org/ +;; +;; - ruby-mode :: Can be installed through ELPA, or from +;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el +;; +;; - inf-ruby mode :: Can be installed through ELPA, or from +;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function run-ruby "ext:inf-ruby" (&optional command name)) + +(add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb")) + +(defvar org-babel-default-header-args:ruby '()) + +(defvar org-babel-ruby-command "ruby" + "Name of command to use for executing ruby code.") + +(defun org-babel-execute:ruby (body params) + "Execute a block of Ruby code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (org-babel-ruby-initiate-session + (cdr (assoc :session params)))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:ruby params))) + (result (org-babel-ruby-evaluate + session full-body result-type result-params))) + (or (cdr (assoc :file params)) + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params))))))) + +(defun org-babel-prep-session:ruby (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + ;; (message "params=%S" params) ;; debugging + (let* ((session (org-babel-ruby-initiate-session session)) + (var-lines (org-babel-variable-assignments:ruby params))) + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines)) + session)) + +(defun org-babel-load-session:ruby (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:ruby session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:ruby (params) + "Return list of ruby statements assigning the block's variables" + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-ruby-var-to-ruby (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-ruby-var-to-ruby (var) + "Convert VAR into a ruby variable. +Convert an elisp value into a string of ruby source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]") + (format "%S" var))) + +(defun org-babel-ruby-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + +(defun org-babel-ruby-initiate-session (&optional session params) + "Initiate a ruby session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session." + (require 'inf-ruby) + (unless (string= session "none") + (let ((session-buffer (save-window-excursion + (run-ruby nil session) (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-ruby-initiate-session session))))) + +(defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe" + "String to indicate that evaluation has completed.") +(defvar org-babel-ruby-f-write + "File.open('%s','w'){|f| f.write((_.class == String) ? _ : _.inspect)}") +(defvar org-babel-ruby-pp-f-write + "File.open('%s','w'){|f| $stdout = f; pp(results); $stdout = orig_out}") +(defvar org-babel-ruby-wrapper-method + " +def main() +%s +end +results = main() +File.open('%s', 'w'){ |f| f.write((results.class == String) ? results : results.inspect) } +") +(defvar org-babel-ruby-pp-wrapper-method + " +require 'pp' +def main() +%s +end +results = main() +File.open('%s', 'w') do |f| + $stdout = f + pp results +end +") + +(defun org-babel-ruby-evaluate + (buffer body &optional result-type result-params) + "Pass BODY to the Ruby process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (if (not buffer) + ;; external process evaluation + (case result-type + (output (org-babel-eval org-babel-ruby-command body)) + (value (let ((tmp-file (org-babel-temp-file "ruby-"))) + (org-babel-eval + org-babel-ruby-command + (format (if (member "pp" result-params) + org-babel-ruby-pp-wrapper-method + org-babel-ruby-wrapper-method) + body (org-babel-process-file-name tmp-file 'noquote))) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-ruby-table-or-string raw))) + (org-babel-eval-read-file tmp-file))))) + ;; comint session evaluation + (case result-type + (output + (mapconcat + #'identity + (butlast + (split-string + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body org-babel-ruby-eoe-indicator)) + (comint-send-input nil t)) 2) + "\n") "[\r\n]")) "\n")) + (value + ((lambda (results) + (if (or (member "code" result-params) (member "pp" result-params)) + results + (org-babel-ruby-table-or-string results))) + (let* ((tmp-file (org-babel-temp-file "ruby-")) + (ppp (or (member "code" result-params) + (member "pp" result-params)))) + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (when ppp (insert "require 'pp';") (comint-send-input nil t)) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (append + (list body) + (if (not ppp) + (list (format org-babel-ruby-f-write + (org-babel-process-file-name tmp-file 'noquote))) + (list + "results=_" "require 'pp'" "orig_out = $stdout" + (format org-babel-ruby-pp-f-write + (org-babel-process-file-name tmp-file 'noquote)))) + (list org-babel-ruby-eoe-indicator))) + (comint-send-input nil t)) + (org-babel-eval-read-file tmp-file))))))) + +(defun org-babel-ruby-read-string (string) + "Strip \\\"s from around a ruby string." + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(provide 'ob-ruby) + +;; arch-tag: 3e9726db-4520-49e2-b263-e8f571ac88f5 + +;;; ob-ruby.el ends here diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el new file mode 100644 index 00000000000..b3acc8b8d2c --- /dev/null +++ b/lisp/org/ob-sass.el @@ -0,0 +1,69 @@ +;;; ob-sass.el --- org-babel functions for the sass css generation language + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; For more information on sass see http://sass-lang.com/ +;; +;; This accepts a 'file' header argument which is the target of the +;; compiled sass. The default output type for sass evaluation is +;; either file (if a 'file' header argument was given) or scalar if no +;; such header argument was supplied. +;; +;; A 'cmdline' header argument can be supplied to pass arguments to +;; the sass command line. + +;;; Requirements: + +;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:sass '()) + +(defun org-babel-execute:sass (body params) + "Execute a block of Sass code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (file (cdr (assoc :file params))) + (out-file (or file (org-babel-temp-file "sass-out-"))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "sass-in-")) + (cmd (concat "sass " (or cmdline "") + " " (org-babel-process-file-name in-file) + " " (org-babel-process-file-name out-file)))) + (with-temp-file in-file + (insert (org-babel-expand-body:generic body params))) (shell-command cmd) + (or file (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) + +(defun org-babel-prep-session:sass (session params) + "Raise an error because sass does not support sessions." + (error "Sass does not support sessions")) + +(provide 'ob-sass) + +;; arch-tag: 2954b169-eef4-45ce-a8e5-3e619f0f07ac + +;;; ob-sass.el ends here diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el new file mode 100644 index 00000000000..b2b9fa6a01d --- /dev/null +++ b/lisp/org/ob-scheme.el @@ -0,0 +1,139 @@ +;;; ob-scheme.el --- org-babel functions for Scheme + +;; Copyright (C) 2010 Free Software Foundation + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, scheme +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Now working with SBCL for both session and external evaluation. +;; +;; This certainly isn't optimally robust, but it seems to be working +;; for the basic use cases. + +;;; Requirements: + +;; - a working scheme implementation +;; (e.g. guile http://www.gnu.org/software/guile/guile.html) +;; +;; - for session based evaluation cmuscheme.el is required which is +;; included in Emacs + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function run-scheme "ext:cmuscheme" (cmd)) + +(defvar org-babel-default-header-args:scheme '() + "Default header arguments for scheme code blocks.") + +(defvar org-babel-scheme-eoe "org-babel-scheme-eoe" + "String to indicate that evaluation has completed.") + +(defcustom org-babel-scheme-cmd "guile" + "Name of command used to evaluate scheme blocks." + :group 'org-babel + :type 'string) + +(defun org-babel-expand-body:scheme (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (if (> (length vars) 0) + (concat "(let (" + (mapconcat + (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body ")") + body))) + +(defvar scheme-program-name) +(defun org-babel-execute:scheme (body params) + "Execute a block of Scheme code with org-babel. +This function is called by `org-babel-execute-src-block'" + (let* ((result-type (cdr (assoc :result-type params))) + (org-babel-scheme-cmd (or (cdr (assoc :scheme params)) + org-babel-scheme-cmd)) + (full-body (org-babel-expand-body:scheme body params))) + (read + (if (not (string= (cdr (assoc :session params)) "none")) + ;; session evaluation + (let ((session (org-babel-prep-session:scheme + (cdr (assoc :session params)) params))) + (org-babel-comint-with-output + (session (format "%S" org-babel-scheme-eoe) t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body (format "%S" org-babel-scheme-eoe))))) + ;; external evaluation + (let ((script-file (org-babel-temp-file "scheme-script-"))) + (with-temp-file script-file + (insert + ;; return the value or the output + (if (string= result-type "value") + (format "(display %s)" full-body) + full-body))) + (org-babel-eval + (format "%s %s" org-babel-scheme-cmd + (org-babel-process-file-name script-file)) "")))))) + +(defun org-babel-prep-session:scheme (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-scheme-initiate-session session)) + (vars (mapcar #'cdr (org-babel-get-header params :var))) + (var-lines + (mapcar + (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var))))) + vars))) + (when session + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines))) + session)) + +(defun org-babel-scheme-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (require 'cmuscheme) + (unless (string= session "none") + (let ((session-buffer (save-window-excursion + (run-scheme org-babel-scheme-cmd) + (rename-buffer session) + (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-scheme-initiate-session session))))) + +(provide 'ob-scheme) + +;; arch-tag: 6b2fe76f-4b25-4e87-ad1c-225b2f282a71 + +;;; ob-scheme.el ends here diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el new file mode 100644 index 00000000000..7f4af795499 --- /dev/null +++ b/lisp/org/ob-screen.el @@ -0,0 +1,147 @@ +;;; ob-screen.el --- org-babel support for interactive terminal + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Benjamin Andresen +;; Keywords: literate programming, interactive shell +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for interactive terminals. Mostly shell scripts. +;; Heavily inspired by 'eev' from Eduardo Ochs +;; +;; Adding :cmd and :terminal as header arguments +;; :terminal must support the -T (title) and -e (command) parameter +;; +;; You can test the default setup. (xterm + sh) with +;; M-x org-babel-screen-test RET + +;;; Code: +(require 'ob) +(require 'ob-ref) + +(defvar org-babel-screen-location "screen" + "The command location for screen. +In case you want to use a different screen than one selected by your $PATH") + +(defvar org-babel-default-header-args:screen + '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm")) + "Default arguments to use when running screen source blocks.") + +(defun org-babel-execute:screen (body params) + "Send a block of code via screen to a terminal using Babel. +\"default\" session is used when none is specified." + (message "Sending source code block to interactive terminal session...") + (save-window-excursion + (let* ((session (cdr (assoc :session params))) + (socket (org-babel-screen-session-socketname session))) + (unless socket (org-babel-prep-session:screen session params)) + (org-babel-screen-session-execute-string + session (org-babel-expand-body:generic body params))))) + +(defun org-babel-prep-session:screen (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (cdr (assoc :session params))) + (socket (org-babel-screen-session-socketname session)) + (cmd (cdr (assoc :cmd params))) + (terminal (cdr (assoc :terminal params))) + (process-name (concat "org-babel: terminal (" session ")"))) + (apply 'start-process process-name "*Messages*" + terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location + "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) + ,cmd)) + ;; XXX: Is there a better way than the following? + (while (not (org-babel-screen-session-socketname session)) + ;; wait until screen session is available before returning + ))) + +;; helper functions + +(defun org-babel-screen-session-execute-string (session body) + "If SESSION exists, send BODY to it." + (let ((socket (org-babel-screen-session-socketname session))) + (when socket + (let ((tmpfile (org-babel-screen-session-write-temp-file session body))) + (apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*" + org-babel-screen-location + `("-S" ,socket "-X" "eval" "msgwait 0" + ,(concat "readreg z " tmpfile) + "paste z")))))) + +(defun org-babel-screen-session-socketname (session) + "Check if SESSION exists by parsing output of \"screen -ls\"." + (let* ((screen-ls (shell-command-to-string "screen -ls")) + (sockets (delq + nil + (mapcar + (lambda (x) + (when (string-match (rx (or "(Attached)" "(Detached)")) x) + x)) + (split-string screen-ls "\n")))) + (match-socket (car + (delq + nil + (mapcar + (lambda (x) + (when (string-match + (concat "org-babel-session-" session) x) + x)) + sockets))))) + (when match-socket (car (split-string match-socket))))) + +(defun org-babel-screen-session-write-temp-file (session body) + "Save BODY in a temp file that is named after SESSION." + (let ((tmpfile (concat "/tmp/screen.org-babel-session-" session))) + (with-temp-file tmpfile + (insert body) + + ;; org-babel has superflous spaces + (goto-char (point-min)) + (delete-matching-lines "^ +$")) + tmpfile)) + +(defun org-babel-screen-test () + "Test if the default setup works. +The terminal should shortly flicker." + (interactive) + (let* ((session "org-babel-testing") + (random-string (format "%s" (random 99999))) + (tmpfile "/tmp/org-babel-screen.test") + (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) + process tmp-string) + (org-babel-execute:screen body org-babel-default-header-args:screen) + ;; XXX: need to find a better way to do the following + (while (not (file-readable-p tmpfile)) + ;; do something, otherwise this will be optimized away + (format "org-babel-screen: File not readable yet.")) + (setq tmp-string (with-temp-buffer + (insert-file-contents-literally tmpfile) + (buffer-substring (point-min) (point-max)))) + (delete-file tmpfile) + (message (concat "org-babel-screen: Setup " + (if (string-match random-string tmp-string) + "WORKS." + "DOESN'T work."))))) + +(provide 'ob-screen) + +;; arch-tag: 908e5afe-89a0-4f27-b982-23f1f2e3bac9 + +;;; ob-screen.el ends here diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el new file mode 100644 index 00000000000..e153d68b575 --- /dev/null +++ b/lisp/org/ob-sh.el @@ -0,0 +1,171 @@ +;;; ob-sh.el --- org-babel functions for shell evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating shell source code. + +;;; Code: +(require 'ob) +(require 'ob-comint) +(require 'ob-eval) +(require 'shell) +(eval-when-compile (require 'cl)) + +(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) +(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) +(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) +(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)) +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defvar org-babel-default-header-args:sh '()) + +(defvar org-babel-sh-command "sh" + "Command used to invoke a shell. +This will be passed to `shell-command-on-region'") + +(defun org-babel-execute:sh (body params) + "Execute a block of Shell commands with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (org-babel-sh-initiate-session + (cdr (assoc :session params)))) + (result-params (cdr (assoc :result-params params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:sh params)))) + (org-babel-reassemble-table + (org-babel-sh-evaluate session full-body result-params) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:sh (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-sh-initiate-session session)) + (var-lines (org-babel-variable-assignments:sh params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:sh (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:sh session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:sh (params) + "Return list of shell statements assigning the block's variables" + (let ((sep (cdr (assoc :separator params)))) + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-sh-var-to-sh (cdr pair) sep))) + (mapcar #'cdr (org-babel-get-header params :var))))) + +(defun org-babel-sh-var-to-sh (var &optional sep) + "Convert an elisp value to a shell variable. +Convert an elisp var into a string of shell commands specifying a +var of the same value." + (if (listp var) + (flet ((deep-string (el) + (if (listp el) + (mapcar #'deep-string el) + (org-babel-sh-var-to-sh el sep)))) + (format "$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)" + (orgtbl-to-generic + (deep-string (if (listp (car var)) var (list var))) + (list :sep (or sep "\t"))))) + (if (stringp var) + (if (string-match "[\n\r]" var) + (format "$(cat <<BABEL_STRING\n%s\nBABEL_STRING\n)" var) + (format "%s" var)) + (format "%S" var)))) + +(defun org-babel-sh-table-or-results (results) + "Convert RESULTS to an appropriate elisp value. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + +(defun org-babel-sh-initiate-session (&optional session params) + "Initiate a session named SESSION according to PARAMS." + (when (and session (not (string= session "none"))) + (save-window-excursion + (or (org-babel-comint-buffer-livep session) + (progn (shell session) (get-buffer (current-buffer))))))) + +(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'" + "String to indicate that evaluation has completed.") +(defvar org-babel-sh-eoe-output "org_babel_sh_eoe" + "String to indicate that evaluation has completed.") + +(defun org-babel-sh-evaluate (session body &optional result-params) + "Pass BODY to the Shell process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY." + ((lambda (results) + (when results + (if (or (member "scalar" result-params) + (member "output" result-params)) + results + (let ((tmp-file (org-babel-temp-file "sh-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))))) + (if (not session) + (org-babel-eval org-babel-sh-command (org-babel-trim body)) + (mapconcat + #'org-babel-sh-strip-weird-long-prompt + (mapcar + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-sh-eoe-output t body) + (mapc + (lambda (line) + (insert line) (comint-send-input nil t) (sleep-for 0.25)) + (append + (split-string (org-babel-trim body) "\n") + (list org-babel-sh-eoe-indicator)))) + 2)) "\n")))) + +(defun org-babel-sh-strip-weird-long-prompt (string) + "Remove prompt cruft from a string of shell output." + (while (string-match "^% +[\r\n$]+ *" string) + (setq string (substring string (match-end 0)))) + string) + +(provide 'ob-sh) + +;; arch-tag: 416dd531-c230-4b0a-a5bf-8d948f990f2d + +;;; ob-sh.el ends here diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el new file mode 100644 index 00000000000..5bb123d631b --- /dev/null +++ b/lisp/org/ob-sql.el @@ -0,0 +1,126 @@ +;;; ob-sql.el --- org-babel functions for sql evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating sql source code. +;; +;; SQL is somewhat unique in that there are many different engines for +;; the evaluation of sql (Mysql, PostgreSQL, etc...), so much of this +;; file will have to be implemented engine by engine. +;; +;; Also SQL evaluation generally takes place inside of a database. +;; +;; For now lets just allow a generic ':cmdline' header argument. +;; +;; TODO: +;; +;; - support for sessions +;; - add more useful header arguments (user, passwd, database, etc...) +;; - support for more engines (currently only supports mysql) +;; - what's a reasonable way to drop table data into SQL? +;; + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function org-table-import "org-table" (file arg)) +(declare-function orgtbl-to-csv "org-table" (TABLE PARAMS)) + +(defvar org-babel-default-header-args:sql '()) + +(defun org-babel-expand-body:sql (body params) + "Expand BODY according to the values of PARAMS." + (org-babel-sql-expand-vars + body (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-execute:sql (body params) + "Execute a block of Sql code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (cdr (assoc :result-params params))) + (cmdline (cdr (assoc :cmdline params))) + (engine (cdr (assoc :engine params))) + (in-file (org-babel-temp-file "sql-in-")) + (out-file (or (cdr (assoc :out-file params)) + (org-babel-temp-file "sql-out-"))) + (command (case (intern engine) + ('msosql (format "osql %s -s \"\t\" -i %s -o %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + ('mysql (format "mysql %s -e \"source %s\" > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + ('postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) + (t (error "no support for the %s sql engine" engine))))) + (with-temp-file in-file + (insert (org-babel-expand-body:sql body params))) + (message command) + (shell-command command) + (with-temp-buffer + (org-table-import out-file '(16)) + (org-babel-reassemble-table + (org-table-to-lisp) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params))))))) + +(defun org-babel-sql-expand-vars (body vars) + "Expand the variables held in VARS in BODY." + (mapc + (lambda (pair) + (setq body + (replace-regexp-in-string + (format "\$%s" (car pair)) + ((lambda (val) + (if (listp val) + ((lambda (data-file) + (with-temp-file data-file + (insert (orgtbl-to-csv + val '(:fmt (lambda (el) (if (stringp el) + el + (format "%S" el))))))) + data-file) + (org-babel-temp-file "sql-data-")) + (if (stringp val) val (format "%S" val)))) + (cdr pair)) + body))) + vars) + body) + +(defun org-babel-prep-session:sql (session params) + "Raise an error because Sql sessions aren't implemented." + (error "sql sessions not yet implemented")) + +(provide 'ob-sql) + +;; arch-tag: a43ff944-6de1-4566-a83c-626814e3dad2 + +;;; ob-sql.el ends here diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el new file mode 100644 index 00000000000..65e8091741f --- /dev/null +++ b/lisp/org/ob-sqlite.el @@ -0,0 +1,149 @@ +;;; ob-sqlite.el --- org-babel functions for sqlite database interaction + +;; Copyright (C) 2010 Free Software Foundation + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating sqlite source code. + +;;; Code: +(require 'ob) +(require 'ob-eval) +(require 'ob-ref) + +(declare-function org-fill-template "org" (template alist)) +(declare-function org-table-convert-region "org-table" + (beg0 end0 &optional separator)) +(declare-function orgtbl-to-csv "org-table" (TABLE PARAMS)) + +(defvar org-babel-default-header-args:sqlite '()) + +(defvar org-babel-header-arg-names:sqlite + '(db header echo bail csv column html line list separator nullvalue) + "Sqlite specific header args.") + +(defun org-babel-expand-body:sqlite (body params) + "Expand BODY according to the values of PARAMS." + (org-babel-sqlite-expand-vars + body (mapcar #'cdr (org-babel-get-header params :var)))) + +(defvar org-babel-sqlite3-command "sqlite3") + +(defun org-babel-execute:sqlite (body params) + "Execute a block of Sqlite code with Babel. +This function is called by `org-babel-execute-src-block'." + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (db (cdr (assoc :db params))) + (separator (cdr (assoc :separator params))) + (nullvalue (cdr (assoc :nullvalue params))) + (headers-p (equal "yes" (cdr (assoc :colnames params)))) + (others (delq nil (mapcar + (lambda (arg) (car (assoc arg params))) + (list :header :echo :bail :column + :csv :html :line :list)))) + exit-code) + (unless db (error "ob-sqlite: can't evaluate without a database.")) + (with-temp-buffer + (insert + (org-babel-eval + (org-fill-template + "%cmd %header %separator %nullvalue %others %csv %db " + (list + (cons "cmd" org-babel-sqlite3-command) + (cons "header" (if headers-p "-header" "-noheader")) + (cons "separator" + (if separator (format "-separator %s" separator) "")) + (cons "nullvalue" + (if nullvalue (format "-nullvalue %s" nullvalue) "")) + (cons "others" + (mapconcat + (lambda (arg) (format "-%s" (substring (symbol-name arg) 1))) + others " ")) + ;; for easy table parsing, default header type should be -csv + (cons "csv" (if (or (member :csv others) (member :column others) + (member :line others) (member :list others) + (member :html others) separator) + "" + "-csv")) + (cons "db " db))) + ;; body of the code block + (org-babel-expand-body:sqlite body params))) + (if (or (member "scalar" result-params) + (member "html" result-params) + (member "code" result-params) + (equal (point-min) (point-max))) + (buffer-string) + (org-table-convert-region (point-min) (point-max)) + (org-babel-sqlite-table-or-scalar + (org-babel-sqlite-offset-colnames + (org-table-to-lisp) headers-p)))))) + +(defun org-babel-sqlite-expand-vars (body vars) + "Expand the variables held in VARS in BODY." + (mapc + (lambda (pair) + (setq body + (replace-regexp-in-string + (format "\$%s" (car pair)) + ((lambda (val) + (if (listp val) + ((lambda (data-file) + (with-temp-file data-file + (insert (orgtbl-to-csv + val '(:fmt (lambda (el) (if (stringp el) + el + (format "%S" el))))))) + data-file) + (org-babel-temp-file "sqlite-data-")) + (if (stringp val) val (format "%S" val)))) + (cdr pair)) + body))) + vars) + body) + +(defun org-babel-sqlite-table-or-scalar (result) + "If RESULT looks like a trivial table, then unwrap it." + (if (and (equal 1 (length result)) + (equal 1 (length (car result)))) + (org-babel-read (caar result)) + (mapcar (lambda (row) + (if (equal 'hline row) + 'hline + (mapcar #'org-babel-read row))) result))) + +(defun org-babel-sqlite-offset-colnames (table headers-p) + "If HEADERS-P is non-nil then offset the first row as column names." + (if headers-p + (cons (car table) (cons 'hline (cdr table))) + table)) + +(defun org-babel-prep-session:sqlite (session params) + "Raise an error because support for sqlite sessions isn't implemented. +Prepare SESSION according to the header arguments specified in PARAMS." + (error "sqlite sessions not yet implemented")) + +(provide 'ob-sqlite) + +;; arch-tag: 5c03d7f2-0f72-48b8-bbd1-35aafea248ac + +;;; ob-sqlite.el ends here diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el new file mode 100644 index 00000000000..b7f9673c676 --- /dev/null +++ b/lisp/org/ob-table.el @@ -0,0 +1,125 @@ +;;; ob-table.el --- support for calling org-babel functions from tables + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Should allow calling functions from org-mode tables using the +;; function `sbe' as so... + +;; #+begin_src emacs-lisp :results silent +;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2))))) +;; #+end_src + +;; #+srcname: fibbd +;; #+begin_src emacs-lisp :var n=2 :results silent +;; (fibbd n) +;; #+end_src + +;; | original | fibbd | +;; |----------+--------| +;; | 0 | | +;; | 1 | | +;; | 2 | | +;; | 3 | | +;; | 4 | | +;; | 5 | | +;; | 6 | | +;; | 7 | | +;; | 8 | | +;; | 9 | | +;; #+TBLFM: $2='(sbe 'fibbd (n $1)) + +;;; Code: +(require 'ob) + +(defun org-babel-table-truncate-at-newline (string) + "Replace newline character with ellipses. +If STRING ends in a newline character, then remove the newline +character and replace it with ellipses." + (if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string)) + (concat (substring string 0 (match-beginning 0)) + (if (match-string 1 string) "...")) string)) + +(defmacro sbe (source-block &rest variables) + "Return the results of calling SOURCE-BLOCK with VARIABLES. +Each element of VARIABLES should be a two +element list, whose first element is the name of the variable and +second element is a string of its value. The following call to +`sbe' would be equivalent to the following source code block. + + (sbe 'source-block (n $2) (m 3)) + +#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent +results +#+end_src + +NOTE: by default string variable names are interpreted as +references to source-code blocks, to force interpretation of a +cell's value as a string, prefix the identifier with two \"$\"s +rather than a single \"$\" (i.e. \"$$2\" instead of \"$2\" in the +example above." + (let* (quote + (variables + (mapcar + (lambda (var) + ;; ensure that all cells prefixed with $'s are strings + (cons (car var) + (delq nil (mapcar + (lambda (el) + (if (eq '$ el) + (setq quote t) + (prog1 (if quote + (format "\"%s\"" el) + (org-babel-clean-text-properties el)) + (setq quote nil)))) + (cdr var))))) + variables))) + (unless (stringp source-block) + (setq source-block (symbol-name source-block))) + (org-babel-table-truncate-at-newline ;; org-table cells can't be multi-line + (if (and source-block (> (length source-block) 0)) + (let ((params + (eval `(org-babel-parse-header-arguments + (concat ":var results=" + ,source-block + "(" + (mapconcat + (lambda (var-spec) + (if (> (length (cdr var-spec)) 1) + (format "%S='%S" + (car var-spec) + (mapcar #'read (cdr var-spec))) + (format "%S=%s" + (car var-spec) (cadr var-spec)))) + ',variables ", ") + ")"))))) + (org-babel-execute-src-block + nil (list "emacs-lisp" "results" params) '((:results . "silent")))) + "")))) + +(provide 'ob-table) + +;; arch-tag: 4234cc7c-4fc8-4e92-abb0-2892de1a493b + +;;; ob-table.el ends here diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el new file mode 100644 index 00000000000..c5ef2a1fcea --- /dev/null +++ b/lisp/org/ob-tangle.el @@ -0,0 +1,454 @@ +;;; ob-tangle.el --- extract source code from org-mode files + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extract the code from source blocks out into raw source-code files. + +;;; Code: +(require 'ob) +(require 'org-src) +(eval-when-compile + (require 'cl)) + +(declare-function org-link-escape "org" (text &optional table)) +(declare-function org-heading-components "org" ()) +(declare-function org-back-to-heading "org" (invisible-ok)) +(declare-function org-fill-template "org" (template alist)) +(declare-function org-babel-update-block-body "org" (new-body)) + +;;;###autoload +(defcustom org-babel-tangle-lang-exts + '(("emacs-lisp" . "el")) + "Alist mapping languages to their file extensions. +The key is the language name, the value is the string that should +be inserted as the extension commonly used to identify files +written in this language. If no entry is found in this list, +then the name of the language is used." + :group 'org-babel-tangle + :type '(repeat + (cons + (string "Language name") + (string "File Extension")))) + +(defcustom org-babel-post-tangle-hook nil + "Hook run in code files tangled by `org-babel-tangle'." + :group 'org-babel + :type 'hook) + +(defcustom org-babel-pre-tangle-hook '(save-buffer) + "Hook run at the beginning of `org-babel-tangle'." + :group 'org-babel + :type 'hook) + +(defcustom org-babel-tangle-pad-newline t + "Switch indicating whether to pad tangled code with newlines." + :group 'org-babel + :type 'boolean) + +(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]" + "Format of inserted comments in tangled code files. +The following format strings can be used to insert special +information into the output using `org-fill-template'. +%start-line --- the line number at the start of the code block +%file --------- the file from which the code block was tangled +%link --------- Org-mode style link to the code block +%source-name -- name of the code block + +Whether or not comments are inserted during tangling is +controlled by the :comments header argument." + :group 'org-babel + :type 'string) + +(defcustom org-babel-tangle-comment-format-end "%source-name ends here" + "Format of inserted comments in tangled code files. +The following format strings can be used to insert special +information into the output using `org-fill-template'. +%start-line --- the line number at the start of the code block +%file --------- the file from which the code block was tangled +%link --------- Org-mode style link to the code block +%source-name -- name of the code block + +Whether or not comments are inserted during tangling is +controlled by the :comments header argument." + :group 'org-babel + :type 'string) + +(defun org-babel-find-file-noselect-refresh (file) + "Find file ensuring that the latest changes on disk are +represented in the file." + (find-file-noselect file) + (with-current-buffer (get-file-buffer file) + (revert-buffer t t t))) + +(defmacro org-babel-with-temp-filebuffer (file &rest body) + "Open FILE into a temporary buffer execute BODY there like +`progn', then kill the FILE buffer returning the result of +evaluating BODY." + (declare (indent 1)) + (let ((temp-result (make-symbol "temp-result")) + (temp-file (make-symbol "temp-file")) + (visited-p (make-symbol "visited-p"))) + `(let (,temp-result ,temp-file + (,visited-p (get-file-buffer ,file))) + (org-babel-find-file-noselect-refresh ,file) + (setf ,temp-file (get-file-buffer ,file)) + (with-current-buffer ,temp-file + (setf ,temp-result (progn ,@body))) + (unless ,visited-p (kill-buffer ,temp-file)) + ,temp-result))) + +;;;###autoload +(defun org-babel-load-file (file) + "Load Emacs Lisp source code blocks in the Org-mode FILE. +This function exports the source code using +`org-babel-tangle' and then loads the resulting file using +`load-file'." + (interactive "fFile to load: ") + (flet ((age (file) + (float-time + (time-subtract (current-time) + (nth 5 (or (file-attributes (file-truename file)) + (file-attributes file))))))) + (let* ((base-name (file-name-sans-extension file)) + (exported-file (concat base-name ".el"))) + ;; tangle if the org-mode file is newer than the elisp file + (unless (and (file-exists-p exported-file) + (> (age file) (age exported-file))) + (org-babel-tangle-file file exported-file "emacs-lisp")) + (load-file exported-file) + (message "loaded %s" exported-file)))) + +;;;###autoload +(defun org-babel-tangle-file (file &optional target-file lang) + "Extract the bodies of source code blocks in FILE. +Source code blocks are extracted with `org-babel-tangle'. +Optional argument TARGET-FILE can be used to specify a default +export file for all source blocks. Optional argument LANG can be +used to limit the exported source code blocks by language." + (interactive "fFile to tangle: \nP") + (let ((visited-p (get-file-buffer (expand-file-name file))) + to-be-removed) + (save-window-excursion + (find-file file) + (setq to-be-removed (current-buffer)) + (org-babel-tangle target-file lang)) + (unless visited-p + (kill-buffer to-be-removed)))) + +(defun org-babel-tangle-publish (_ filename pub-dir) + "Tangle FILENAME and place the results in PUB-DIR." + (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) + +;;;###autoload +(defun org-babel-tangle (&optional target-file lang) + "Write code blocks to source-specific files. +Extract the bodies of all source code blocks from the current +file into their own source-specific files. Optional argument +TARGET-FILE can be used to specify a default export file for all +source blocks. Optional argument LANG can be used to limit the +exported source code blocks by language." + (interactive) + (run-hooks 'org-babel-pre-tangle-hook) + (save-excursion + (let ((block-counter 0) + (org-babel-default-header-args + (if target-file + (org-babel-merge-params org-babel-default-header-args + (list (cons :tangle target-file))) + org-babel-default-header-args)) + path-collector) + (mapc ;; map over all languages + (lambda (by-lang) + (let* ((lang (car by-lang)) + (specs (cdr by-lang)) + (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang)) + (lang-f (intern + (concat + (or (and (cdr (assoc lang org-src-lang-modes)) + (symbol-name + (cdr (assoc lang org-src-lang-modes)))) + lang) + "-mode"))) + she-banged) + (mapc + (lambda (spec) + (flet ((get-spec (name) + (cdr (assoc name (nth 4 spec))))) + (let* ((tangle (get-spec :tangle)) + (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) + (get-spec :shebang))) + (base-name (cond + ((string= "yes" tangle) + (file-name-sans-extension + (buffer-file-name))) + ((string= "no" tangle) nil) + ((> (length tangle) 0) tangle))) + (file-name (when base-name + ;; decide if we want to add ext to base-name + (if (and ext (string= "yes" tangle)) + (concat base-name "." ext) base-name)))) + (when file-name + ;; delete any old versions of file + (when (and (file-exists-p file-name) + (not (member file-name path-collector))) + (delete-file file-name)) + ;; drop source-block to file + (with-temp-buffer + (when (fboundp lang-f) (funcall lang-f)) + (when (and she-bang (not (member file-name she-banged))) + (insert (concat she-bang "\n")) + (setq she-banged (cons file-name she-banged))) + (org-babel-spec-to-string spec) + ;; We avoid append-to-file as it does not work with tramp. + (let ((content (buffer-string))) + (with-temp-buffer + (if (file-exists-p file-name) + (insert-file-contents file-name)) + (goto-char (point-max)) + (insert content) + (write-region nil nil file-name)))) + ;; if files contain she-bangs, then make the executable + (when she-bang (set-file-modes file-name #o755)) + ;; update counter + (setq block-counter (+ 1 block-counter)) + (add-to-list 'path-collector file-name))))) + specs))) + (org-babel-tangle-collect-blocks lang)) + (message "tangled %d code block%s from %s" block-counter + (if (= block-counter 1) "" "s") + (file-name-nondirectory (buffer-file-name (current-buffer)))) + ;; run `org-babel-post-tangle-hook' in all tangled files + (when org-babel-post-tangle-hook + (mapc + (lambda (file) + (org-babel-with-temp-filebuffer file + (run-hooks 'org-babel-post-tangle-hook))) + path-collector)) + path-collector))) + +(defun org-babel-tangle-clean () + "Remove comments inserted by `org-babel-tangle'. +Call this function inside of a source-code file generated by +`org-babel-tangle' to remove all comments inserted automatically +by `org-babel-tangle'. Warning, this comment removes any lines +containing constructs which resemble org-mode file links or noweb +references." + (interactive) + (goto-char (point-min)) + (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t) + (re-search-forward "<<[^[:space:]]*>>" nil t)) + (delete-region (save-excursion (beginning-of-line 1) (point)) + (save-excursion (end-of-line 1) (forward-char 1) (point))))) + +(defvar org-stored-links) +(defun org-babel-tangle-collect-blocks (&optional language) + "Collect source blocks in the current Org-mode file. +Return an association list of source-code block specifications of +the form used by `org-babel-spec-to-string' grouped by language. +Optional argument LANG can be used to limit the collected source +code blocks by language." + (let ((block-counter 1) (current-heading "") blocks) + (org-babel-map-src-blocks (buffer-file-name) + ((lambda (new-heading) + (if (not (string= new-heading current-heading)) + (progn + (setq block-counter 1) + (setq current-heading new-heading)) + (setq block-counter (+ 1 block-counter)))) + (replace-regexp-in-string "[ \t]" "-" + (condition-case nil + (nth 4 (org-heading-components)) + (error (buffer-file-name))))) + (let* ((start-line (save-restriction (widen) + (+ 1 (line-number-at-pos (point))))) + (file (buffer-file-name)) + (info (org-babel-get-src-block-info 'light)) + (src-lang (nth 0 info))) + (unless (string= (cdr (assoc :tangle (nth 2 info))) "no") + (unless (and language (not (string= language src-lang))) + (let* ((info (org-babel-get-src-block-info)) + (params (nth 2 info)) + (link (progn (call-interactively 'org-store-link) + (org-babel-clean-text-properties + (car (pop org-stored-links))))) + (source-name + (intern (or (nth 4 info) + (format "%s:%d" + current-heading block-counter)))) + (expand-cmd + (intern (concat "org-babel-expand-body:" src-lang))) + (assignments-cmd + (intern (concat "org-babel-variable-assignments:" src-lang))) + (body + ((lambda (body) + (if (assoc :no-expand params) + body + (if (fboundp expand-cmd) + (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params + (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) + (if (and (cdr (assoc :noweb params)) + (let ((nowebs (split-string + (cdr (assoc :noweb params))))) + (or (member "yes" nowebs) + (member "tangle" nowebs)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (comment + (when (or (string= "both" (cdr (assoc :comments params))) + (string= "org" (cdr (assoc :comments params)))) + ;; from the previous heading or code-block end + (buffer-substring + (max (condition-case nil + (save-excursion + (org-back-to-heading t) (point)) + (error 0)) + (save-excursion + (re-search-backward + org-babel-src-block-regexp nil t) + (match-end 0))) + (point)))) + by-lang) + ;; add the spec for this block to blocks under it's language + (setq by-lang (cdr (assoc src-lang blocks))) + (setq blocks (delq (assoc src-lang blocks) blocks)) + (setq blocks (cons + (cons src-lang + (cons (list start-line file link + source-name params body comment) + by-lang)) blocks))))))) + ;; ensure blocks in the correct order + (setq blocks + (mapcar + (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) + blocks)) + blocks)) + +(defun org-babel-spec-to-string (spec) + "Insert SPEC into the current file. +Insert the source-code specified by SPEC into the current +source code file. This function uses `comment-region' which +assumes that the appropriate major-mode is set. SPEC has the +form + + (start-line file link source-name params body comment)" + (let* ((start-line (nth 0 spec)) + (file (nth 1 spec)) + (link (org-link-escape (nth 2 spec))) + (source-name (nth 3 spec)) + (body (nth 5 spec)) + (comment (nth 6 spec)) + (comments (cdr (assoc :comments (nth 4 spec)))) + (link-p (or (string= comments "both") (string= comments "link") + (string= comments "yes"))) + (link-data (mapcar (lambda (el) + (cons (symbol-name el) + ((lambda (le) + (if (stringp le) le (format "%S" le))) + (eval el)))) + '(start-line file link source-name)))) + (flet ((insert-comment (text) + (let ((text (org-babel-trim text))) + (when (and comments (not (string= comments "no")) + (> (length text) 0)) + (when org-babel-tangle-pad-newline (insert "\n")) + (comment-region (point) (progn (insert text) (point))) + (end-of-line nil) (insert "\n"))))) + (when comment (insert-comment comment)) + (when link-p + (insert-comment + (org-fill-template org-babel-tangle-comment-format-beg link-data))) + (when org-babel-tangle-pad-newline (insert "\n")) + (insert + (format + "%s\n" + (replace-regexp-in-string + "^," "" + (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) + (when link-p + (insert-comment + (org-fill-template org-babel-tangle-comment-format-end link-data)))))) + +;; detangling functions +(defvar org-bracket-link-analytic-regexp) +(defun org-babel-detangle (&optional source-code-file) + "Propagate changes in source file back original to Org-mode file. +This requires that code blocks were tangled with link comments +which enable the original code blocks to be found." + (interactive) + (save-excursion + (when source-code-file (find-file source-code-file)) + (goto-char (point-min)) + (let ((counter 0) new-body end) + (while (re-search-forward org-bracket-link-analytic-regexp nil t) + (when (re-search-forward + (concat " " (regexp-quote (match-string 5)) " ends here")) + (setq end (match-end 0)) + (forward-line -1) + (save-excursion + (when (setq new-body (org-babel-tangle-jump-to-org)) + (org-babel-update-block-body new-body))) + (setq counter (+ 1 counter))) + (goto-char end)) + (prog1 counter (message "detangled %d code blocks" counter))))) + +(defun org-babel-tangle-jump-to-org () + "Jump from a tangled code file to the related Org-mode file." + (interactive) + (let ((mid (point)) + target-buffer target-char + start end link path block-name body) + (save-window-excursion + (save-excursion + (unless (and (re-search-backward org-bracket-link-analytic-regexp nil t) + (setq start (point-at-eol)) + (setq link (match-string 0)) + (setq path (match-string 3)) + (setq block-name (match-string 5)) + (re-search-forward + (concat " " (regexp-quote block-name) " ends here") nil t) + (setq end (point-at-bol)) + (< start mid) (< mid end)) + (error "not in tangled code")) + (setq body (org-babel-trim (buffer-substring start end)))) + (when (string-match "::" path) + (setq path (substring path 0 (match-beginning 0)))) + (find-file path) (setq target-buffer (current-buffer)) + (goto-char start) (org-open-link-from-string link) + (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name) + (org-babel-next-src-block + (string-to-number (match-string 1 block-name))) + (org-babel-goto-named-src-block block-name)) + (setq target-char (point))) + (pop-to-buffer target-buffer) + (prog1 body (goto-char target-char)))) + +(provide 'ob-tangle) + +;; arch-tag: 413ced93-48f5-4216-86e4-3fc5df8c8f24 + +;;; ob-tangle.el ends here diff --git a/lisp/org/ob.el b/lisp/org/ob.el new file mode 100644 index 00000000000..1c9f9fdbc12 --- /dev/null +++ b/lisp/org/ob.el @@ -0,0 +1,1968 @@ +;;; ob.el --- working with code blocks in org-mode + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.4 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; See the online documentation for more information +;; +;; http://orgmode.org/worg/org-contrib/babel/ + +;;; Code: +(eval-when-compile + (require 'org-list) + (require 'cl)) +(require 'ob-eval) +(require 'org-macs) + +(defvar org-babel-call-process-region-original) +(declare-function show-all "outline" ()) +(declare-function tramp-compat-make-temp-file "tramp-compat" + (filename &optional dir-flag)) +(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) +(declare-function tramp-file-name-user "tramp" (vec)) +(declare-function tramp-file-name-host "tramp" (vec)) +(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) +(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-edit-src-code "org-src" + (&optional context code edit-buffer-name quietp)) +(declare-function org-edit-src-exit "org-src" (&optional context)) +(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) +(declare-function org-save-outline-visibility "org" (use-markers &rest body)) +(declare-function org-outline-overlay-data "org" (&optional use-markers)) +(declare-function org-set-outline-overlay-data "org" (data)) +(declare-function org-narrow-to-subtree "org" ()) +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) +(declare-function org-make-options-regexp "org" (kwds &optional extra)) +(declare-function org-do-remove-indentation "org" (&optional n)) +(declare-function org-show-context "org" (&optional key)) +(declare-function org-at-table-p "org" (&optional table-type)) +(declare-function org-cycle "org" (&optional arg)) +(declare-function org-uniquify "org" (list)) +(declare-function org-current-level "org" ()) +(declare-function org-table-import "org-table" (file arg)) +(declare-function org-add-hook "org-compat" + (hook function &optional append local)) +(declare-function org-table-align "org-table" ()) +(declare-function org-table-end "org-table" (&optional table-type)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-orgtbl "org-table" (table params)) +(declare-function org-babel-lob-get-info "ob-lob" nil) +(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) +(declare-function org-babel-ref-parse "ob-ref" (assignment)) +(declare-function org-babel-ref-resolve "ob-ref" (ref)) +(declare-function org-babel-lob-execute-maybe "ob-lob" ()) +(declare-function org-number-sequence "org-compat" (from &optional to inc)) +(declare-function org-in-item-p "org-list" ()) +(declare-function org-list-parse-list "org-list" (&optional delete)) +(declare-function org-list-to-generic "org-list" (LIST PARAMS)) +(declare-function org-list-bottom-point "org-list" ()) + +(defgroup org-babel nil + "Code block evaluation and management in `org-mode' documents." + :tag "Babel" + :group 'org) + +(defcustom org-confirm-babel-evaluate t + "Confirm before evaluation. +Require confirmation before interactively evaluating code +blocks in Org-mode buffers. The default value of this variable +is t, meaning confirmation is required for any code block +evaluation. This variable can be set to nil to inhibit any +future confirmation requests. This variable can also be set to a +function which takes two arguments the language of the code block +and the body of the code block. Such a function should then +return a non-nil value if the user should be prompted for +execution or nil if no prompt is required. + +Warning: Disabling confirmation may result in accidental +evaluation of potentially harmful code. It may be advisable +remove code block execution from C-c C-c as further protection +against accidental code block evaluation. The +`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to +remove code block execution from the C-c C-c keybinding." + :group 'org-babel + :type '(choice boolean function)) +;; don't allow this variable to be changed through file settings +(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) + +(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil + "Remove code block evaluation from the C-c C-c key binding." + :group 'org-babel + :type 'boolean) + +(defvar org-babel-src-name-regexp + "^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*" + "Regular expression used to match a source name line.") + +(defvar org-babel-multi-line-header-regexp + "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$" + "Regular expression used to match multi-line header arguments.") + +(defvar org-babel-src-name-w-name-regexp + (concat org-babel-src-name-regexp + "\\(" + org-babel-multi-line-header-regexp + "\\)*" + "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)") + "Regular expression matching source name lines with a name.") + +(defvar org-babel-src-block-regexp + (concat + ;; (1) indentation (2) lang + "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*" + ;; (3) switches + "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)" + ;; (4) header arguments + "\\([^\n]*\\)\n" + ;; (5) body + "\\([^\000]+?\n\\)[ \t]*#\\+end_src") + "Regexp used to identify code blocks.") + +(defvar org-babel-inline-src-block-regexp + (concat + ;; (1) replacement target (2) lang + "[ \f\t\n\r\v]\\(src_\\([^ \f\t\n\r\v]+\\)" + ;; (3,4) (unused, headers) + "\\(\\|\\[\\(.*?\\)\\]\\)" + ;; (5) body + "{\\([^\f\n\r\v]+?\\)}\\)") + "Regexp used to identify inline src-blocks.") + +(defun org-babel-get-header (params key &optional others) + "Select only header argument of type KEY from a list. +Optional argument OTHERS indicates that only the header that do +not match KEY should be returned." + (delq nil + (mapcar + (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p)) + params))) + +(defun org-babel-get-src-block-info (&optional light) + "Get information on the current source block. + +Optional argument LIGHT does not resolve remote variable +references; a process which could likely result in the execution +of other code blocks. + +Returns a list + (language body header-arguments-alist switches name indent)." + (let ((case-fold-search t) head info name indent) + ;; full code block + (if (setq head (org-babel-where-is-src-block-head)) + (save-excursion + (goto-char head) + (setq info (org-babel-parse-src-block-match)) + (setq indent (car (last info))) + (setq info (butlast info)) + (while (and (forward-line -1) + (looking-at org-babel-multi-line-header-regexp)) + (setf (nth 2 info) + (org-babel-merge-params + (org-babel-parse-header-arguments (match-string 1)) + (nth 2 info)))) + (when (looking-at org-babel-src-name-w-name-regexp) + (setq name (org-babel-clean-text-properties (match-string 4))) + (when (match-string 6) + (setf (nth 2 info) ;; merge functional-syntax vars and header-args + (org-babel-merge-params + (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args (match-string 6))) + (nth 2 info)))))) + ;; inline source block + (when (save-excursion (re-search-backward "[ \f\t\n\r\v]" nil t) + (looking-at org-babel-inline-src-block-regexp)) + (setq info (org-babel-parse-inline-src-block-match)))) + ;; resolve variable references and add summary parameters + (when (and info (not light)) + (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) + (when info (append info (list name indent))))) + +(defun org-babel-confirm-evaluate (info) + "Confirm evaluation of the code block INFO. +This behavior can be suppressed by setting the value of +`org-confirm-babel-evaluate' to nil, in which case all future +interactive code block evaluations will proceed without any +confirmation from the user. + +Note disabling confirmation may result in accidental evaluation +of potentially harmful code." + (let* ((eval (or (cdr (assoc :eval (nth 2 info))) + (when (assoc :noeval (nth 2 info)) "no"))) + (query (or (equal eval "query") + (if (functionp org-confirm-babel-evaluate) + (funcall org-confirm-babel-evaluate + (nth 0 info) (nth 1 info)) + org-confirm-babel-evaluate)))) + (if (or (equal eval "never") (equal eval "no") + (and query + (not (yes-or-no-p + (format "Evaluate this%scode block%son your system? " + (if info (format " %s " (nth 0 info)) " ") + (if (nth 4 info) + (format " (%s) " (nth 4 info)) " ")))))) + (prog1 nil (message "Evaluation %s" + (if (or (equal eval "never") (equal eval "no")) + "Disabled" "Aborted"))) + t))) + +;;;###autoload +(defun org-babel-execute-safely-maybe () + (unless org-babel-no-eval-on-ctrl-c-ctrl-c + (org-babel-execute-maybe))) + +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe) + +;;;###autoload +(defun org-babel-execute-maybe () + (interactive) + (or (org-babel-execute-src-block-maybe) + (org-babel-lob-execute-maybe))) + +(defun org-babel-execute-src-block-maybe () + "Conditionally execute a source block. +Detect if this is context for a Babel src-block and if so +then run `org-babel-execute-src-block'." + (interactive) + (let ((info (org-babel-get-src-block-info))) + (if info + (progn (org-babel-eval-wipe-error-buffer) + (org-babel-execute-src-block current-prefix-arg info) t) nil))) + +;;;###autoload +(defun org-babel-expand-src-block-maybe () + "Conditionally expand a source block. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-expand-src-block'." + (interactive) + (let ((info (org-babel-get-src-block-info))) + (if info + (progn (org-babel-expand-src-block current-prefix-arg info) t) + nil))) + +;;;###autoload +(defun org-babel-load-in-session-maybe () + "Conditionally load a source block in a session. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-load-in-session'." + (interactive) + (let ((info (org-babel-get-src-block-info))) + (if info + (progn (org-babel-load-in-session current-prefix-arg info) t) + nil))) + +(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe) + +;;;###autoload +(defun org-babel-pop-to-session-maybe () + "Conditionally pop to a session. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-pop-to-session'." + (interactive) + (let ((info (org-babel-get-src-block-info))) + (if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil))) + +(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe) + +(defconst org-babel-header-arg-names + '(cache cmdline colnames dir exports file noweb results + session tangle var eval noeval comments) + "Common header arguments used by org-babel. +Note that individual languages may define their own language +specific header arguments as well.") + +(defvar org-babel-default-header-args + '((:session . "none") (:results . "replace") (:exports . "code") + (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")) + "Default arguments to use when evaluating a source block.") + +(defvar org-babel-default-inline-header-args + '((:session . "none") (:results . "silent") (:exports . "results")) + "Default arguments to use when evaluating an inline source block.") + +(defvar org-babel-current-buffer-properties nil + "Local cache for buffer properties.") +(make-variable-buffer-local 'org-babel-current-buffer-properties) + +(defvar org-babel-result-regexp + "^[ \t]*#\\+res\\(ults\\|name\\)\\(\\[\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*" + "Regular expression used to match result lines. +If the results are associated with a hash key then the hash will +be saved in the second match data.") + +(defvar org-babel-result-w-name-regexp + (concat org-babel-result-regexp + "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")) + +(defvar org-babel-min-lines-for-block-output 10 + "The minimum number of lines for block output. +If number of lines of output is equal to or exceeds this +value, the output is placed in a #+begin_example...#+end_example +block. Otherwise the output is marked as literal by inserting +colons at the starts of the lines. This variable only takes +effect if the :results output option is in effect.") + +(defvar org-babel-noweb-error-langs nil + "Languages for which Babel will raise literate programming errors. +List of languages for which errors should be raised when the +source code block satisfying a noweb reference in this language +can not be resolved.") + +(defvar org-babel-hash-show 4 + "Number of initial characters to show of a hidden results hash.") + +(defvar org-babel-after-execute-hook nil + "Hook for functions to be called after `org-babel-execute-src-block'") +(defun org-babel-named-src-block-regexp-for-name (name) + "This generates a regexp used to match a src block named NAME." + (concat org-babel-src-name-regexp (regexp-quote name) "[ \t\n]*" + (substring org-babel-src-block-regexp 1))) + +;;; functions +(defvar call-process-region) +;;;###autoload + +(defun org-babel-execute-src-block (&optional arg info params) + "Execute the current source code block. +Insert the results of execution into the buffer. Source code +execution and the collection and formatting of results can be +controlled through a variety of header arguments. + +With prefix argument ARG, force re-execution even if a an +existing result cached in the buffer would otherwise have been +returned. + +Optionally supply a value for INFO in the form returned by +`org-babel-get-src-block-info'. + +Optionally supply a value for PARAMS which will be merged with +the header arguments specified at the front of the source code +block." + (interactive) + (let ((info (or info (org-babel-get-src-block-info)))) + (when (org-babel-confirm-evaluate info) + (let* ((lang (nth 0 info)) + (params (if params + (org-babel-process-params + (org-babel-merge-params (nth 2 info) params)) + (nth 2 info))) + (cache? (and (not arg) (cdr (assoc :cache params)) + (string= "yes" (cdr (assoc :cache params))))) + (result-params (cdr (assoc :result-params params))) + (new-hash (when cache? (org-babel-sha1-hash info))) + (old-hash (when cache? (org-babel-result-hash info))) + (body (setf (nth 1 info) + (let ((noweb (cdr (assoc :noweb params)))) + (if (and noweb + (or (string= "yes" noweb) + (string= "tangle" noweb))) + (org-babel-expand-noweb-references info) + (nth 1 info))))) + (cmd (intern (concat "org-babel-execute:" lang))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (org-babel-call-process-region-original + (if (boundp 'org-babel-call-process-region-original) + org-babel-call-process-region-original + (symbol-function 'call-process-region))) + (indent (car (last info))) + result) + (unwind-protect + (flet ((call-process-region (&rest args) + (apply 'org-babel-tramp-handle-call-process-region args))) + (unless (fboundp cmd) + (error "No org-babel-execute function for %s!" lang)) + (if (and (not arg) new-hash (equal new-hash old-hash)) + (save-excursion ;; return cached result + (goto-char (org-babel-where-is-src-block-result nil info)) + (end-of-line 1) (forward-char 1) + (setq result (org-babel-read-result)) + (message (replace-regexp-in-string + "%" "%%" (format "%S" result))) result) + (message "executing %s code block%s..." + (capitalize lang) + (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) + (setq result + ((lambda (result) + (cond + ((member "file" result-params) + (cdr (assoc :file params))) + ((and (eq (cdr (assoc :result-type params)) 'value) + (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result))) + (t result))) + (funcall cmd body params))) + (org-babel-insert-result + result result-params info new-hash indent lang) + (run-hooks 'org-babel-after-execute-hook) + result)) + (setq call-process-region 'org-babel-call-process-region-original)))))) + +(defun org-babel-expand-body:generic (body params &optional var-lines) + "Expand BODY with PARAMS. +Expand a block of code with org-babel according to it's header +arguments. This generic implementation of body expansion is +called for languages which have not defined their own specific +org-babel-expand-body:lang function." + (mapconcat #'identity (append var-lines (list body)) "\n")) + +;;;###autoload +(defun org-babel-expand-src-block (&optional arg info params) + "Expand the current source code block. +Expand according to the source code block's header +arguments and pop open the results in a preview buffer." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (params (setf (nth 2 info) + (sort (org-babel-merge-params (nth 2 info) params) + (lambda (el1 el2) (string< (symbol-name (car el1)) + (symbol-name (car el2))))))) + (body (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) (nth 1 info)))) + (expand-cmd (intern (concat "org-babel-expand-body:" lang))) + (assignments-cmd (intern (concat "org-babel-variable-assignments:" lang))) + (expanded + (if (fboundp expand-cmd) (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params (and (fboundp assignments-cmd) (funcall assignments-cmd params)))))) + (org-edit-src-code + nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")))) + +;;;###autoload +(defun org-babel-load-in-session (&optional arg info) + "Load the body of the current source-code block. +Evaluate the header arguments for the source block before +entering the session. After loading the body this pops open the +session." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (params (nth 2 info)) + (body (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (session (cdr (assoc :session params))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (cmd (intern (concat "org-babel-load-session:" lang)))) + (unless (fboundp cmd) + (error "No org-babel-load-session function for %s!" lang)) + (pop-to-buffer (funcall cmd session body params)) + (end-of-line 1))) + +;;;###autoload +(defun org-babel-initiate-session (&optional arg info) + "Initiate session for current code block. +If called with a prefix argument then resolve any variable +references in the header arguments and assign these variables in +the session. Copy the body of the code block to the kill ring." + (interactive "P") + (let* ((info (or info (org-babel-get-src-block-info (not arg)))) + (lang (nth 0 info)) + (body (nth 1 info)) + (params (nth 2 info)) + (session (cdr (assoc :session params))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (init-cmd (intern (format "org-babel-%s-initiate-session" lang))) + (prep-cmd (intern (concat "org-babel-prep-session:" lang)))) + (if (and (stringp session) (string= session "none")) + (error "This block is not using a session!")) + (unless (fboundp init-cmd) + (error "No org-babel-initiate-session function for %s!" lang)) + (with-temp-buffer (insert (org-babel-trim body)) + (copy-region-as-kill (point-min) (point-max))) + (when arg + (unless (fboundp prep-cmd) + (error "No org-babel-prep-session function for %s!" lang)) + (funcall prep-cmd session params)) + (funcall init-cmd session params))) + +;;;###autoload +(defun org-babel-switch-to-session (&optional arg info) + "Switch to the session of the current code block. +Uses `org-babel-initiate-session' to start the session. If called +with a prefix argument then this is passed on to +`org-babel-initiate-session'." + (interactive "P") + (pop-to-buffer (org-babel-initiate-session arg info)) + (end-of-line 1)) + +(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) + +;;;###autoload +(defun org-babel-switch-to-session-with-code (&optional arg info) + "Switch to code buffer and display session." + (interactive "P") + (flet ((swap-windows + () + (let ((other-window-buffer (window-buffer (next-window)))) + (set-window-buffer (next-window) (current-buffer)) + (set-window-buffer (selected-window) other-window-buffer)) + (other-window 1))) + (let ((info (org-babel-get-src-block-info)) + (org-src-window-setup 'reorganize-frame)) + (save-excursion + (org-babel-switch-to-session arg info)) + (org-edit-src-code)) + (swap-windows))) + +(defmacro org-babel-do-in-edit-buffer (&rest body) + "Evaluate BODY in edit buffer if there is a code block at point. +Return t if a code block was found at point, nil otherwise." + `(let ((org-src-window-setup 'switch-invisibly)) + (when (and (org-babel-where-is-src-block-head) + (org-edit-src-code nil nil nil 'quietly)) + (unwind-protect (progn ,@body) + (if (org-bound-and-true-p org-edit-src-from-org-mode) + (org-edit-src-exit))) + t))) + +(defun org-babel-do-key-sequence-in-edit-buffer (key) + "Read key sequence and execute the command in edit buffer. +Enter a key sequence to be executed in the language major-mode +edit buffer. For example, TAB will alter the contents of the +Org-mode code block according to the effect of TAB in the +language major-mode buffer. For languages that support +interactive sessions, this can be used to send code from the Org +buffer to the session for evaluation using the native major-mode +evaluation mechanisms." + (interactive "kEnter key-sequence to execute in edit buffer: ") + (org-babel-do-in-edit-buffer + (call-interactively + (key-binding (or key (read-key-sequence nil)))))) + +(defvar org-bracket-link-regexp) +;;;###autoload +(defun org-babel-open-src-block-result (&optional re-run) + "If `point' is on a src block then open the results of the +source code block, otherwise return nil. With optional prefix +argument RE-RUN the source-code block is evaluated even if +results already exist." + (interactive "P") + (when (org-babel-get-src-block-info) + (save-excursion + ;; go to the results, if there aren't any then run the block + (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result)) + (progn (org-babel-execute-src-block) + (org-babel-where-is-src-block-result)))) + (end-of-line 1) + (while (looking-at "[\n\r\t\f ]") (forward-char 1)) + ;; open the results + (if (looking-at org-bracket-link-regexp) + ;; file results + (org-open-at-point) + (let ((results (org-babel-read-result))) + (flet ((echo-res (result) + (if (stringp result) result (format "%S" result)))) + (pop-to-buffer (get-buffer-create "org-babel-results")) + (delete-region (point-min) (point-max)) + (if (listp results) + ;; table result + (insert (orgtbl-to-generic results '(:sep "\t" :fmt echo-res))) + ;; scalar result + (insert (echo-res results)))))) + t))) + +;;;###autoload +(defmacro org-babel-map-src-blocks (file &rest body) + "Evaluate BODY forms on each source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer. During evaluation of BODY the following local variables +are set relative to the currently matched code block. + +full-block ------- string holding the entirety of the code block +beg-block -------- point at the beginning of the code block +end-block -------- point at the end of the matched code block +lang ------------- string holding the language of the code block +beg-lang --------- point at the beginning of the lang +end-lang --------- point at the end of the lang +switches --------- string holding the switches +beg-switches ----- point at the beginning of the switches +end-switches ----- point at the end of the switches +header-args ------ string holding the header-args +beg-header-args -- point at the beginning of the header-args +end-header-args -- point at the end of the header-args +body ------------- string holding the body of the code block +beg-body --------- point at the beginning of the body +end-body --------- point at the end of the body" + (declare (indent 1)) + (let ((tempvar (make-symbol "file"))) + `(let* ((,tempvar ,file) + (visited-p (or (null ,tempvar) + (get-file-buffer (expand-file-name ,tempvar)))) + (point (point)) to-be-removed) + (save-window-excursion + (when ,tempvar (find-file ,tempvar)) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward org-babel-src-block-regexp nil t) + (goto-char (match-beginning 0)) + (let ((full-block (match-string 0)) + (beg-block (match-beginning 0)) + (end-block (match-end 0)) + (lang (match-string 2)) + (beg-lang (match-beginning 2)) + (end-lang (match-end 2)) + (switches (match-string 3)) + (beg-switches (match-beginning 3)) + (end-switches (match-end 3)) + (header-args (match-string 4)) + (beg-header-args (match-beginning 4)) + (end-header-args (match-end 4)) + (body (match-string 5)) + (beg-body (match-beginning 5)) + (end-body (match-end 5))) + ,@body + (goto-char end-block)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) + +;;;###autoload +(defun org-babel-execute-buffer (&optional arg) + "Execute source code blocks in a buffer. +Call `org-babel-execute-src-block' on every source block in +the current buffer." + (interactive "P") + (org-save-outline-visibility t + (org-babel-map-src-blocks nil + (org-babel-execute-src-block arg)))) + +;;;###autoload +(defun org-babel-execute-subtree (&optional arg) + "Execute source code blocks in a subtree. +Call `org-babel-execute-src-block' on every source block in +the current subtree." + (interactive "P") + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (org-babel-execute-buffer arg) + (widen)))) + +;;;###autoload +(defun org-babel-sha1-hash (&optional info) + "Generate an sha1 hash based on the value of info." + (interactive) + (let ((print-level nil) + (info (or info (org-babel-get-src-block-info)))) + (setf (nth 2 info) + (sort (copy-sequence (nth 2 info)) + (lambda (a b) (string< (car a) (car b))))) + (let ((hash (sha1 + (format "%s-%s" + (mapconcat + #'identity + (delq nil + (mapcar + (lambda (arg) + (let ((v (cdr arg))) + (when (and v (not (and (sequencep v) + (not (consp v)) + (= (length v) 0)))) + (format "%S" v)))) + (nth 2 info))) ":") + (nth 1 info))))) + (when (interactive-p) (message hash)) + hash))) + +(defun org-babel-result-hash (&optional info) + "Return the in-buffer hash associated with INFO." + (org-babel-where-is-src-block-result nil info) + (org-babel-clean-text-properties (match-string 3))) + +(defun org-babel-hide-hash () + "Hide the hash in the current results line. +Only the initial `org-babel-hash-show' characters of the hash +will remain visible." + (add-to-invisibility-spec '(org-babel-hide-hash . t)) + (save-excursion + (when (and (re-search-forward org-babel-result-regexp nil t) + (match-string 3)) + (let* ((start (match-beginning 3)) + (hide-start (+ org-babel-hash-show start)) + (end (match-end 3)) + (hash (match-string 3)) + ov1 ov2) + (setq ov1 (make-overlay start hide-start)) + (setq ov2 (make-overlay hide-start end)) + (overlay-put ov2 'invisible 'org-babel-hide-hash) + (overlay-put ov1 'babel-hash hash))))) + +(defun org-babel-hide-all-hashes () + "Hide the hash in the current buffer. +Only the initial `org-babel-hash-show' characters of each hash +will remain visible. This function should be called as part of +the `org-mode-hook'." + (save-excursion + (while (re-search-forward org-babel-result-regexp nil t) + (goto-char (match-beginning 0)) + (org-babel-hide-hash) + (goto-char (match-end 0))))) +(add-hook 'org-mode-hook 'org-babel-hide-all-hashes) + +(defun org-babel-hash-at-point (&optional point) + "Return the value of the hash at POINT. +The hash is also added as the last element of the kill ring. +This can be called with C-c C-c." + (interactive) + (let ((hash (car (delq nil (mapcar + (lambda (ol) (overlay-get ol 'babel-hash)) + (overlays-at (or point (point)))))))) + (when hash (kill-new hash) (message hash)))) +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point) + +(defun org-babel-result-hide-spec () + "Hide portions of results lines. +Add `org-babel-hide-result' as an invisibility spec for hiding +portions of results lines." + (add-to-invisibility-spec '(org-babel-hide-result . t))) +(add-hook 'org-mode-hook 'org-babel-result-hide-spec) + +(defvar org-babel-hide-result-overlays nil + "Overlays hiding results.") + +(defun org-babel-result-hide-all () + "Fold all results in the current buffer." + (interactive) + (org-babel-show-result-all) + (save-excursion + (while (re-search-forward org-babel-result-regexp nil t) + (save-excursion (goto-char (match-beginning 0)) + (org-babel-hide-result-toggle-maybe))))) + +(defun org-babel-show-result-all () + "Unfold all results in the current buffer." + (mapc 'delete-overlay org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays nil)) + +;;;###autoload +(defun org-babel-hide-result-toggle-maybe () + "Toggle visibility of result at point." + (interactive) + (let ((case-fold-search t)) + (if (save-excursion + (beginning-of-line 1) + (looking-at org-babel-result-regexp)) + (progn (org-babel-hide-result-toggle) + t) ;; to signal that we took action + nil))) ;; to signal that we did not + +(defun org-babel-hide-result-toggle (&optional force) + "Toggle the visibility of the current result." + (interactive) + (save-excursion + (beginning-of-line) + (if (re-search-forward org-babel-result-regexp nil t) + (let ((start (progn (beginning-of-line 2) (- (point) 1))) + (end (progn (goto-char (- (org-babel-result-end) 1)) (point))) + ov) + (if (memq t (mapcar (lambda (overlay) + (eq (overlay-get overlay 'invisible) + 'org-babel-hide-result)) + (overlays-at start))) + (if (or (not force) (eq force 'off)) + (mapc (lambda (ov) + (when (member ov org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays + (delq ov org-babel-hide-result-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-babel-hide-result) + (delete-overlay ov))) + (overlays-at start))) + (setq ov (make-overlay start end)) + (overlay-put ov 'invisible 'org-babel-hide-result) + ;; make the block accessible to isearch + (overlay-put + ov 'isearch-open-invisible + (lambda (ov) + (when (member ov org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays + (delq ov org-babel-hide-result-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-babel-hide-result) + (delete-overlay ov)))) + (push ov org-babel-hide-result-overlays))) + (error "Not looking at a result line")))) + +;; org-tab-after-check-for-cycling-hook +(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) +;; Remove overlays when changing major mode +(add-hook 'org-mode-hook + (lambda () (org-add-hook 'change-major-mode-hook + 'org-babel-show-result-all 'append 'local))) + +(defvar org-file-properties) +(defun org-babel-params-from-properties (&optional lang) + "Retrieve parameters specified as properties. +Return an association list of any source block params which +may be specified in the properties of the current outline entry." + (save-match-data + (let (val sym) + (delq nil + (mapcar + (lambda (header-arg) + (and (setq val + (or (condition-case nil + (org-entry-get (point) header-arg t) + (error nil)) + (cdr (assoc header-arg org-file-properties)))) + (cons (intern (concat ":" header-arg)) + (org-babel-read val)))) + (mapcar + 'symbol-name + (append + org-babel-header-arg-names + (progn + (setq sym (intern (concat "org-babel-header-arg-names:" lang))) + (and (boundp sym) (eval sym)))))))))) + +(defun org-babel-params-from-buffer () + "Retrieve per-buffer parameters. + Return an association list of any source block params which +may be specified at the top of the current buffer." + (or org-babel-current-buffer-properties + (setq org-babel-current-buffer-properties + (save-match-data + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (when (re-search-forward + (org-make-options-regexp (list "BABEL")) nil t) + (org-babel-parse-header-arguments + (org-match-string-no-properties 2))))))))) + +(defvar org-src-preserve-indentation) +(defun org-babel-parse-src-block-match () + "Parse the results from a match of the `org-babel-src-block-regexp'." + (let* ((block-indentation (length (match-string 1))) + (lang (org-babel-clean-text-properties (match-string 2))) + (lang-headers (intern (concat "org-babel-default-header-args:" lang))) + (switches (match-string 3)) + (body (org-babel-clean-text-properties (match-string 5))) + (preserve-indentation (or org-src-preserve-indentation + (string-match "-i\\>" switches)))) + (list lang + ;; get block body less properties, protective commas, and indentation + (with-temp-buffer + (save-match-data + (insert (org-babel-strip-protective-commas body)) + (unless preserve-indentation (org-do-remove-indentation)) + (buffer-string))) + (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties lang) + (if (boundp lang-headers) (eval lang-headers) nil) + (org-babel-parse-header-arguments + (org-babel-clean-text-properties (or (match-string 4) "")))) + switches + block-indentation))) + +(defun org-babel-parse-inline-src-block-match () + "Parse the results from a match of the `org-babel-inline-src-block-regexp'." + (let* ((lang (org-babel-clean-text-properties (match-string 2))) + (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) + (list lang + (org-babel-strip-protective-commas + (org-babel-clean-text-properties (match-string 5))) + (org-babel-merge-params + org-babel-default-inline-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties lang) + (if (boundp lang-headers) (eval lang-headers) nil) + (org-babel-parse-header-arguments + (org-babel-clean-text-properties (or (match-string 4) ""))))))) + +(defun org-babel-parse-header-arguments (arg-string) + "Parse a string of header arguments returning an alist." + (when (> (length arg-string) 0) + (delq nil + (mapcar + (lambda (arg) + (if (string-match + "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" + arg) + (cons (intern (match-string 1 arg)) + (org-babel-read (org-babel-chomp (match-string 2 arg)))) + (cons (intern (org-babel-chomp arg)) nil))) + (let ((balance 0) (partial nil) (lst nil) (last 0)) + (mapc (lambda (ch) ; split on [] balanced instances of [ \t]: + (setq balance (+ balance + (cond ((equal 91 ch) 1) + ((equal 93 ch) -1) + (t 0)))) + (setq partial (cons ch partial)) + (when (and (= ch 58) (= balance 0) + (or (= last 32) (= last 9))) + (setq lst (cons (apply #'string (nreverse (cddr partial))) + lst)) + (setq partial (list ch))) + (setq last ch)) + (string-to-list arg-string)) + (nreverse (cons (apply #'string (nreverse partial)) lst))))))) + +(defun org-babel-process-params (params) + "Expand variables in PARAMS and add summary parameters." + (let* ((vars-and-names (org-babel-disassemble-tables + (mapcar (lambda (el) + (if (consp (cdr el)) + (cdr el) (org-babel-ref-parse (cdr el)))) + (org-babel-get-header params :var)) + (cdr (assoc :hlines params)) + (cdr (assoc :colnames params)) + (cdr (assoc :rownames params)))) + (result-params (append + (split-string (or (cdr (assoc :results params)) "")) + (cdr (assoc :result-params params))))) + (append + (mapcar (lambda (var) (cons :var var)) (car vars-and-names)) + (list + (cons :colname-names (cadr vars-and-names)) + (cons :rowname-names (caddr vars-and-names)) + (cons :result-params result-params) + (cons :result-type (cond ((member "output" result-params) 'output) + ((member "value" result-params) 'value) + (t 'value)))) + (org-babel-get-header params :var 'other)))) + +;; row and column names +(defun org-babel-del-hlines (table) + "Remove all 'hlines from TABLE." + (remove 'hline table)) + +(defun org-babel-get-colnames (table) + "Return the column names of TABLE. +Return a cons cell, the `car' of which contains the TABLE less +colnames, and the `cdr' of which contains a list of the column +names." + (if (equal 'hline (nth 1 table)) + (cons (cddr table) (car table)) + (cons (cdr table) (car table)))) + +(defun org-babel-get-rownames (table) + "Return the row names of TABLE. +Return a cons cell, the `car' of which contains the TABLE less +colnames, and the `cdr' of which contains a list of the column +names. Note: this function removes any hlines in TABLE." + (flet ((trans (table) (apply #'mapcar* #'list table))) + (let* ((width (apply 'max + (mapcar (lambda (el) (if (listp el) (length el) 0)) table))) + (table (trans (mapcar (lambda (row) + (if (not (equal row 'hline)) + row + (setq row '()) + (dotimes (n width) + (setq row (cons 'hline row))) + row)) + table)))) + (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row)) + (trans (cdr table))) + (remove 'hline (car table)))))) + +(defun org-babel-put-colnames (table colnames) + "Add COLNAMES to TABLE if they exist." + (if colnames (apply 'list colnames 'hline table) table)) + +(defun org-babel-put-rownames (table rownames) + "Add ROWNAMES to TABLE if they exist." + (if rownames + (mapcar (lambda (row) + (if (listp row) + (cons (or (pop rownames) "") row) + row)) table) + table)) + +(defun org-babel-pick-name (names selector) + "Select one out of an alist of row or column names. +SELECTOR can be either a list of names in which case those names +will be returned directly, or an index into the list NAMES in +which case the indexed names will be return." + (if (listp selector) + selector + (when names + (if (and selector (symbolp selector) (not (equal t selector))) + (cdr (assoc selector names)) + (if (integerp selector) + (nth (- selector 1) names) + (cdr (car (last names)))))))) + +(defun org-babel-disassemble-tables (vars hlines colnames rownames) + "Parse tables for further processing. +Process the variables in VARS according to the HLINES, +ROWNAMES and COLNAMES header arguments. Return a list consisting +of the vars, cnames and rnames." + (let (cnames rnames) + (list + (mapcar + (lambda (var) + (when (listp (cdr var)) + (when (and (not (equal colnames "no")) + (or colnames (and (equal (nth 1 (cdr var)) 'hline) + (not (member 'hline (cddr (cdr var))))))) + (let ((both (org-babel-get-colnames (cdr var)))) + (setq cnames (cons (cons (car var) (cdr both)) + cnames)) + (setq var (cons (car var) (car both))))) + (when (and rownames (not (equal rownames "no"))) + (let ((both (org-babel-get-rownames (cdr var)))) + (setq rnames (cons (cons (car var) (cdr both)) + rnames)) + (setq var (cons (car var) (car both))))) + (when (and hlines (not (equal hlines "yes"))) + (setq var (cons (car var) (org-babel-del-hlines (cdr var)))))) + var) + vars) + cnames rnames))) + +(defun org-babel-reassemble-table (table colnames rownames) + "Add column and row names to a table. +Given a TABLE and set of COLNAMES and ROWNAMES add the names +to the table for reinsertion to org-mode." + (if (listp table) + ((lambda (table) + (if (and colnames (listp (car table)) (= (length (car table)) + (length colnames))) + (org-babel-put-colnames table colnames) table)) + (if (and rownames (= (length table) (length rownames))) + (org-babel-put-rownames table rownames) table)) + table)) + +(defun org-babel-where-is-src-block-head () + "Find where the current source block begins. +Return the point at the beginning of the current source +block. Specifically at the beginning of the #+BEGIN_SRC line. +If the point is not on a source block then return nil." + (let ((initial (point)) top bottom) + (or + (save-excursion ;; on a source name line + (beginning-of-line 1) + (and (looking-at org-babel-src-name-regexp) (forward-line 1) + (looking-at org-babel-src-block-regexp) + (point))) + (save-excursion ;; on a #+begin_src line + (beginning-of-line 1) + (and (looking-at org-babel-src-block-regexp) + (point))) + (save-excursion ;; inside a src block + (and + (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point)) + (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point)) + (< top initial) (< initial bottom) + (progn (goto-char top) (beginning-of-line 1) + (looking-at org-babel-src-block-regexp)) + (point)))))) + +;;;###autoload +(defun org-babel-goto-src-block-head () + "Go to the beginning of the current code block." + (interactive) + ((lambda (head) + (if head (goto-char head) (error "not currently in a code block"))) + (org-babel-where-is-src-block-head))) + +;;;###autoload +(defun org-babel-goto-named-src-block (name) + "Go to a named source-code block." + (interactive + (let ((completion-ignore-case t)) + (list (org-icompleting-read "source-block name: " + (org-babel-src-block-names) nil t)))) + (let ((point (org-babel-find-named-block name))) + (if point + ;; taken from `org-open-at-point' + (progn (goto-char point) (org-show-context)) + (message "source-code block '%s' not found in this buffer" name)))) + +(defun org-babel-find-named-block (name) + "Find a named source-code block. +Return the location of the source block identified by source +NAME, or nil if no such block exists. Set match data according to +org-babel-named-src-block-regexp." + (save-excursion + (let ((case-fold-search t) + (regexp (org-babel-named-src-block-regexp-for-name name)) msg) + (goto-char (point-min)) + (when (or (re-search-forward regexp nil t) + (re-search-backward regexp nil t)) + (match-beginning 0))))) + +(defun org-babel-src-block-names (&optional file) + "Returns the names of source blocks in FILE or the current buffer." + (save-excursion + (when file (find-file file)) (goto-char (point-min)) + (let (names) + (while (re-search-forward org-babel-src-name-w-name-regexp nil t) + (setq names (cons (org-babel-clean-text-properties (match-string 3)) + names))) + names))) + +;;;###autoload +(defun org-babel-goto-named-result (name) + "Go to a named result." + (interactive + (let ((completion-ignore-case t)) + (list (org-icompleting-read "source-block name: " + (org-babel-result-names) nil t)))) + (let ((point (org-babel-find-named-result name))) + (if point + ;; taken from `org-open-at-point' + (progn (goto-char point) (org-show-context)) + (message "result '%s' not found in this buffer" name)))) + +(defun org-babel-find-named-result (name) + "Find a named result. +Return the location of the result named NAME in the current +buffer or nil if no such result exists." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward + (concat org-babel-result-regexp + "[ \t]" (regexp-quote name) "[ \t\n\f\v\r]") nil t) + (beginning-of-line 0) (point)))) + +(defun org-babel-result-names (&optional file) + "Returns the names of results in FILE or the current buffer." + (save-excursion + (when file (find-file file)) (goto-char (point-min)) + (let (names) + (while (re-search-forward org-babel-result-w-name-regexp nil t) + (setq names (cons (org-babel-clean-text-properties (match-string 4)) + names))) + names))) + +;;;###autoload +(defun org-babel-next-src-block (&optional arg) + "Jump to the next source block. +With optional prefix argument ARG, jump forward ARG many source blocks." + (interactive "P") + (when (looking-at org-babel-src-block-regexp) (forward-char 1)) + (condition-case nil + (re-search-forward org-babel-src-block-regexp nil nil (or arg 1)) + (error (error "No further code blocks"))) + (goto-char (match-beginning 0)) (org-show-context)) + +;;;###autoload +(defun org-babel-previous-src-block (&optional arg) + "Jump to the previous source block. +With optional prefix argument ARG, jump backward ARG many source blocks." + (interactive "P") + (condition-case nil + (re-search-backward org-babel-src-block-regexp nil nil (or arg 1)) + (error (error "No previous code blocks"))) + (goto-char (match-beginning 0)) (org-show-context)) + +(defvar org-babel-load-languages) + +;;;###autoload +(defun org-babel-mark-block () + "Mark current src block" + (interactive) + ((lambda (head) + (when head + (save-excursion + (goto-char head) + (looking-at org-babel-src-block-regexp)) + (push-mark (match-end 5) nil t) + (goto-char (match-beginning 5)))) + (org-babel-where-is-src-block-head))) + +(defun org-babel-demarcate-block (&optional arg) + "Wrap or split the code in the region or on the point. +When called from inside of a code block the current block is +split. When called from outside of a code block a new code block +is created. In both cases if the region is demarcated and if the +region is not active then the point is demarcated." + (interactive "P") + (let ((info (org-babel-get-src-block-info 'light)) + (stars (concat (make-string (or (org-current-level) 1) ?*) " "))) + (if info + (mapc + (lambda (place) + (save-excursion + (goto-char place) + (let ((lang (nth 0 info)) + (indent (make-string (nth 5 info) ? ))) + (when (string-match "^[[:space:]]*$" + (buffer-substring (point-at-bol) + (point-at-eol))) + (delete-region (point-at-bol) (point-at-eol))) + (insert (concat (if (looking-at "^") "" "\n") + indent "#+end_src\n" + (if arg stars indent) "\n" + indent "#+begin_src " lang + (if (looking-at "[\n\r]") "" "\n"))))) + (move-end-of-line 2)) + (sort (if (region-active-p) (list (mark) (point)) (list (point))) #'>)) + (let ((start (point)) + (lang (org-icompleting-read "Lang: " + (mapcar (lambda (el) (symbol-name (car el))) + org-babel-load-languages))) + (body (delete-and-extract-region + (if (region-active-p) (mark) (point)) (point)))) + (insert (concat (if (looking-at "^") "" "\n") + (if arg (concat stars "\n") "") + "#+begin_src " lang "\n" + body + (if (or (= (length body) 0) + (string-match "[\r\n]$" body)) "" "\n") + "#+end_src\n")) + (goto-char start) (move-end-of-line 1))))) + +(defvar org-babel-lob-one-liner-regexp) +(defun org-babel-where-is-src-block-result (&optional insert info hash indent) + "Find where the current source block results begin. +Return the point at the beginning of the result of the current +source block. Specifically at the beginning of the results line. +If no result exists for this block then create a results line +following the source block." + (save-excursion + (let* ((on-lob-line (progn (beginning-of-line 1) + (looking-at org-babel-lob-one-liner-regexp))) + (name (if on-lob-line + (nth 0 (org-babel-lob-get-info)) + (nth 4 (or info (org-babel-get-src-block-info))))) + (head (unless on-lob-line (org-babel-where-is-src-block-head))) + found beg end) + (when head (goto-char head)) + (setq + found ;; was there a result (before we potentially insert one) + (or + (and + ;; named results: + ;; - return t if it is found, else return nil + ;; - if it does not need to be rebuilt, then don't set end + ;; - if it does need to be rebuilt then do set end + name (setq beg (org-babel-find-named-result name)) + (prog1 beg + (when (and hash (not (string= hash (match-string 3)))) + (goto-char beg) (setq end beg) ;; beginning of result + (forward-line 1) + (delete-region end (org-babel-result-end)) nil))) + (and + ;; unnamed results: + ;; - return t if it is found, else return nil + ;; - if it is found, and the hash doesn't match, delete and set end + (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t)) + (progn (end-of-line 1) + (if (eobp) (insert "\n") (forward-char 1)) + (setq end (point)) + (or (and (not name) + (progn ;; unnamed results line already exists + (re-search-forward "[^ \f\t\n\r\v]" nil t) + (beginning-of-line 1) + (looking-at + (concat org-babel-result-regexp "\n"))) + (prog1 (point) + ;; must remove and rebuild if hash!=old-hash + (if (and hash (not (string= hash (match-string 3)))) + (prog1 nil + (forward-line 1) + (delete-region + end (org-babel-result-end))) + (setq end nil))))))))) + (if (and insert end) + (progn + (goto-char end) + (unless beg + (if (looking-at "[\n\r]") (forward-char 1) (insert "\n"))) + (insert (concat + (if indent + (mapconcat + (lambda (el) " ") + (org-number-sequence 1 indent) "") + "") + "#+results" + (when hash (concat "["hash"]")) + ":" + (when name (concat " " name)) "\n")) + (unless beg (insert "\n") (backward-char)) + (beginning-of-line 0) + (if hash (org-babel-hide-hash)) + (point)) + found)))) + +(defvar org-block-regexp) +(defun org-babel-read-result () + "Read the result at `point' into emacs-lisp." + (let ((case-fold-search t) result-string) + (cond + ((org-at-table-p) (org-babel-read-table)) + ((org-in-item-p) (org-babel-read-list)) + ((looking-at org-bracket-link-regexp) (org-babel-read-link)) + ((looking-at org-block-regexp) (org-babel-trim (match-string 4))) + ((looking-at "^[ \t]*: ") + (setq result-string + (org-babel-trim + (mapconcat (lambda (line) + (if (and (> (length line) 1) + (string-match "^[ \t]*: \\(.+\\)" line)) + (match-string 1 line) + line)) + (split-string + (buffer-substring + (point) (org-babel-result-end)) "[\r\n]+") + "\n"))) + (or (org-babel-number-p result-string) result-string)) + ((looking-at org-babel-result-regexp) + (save-excursion (forward-line 1) (org-babel-read-result)))))) + +(defun org-babel-read-table () + "Read the table at `point' into emacs-lisp." + (mapcar (lambda (row) + (if (and (symbolp row) (equal row 'hline)) row + (mapcar #'org-babel-read row))) + (org-table-to-lisp))) + +(defun org-babel-read-list () + "Read the list at `point' into emacs-lisp." + (mapcar #'org-babel-read (cdr (org-list-parse-list)))) + +(defvar org-link-types-re) +(defun org-babel-read-link () + "Read the link at `point' into emacs-lisp. +If the path of the link is a file path it is expanded using +`expand-file-name'." + (let* ((case-fold-search t) + (raw (and (looking-at org-bracket-link-regexp) + (org-babel-clean-text-properties (match-string 1)))) + (type (and (string-match org-link-types-re raw) + (match-string 1 raw)))) + (cond + ((not type) (expand-file-name raw)) + ((string= type "file") + (and (string-match "file\\(.*\\):\\(.+\\)" raw) + (expand-file-name (match-string 2 raw)))) + (t raw)))) + +(defun org-babel-insert-result + (result &optional result-params info hash indent lang) + "Insert RESULT into the current buffer. +By default RESULT is inserted after the end of the +current source block. With optional argument RESULT-PARAMS +controls insertion of results in the org-mode file. +RESULT-PARAMS can take the following values... + +replace - (default option) insert results after the source block + replacing any previously inserted results + +silent -- no results are inserted + +file ---- the results are interpreted as a file path, and are + inserted into the buffer using the Org-mode file syntax + +list ---- the results are interpreted as an Org-mode list. + +raw ----- results are added directly to the Org-mode file. This + is a good option if you code block will output org-mode + formatted text. + +org ----- similar in effect to raw, only the results are wrapped + in an org code block. Similar to the raw option, on + export the results will be interpreted as org-formatted + text, however by wrapping the results in an org code + block they can be replaced upon re-execution of the + code block. + +html ---- results are added inside of a #+BEGIN_HTML block. This + is a good option if you code block will output html + formatted text. + +latex --- results are added inside of a #+BEGIN_LATEX block. + This is a good option if you code block will output + latex formatted text. + +code ---- the results are extracted in the syntax of the source + code of the language being evaluated and are added + inside of a #+BEGIN_SRC block with the source-code + language set appropriately. Note this relies on the + optional LANG argument." + (if (stringp result) + (progn + (setq result (org-babel-clean-text-properties result)) + (when (member "file" result-params) + (setq result (org-babel-result-to-file result)))) + (unless (listp result) (setq result (format "%S" result)))) + (if (and result-params (member "silent" result-params)) + (progn + (message (replace-regexp-in-string "%" "%%" (format "%S" result))) + result) + (when (and (stringp result) ;; ensure results end in a newline + (> (length result) 0) + (not (or (string-equal (substring result -1) "\n") + (string-equal (substring result -1) "\r")))) + (setq result (concat result "\n"))) + (save-excursion + (let ((existing-result (org-babel-where-is-src-block-result + t info hash indent)) + (results-switches + (cdr (assoc :results_switches (nth 2 info)))) + beg end) + (if (not existing-result) + (setq beg (point)) + (goto-char existing-result) + (save-excursion + (re-search-forward "#" nil t) + (setq indent (- (current-column) 1))) + (forward-line 1) + (setq beg (point)) + (cond + ((member "replace" result-params) + (delete-region (point) (org-babel-result-end))) + ((member "append" result-params) + (goto-char (org-babel-result-end)) (setq beg (point-marker))) + ((member "prepend" result-params)))) ; already there + (setq results-switches + (if results-switches (concat " " results-switches) "")) + ;; insert results based on type + (cond + ;; do nothing for an empty result + ((= (length result) 0)) + ;; insert a list if preferred + ((member "list" result-params) + (insert + (org-babel-trim + (org-list-to-generic (cons 'unordered + (if (listp result) result (list result))) + '(:splicep nil :istart "- " :iend "\n"))))) + ;; assume the result is a table if it's not a string + ((not (stringp result)) + (goto-char beg) + (insert (concat (orgtbl-to-orgtbl + (if (or (eq 'hline (car result)) + (and (listp (car result)) + (listp (cdr (car result))))) + result (list result)) + '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) + (goto-char beg) (when (org-at-table-p) (org-table-align))) + ((member "file" result-params) + (insert result)) + (t (goto-char beg) (insert result))) + (when (listp result) (goto-char (org-table-end))) + (setq end (point-marker)) + ;; possibly wrap result + (flet ((wrap (start finish) + (goto-char beg) (insert start) + (goto-char end) (insert finish) + (setq end (point-marker)))) + (cond + ((member "html" result-params) + (wrap "#+BEGIN_HTML\n" "#+END_HTML")) + ((member "latex" result-params) + (wrap "#+BEGIN_LaTeX\n" "#+END_LaTeX")) + ((member "code" result-params) + (wrap (format "#+BEGIN_SRC %s%s\n" (or lang "none") results-switches) + "#+END_SRC")) + ((member "org" result-params) + (wrap "#+BEGIN_ORG\n" "#+END_ORG")) + ((member "raw" result-params) + (goto-char beg) (if (org-at-table-p) (org-cycle))) + ((member "wrap" result-params) + (when (and (stringp result) (not (member "file" result-params))) + (org-babel-examplize-region beg end results-switches)) + (wrap "#+BEGIN_RESULT\n" "#+END_RESULT")) + ((and (stringp result) (not (member "file" result-params))) + (org-babel-examplize-region beg end results-switches) + (setq end (point))))) + ;; possibly indent the results to match the #+results line + (when (and indent (> indent 0) + ;; in this case `table-align' does the work for us + (not (and (listp result) + (member "append" result-params)))) + (indent-rigidly beg end indent)))) + (if (= (length result) 0) + (if (member "value" result-params) + (message "Code block returned no value.") + (message "Code block produced no output.")) + (message "Code block evaluation complete.")))) + +(defun org-babel-remove-result (&optional info) + "Remove the result of the current source block." + (interactive) + (let ((location (org-babel-where-is-src-block-result nil info)) start) + (when location + (save-excursion + (goto-char location) (setq start (point)) (forward-line 1) + (delete-region start (org-babel-result-end)))))) + +(defun org-babel-result-end () + "Return the point at the end of the current set of results" + (save-excursion + (cond + ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) + ((org-in-item-p) (- (org-list-bottom-point) 1)) + (t + (let ((case-fold-search t) + (blocks-re (regexp-opt + (list "latex" "html" "example" "src" "result")))) + (if (looking-at (concat "[ \t]*#\\+begin_" blocks-re)) + (re-search-forward (concat "[ \t]*#\\+end_" blocks-re) nil t) + (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") + (forward-line 1)))) + (point))))) + +(defun org-babel-result-to-file (result) + "Convert RESULT into an `org-mode' link. +If the `default-directory' is different from the containing +file's directory then expand relative links." + (format + "[[file:%s]]" + (if (and default-directory + buffer-file-name + (not (string= (expand-file-name default-directory) + (expand-file-name + (file-name-directory buffer-file-name))))) + (expand-file-name result default-directory) + result))) + +(defun org-babel-examplize-region (beg end &optional results-switches) + "Comment out region using the ': ' org example quote." + (interactive "*r") + (let ((size (count-lines beg end))) + (save-excursion + (cond ((= size 0)) ; do nothing for an empty result + ((< size org-babel-min-lines-for-block-output) + (goto-char beg) + (dotimes (n size) + (beginning-of-line 1) (insert ": ") (forward-line 1))) + (t + (goto-char beg) + (insert (if results-switches + (format "#+begin_example%s\n" results-switches) + "#+begin_example\n")) + (if (markerp end) (goto-char end) (forward-char (- end beg))) + (insert "#+end_example\n")))))) + +(defun org-babel-update-block-body (new-body) + "Update the body of the current code block to NEW-BODY." + (if (not (org-babel-where-is-src-block-head)) + (error "not in source block") + (save-match-data + (replace-match (concat (org-babel-trim new-body) "\n") nil nil nil 5)) + (indent-rigidly (match-beginning 5) (match-end 5) 2))) + +(defun org-babel-merge-params (&rest plists) + "Combine all parameter association lists in PLISTS. +Later elements of PLISTS override the values of previous element. +This takes into account some special considerations for certain +parameters when merging lists." + (let ((results-exclusive-groups + '(("file" "list" "vector" "table" "scalar" "raw" "org" + "html" "latex" "code" "pp" "wrap") + ("replace" "silent" "append" "prepend") + ("output" "value"))) + (exports-exclusive-groups + '(("code" "results" "both" "none"))) + params results exports tangle noweb cache vars shebang comments) + (flet ((e-merge (exclusive-groups &rest result-params) + ;; maintain exclusivity of mutually exclusive parameters + (let (output) + (mapc (lambda (new-params) + (mapc (lambda (new-param) + (mapc (lambda (exclusive-group) + (when (member new-param exclusive-group) + (mapcar (lambda (excluded-param) + (setq output + (delete + excluded-param + output))) + exclusive-group))) + exclusive-groups) + (setq output (org-uniquify + (cons new-param output)))) + new-params)) + result-params) + output))) + (mapc + (lambda (plist) + (mapc + (lambda (pair) + (case (car pair) + (:var + (let ((name (if (listp (cdr pair)) + (cadr pair) + (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" + (cdr pair)) + (intern (match-string 1 (cdr pair))))))) + (when name + (setq vars + (cons (cons name pair) + (if (member name (mapcar #'car vars)) + (delq nil + (mapcar + (lambda (p) (unless (equal (car p) name) p)) + vars)) + vars)))))) + (:results + (setq results (e-merge results-exclusive-groups + results (split-string (cdr pair))))) + (:file + (when (cdr pair) + (setq results (e-merge results-exclusive-groups + results '("file"))) + (unless (or (member "both" exports) + (member "none" exports) + (member "code" exports)) + (setq exports (e-merge exports-exclusive-groups + exports '("results")))) + (setq params (cons pair (assq-delete-all (car pair) params))))) + (:exports + (setq exports (e-merge exports-exclusive-groups + exports (split-string (cdr pair))))) + (:tangle ;; take the latest -- always overwrite + (setq tangle (or (list (cdr pair)) tangle))) + (:noweb + (setq noweb (e-merge '(("yes" "no" "tangle")) noweb + (split-string (or (cdr pair) ""))))) + (:cache + (setq cache (e-merge '(("yes" "no")) cache + (split-string (or (cdr pair) ""))))) + (:shebang ;; take the latest -- always overwrite + (setq shebang (or (list (cdr pair)) shebang))) + (:comments + (setq comments (e-merge '(("yes" "no")) comments + (split-string (or (cdr pair) ""))))) + (t ;; replace: this covers e.g. :session + (setq params (cons pair (assq-delete-all (car pair) params)))))) + plist)) + plists)) + (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) + (cons (cons :comments (mapconcat 'identity comments " ")) + (cons (cons :shebang (mapconcat 'identity shebang " ")) + (cons (cons :cache (mapconcat 'identity cache " ")) + (cons (cons :noweb (mapconcat 'identity noweb " ")) + (cons (cons :tangle (mapconcat 'identity tangle " ")) + (cons (cons :exports + (mapconcat 'identity exports " ")) + (cons + (cons :results + (mapconcat 'identity results " ")) + params))))))))) + +(defun org-babel-expand-noweb-references (&optional info parent-buffer) + "Expand Noweb references in the body of the current source code block. + +For example the following reference would be replaced with the +body of the source-code block named 'example-block'. + +<<example-block>> + +Note that any text preceding the <<foo>> construct on a line will +be interposed between the lines of the replacement text. So for +example if <<foo>> is placed behind a comment, then the entire +replacement text will also be commented. + +This function must be called from inside of the buffer containing +the source-code block which holds BODY. + +In addition the following syntax can be used to insert the +results of evaluating the source-code block named 'example-block'. + +<<example-block()>> + +Any optional arguments can be passed to example-block by placing +the arguments inside the parenthesis following the convention +defined by `org-babel-lob'. For example + +<<example-block(a=9)>> + +would set the value of argument \"a\" equal to \"9\". Note that +these arguments are not evaluated in the current source-code +block but are passed literally to the \"example-block\"." + (let* ((parent-buffer (or parent-buffer (current-buffer))) + (info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (body (nth 1 info)) + (new-body "") index source-name evaluate prefix) + (flet ((nb-add (text) + (setq new-body (concat new-body text)))) + (with-temp-buffer + (insert body) (goto-char (point-min)) + (setq index (point)) + (while (and (re-search-forward "<<\\(.+?\\)>>" nil t)) + (save-match-data (setf source-name (match-string 1))) + (save-match-data (setq evaluate (string-match "\(.*\)" source-name))) + (save-match-data + (setq prefix + (buffer-substring (match-beginning 0) + (save-excursion + (beginning-of-line 1) (point))))) + ;; add interval to new-body (removing noweb reference) + (goto-char (match-beginning 0)) + (nb-add (buffer-substring index (point))) + (goto-char (match-end 0)) + (setq index (point)) + (nb-add (with-current-buffer parent-buffer + (mapconcat ;; interpose PREFIX between every line + #'identity + (split-string + (if evaluate + (let ((raw (org-babel-ref-resolve source-name))) + (if (stringp raw) raw (format "%S" raw))) + (save-restriction + (widen) + (let ((point (org-babel-find-named-block + source-name))) + (if point + (save-excursion + (goto-char point) + (org-babel-trim + (org-babel-expand-noweb-references + (org-babel-get-src-block-info)))) + ;; optionally raise an error if named + ;; source-block doesn't exist + (if (member lang org-babel-noweb-error-langs) + (error "%s" + (concat + "<<" source-name ">> " + "could not be resolved (see " + "`org-babel-noweb-error-langs')")) + ""))))) + "[\n\r]") (concat "\n" prefix))))) + (nb-add (buffer-substring index (point-max))))) + new-body)) + +(defun org-babel-clean-text-properties (text) + "Strip all properties from text return." + (when text + (set-text-properties 0 (length text) nil text) text)) + +(defun org-babel-strip-protective-commas (body) + "Strip protective commas from bodies of source blocks." + (replace-regexp-in-string "^,#" "#" body)) + +(defun org-babel-script-escape (str) + "Safely convert tables into elisp lists." + (let (in-single in-double out) + (org-babel-read + (if (and (stringp str) (string-match "^\\[.+\\]$" str)) + (org-babel-read + (concat + "'" + (progn + (mapc + (lambda (ch) + (setq + out + (case ch + (91 (if (or in-double in-single) ; [ + (cons 91 out) + (cons 40 out))) + (93 (if (or in-double in-single) ; ] + (cons 93 out) + (cons 41 out))) + (44 (if (or in-double in-single) (cons 44 out) out)) ; , + (39 (if in-double ; ' + (cons 39 out) + (setq in-single (not in-single)) (cons 34 out))) + (34 (if in-single ; " + (append (list 34 32) out) + (setq in-double (not in-double)) (cons 34 out))) + (t (cons ch out))))) + (string-to-list str)) + (apply #'string (reverse out))))) + str)))) + +(defun org-babel-read (cell) + "Convert the string value of CELL to a number if appropriate. +Otherwise if cell looks like lisp (meaning it starts with a +\"(\" or a \"'\") then read it as lisp, otherwise return it +unmodified as a string. + +This is taken almost directly from `org-read-prop'." + (if (and (stringp cell) (not (equal cell ""))) + (or (org-babel-number-p cell) + (if (or (equal "(" (substring cell 0 1)) + (equal "'" (substring cell 0 1)) + (equal "`" (substring cell 0 1))) + (eval (read cell)) + (progn (set-text-properties 0 (length cell) nil cell) cell))) + cell)) + +(defun org-babel-number-p (string) + "If STRING represents a number return it's value." + (if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string) + (= (length (substring string (match-beginning 0) + (match-end 0))) + (length string))) + (string-to-number string))) + +(defun org-babel-import-elisp-from-file (file-name &optional separator) + "Read the results located at FILE-NAME into an elisp table. +If the table is trivial, then return it as a scalar." + (let (result) + (save-window-excursion + (with-temp-buffer + (condition-case nil + (progn + (org-table-import file-name separator) + (delete-file file-name) + (setq result (mapcar (lambda (row) + (mapcar #'org-babel-string-read row)) + (org-table-to-lisp)))) + (error nil))) + (if (null (cdr result)) ;; if result is trivial vector, then scalarize it + (if (consp (car result)) + (if (null (cdr (car result))) + (caar result) + result) + (car result)) + result)))) + +(defun org-babel-string-read (cell) + "Strip nested \"s from around strings." + (org-babel-read (or (and (stringp cell) + (string-match "\\\"\\(.+\\)\\\"" cell) + (match-string 1 cell)) + cell))) + +(defun org-babel-reverse-string (string) + "Return the reverse of STRING." + (apply 'string (reverse (string-to-list string)))) + +(defun org-babel-chomp (string &optional regexp) + "Strip trailing spaces and carriage returns from STRING. +Default regexp used is \"[ \f\t\n\r\v]\" but can be +overwritten by specifying a regexp as a second argument." + (let ((regexp (or regexp "[ \f\t\n\r\v]"))) + (while (and (> (length string) 0) + (string-match regexp (substring string -1))) + (setq string (substring string 0 -1))) + string)) + +(defun org-babel-trim (string &optional regexp) + "Strip leading and trailing spaces and carriage returns from STRING. +Like `org-babel-chomp' only it runs on both the front and back +of the string." + (org-babel-chomp (org-babel-reverse-string + (org-babel-chomp (org-babel-reverse-string string) regexp)) + regexp)) + +(defvar org-babel-org-babel-call-process-region-original nil) +(defun org-babel-tramp-handle-call-process-region + (start end program &optional delete buffer display &rest args) + "Use tramp to handle call-process-region. +Fixes a bug in `tramp-handle-call-process-region'." + (if (and (featurep 'tramp) (file-remote-p default-directory)) + (let ((tmpfile (tramp-compat-make-temp-file ""))) + (write-region start end tmpfile) + (when delete (delete-region start end)) + (unwind-protect + ;; (apply 'call-process program tmpfile buffer display args) + ;; bug in tramp + (apply 'process-file program tmpfile buffer display args) + (delete-file tmpfile))) + ;; org-babel-call-process-region-original is the original emacs + ;; definition. It is in scope from the let binding in + ;; org-babel-execute-src-block + (apply org-babel-call-process-region-original + start end program delete buffer display args))) + +(defun org-babel-local-file-name (file) + "Return the local name component of FILE." + (if (file-remote-p file) + (let (localname) + (with-parsed-tramp-file-name file nil + localname)) + file)) + +(defun org-babel-process-file-name (name &optional no-quote-p) + "Prepare NAME to be used in an external process. +If NAME specifies a remote location, the remote portion of the +name is removed, since in that case the process will be executing +remotely. The file name is then processed by +`expand-file-name'. Unless second argument NO-QUOTE-P is non-nil, +the file name is additionally processed by +`shell-quote-argument'" + ((lambda (f) (if no-quote-p f (shell-quote-argument f))) + (expand-file-name (org-babel-local-file-name name)))) + +(defvar org-babel-temporary-directory) +(unless (or noninteractive (boundp 'org-babel-temporary-directory)) + (defvar org-babel-temporary-directory + (or (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory) + org-babel-temporary-directory) + (make-temp-file "babel-" t)) + "Directory to hold temporary files created to execute code blocks. +Used by `org-babel-temp-file'. This directory will be removed on +Emacs shutdown.")) + +(defun org-babel-temp-file (prefix &optional suffix) + "Create a temporary file in the `org-babel-temporary-directory'. +Passes PREFIX and SUFFIX directly to `make-temp-file' with the +value of `temporary-file-directory' temporarily set to the value +of `org-babel-temporary-directory'." + (if (file-remote-p default-directory) + (make-temp-file + (concat (file-remote-p default-directory) + (expand-file-name + prefix temporary-file-directory) + nil suffix)) + (let ((temporary-file-directory + (or (and (file-exists-p org-babel-temporary-directory) + org-babel-temporary-directory) + temporary-file-directory))) + (make-temp-file prefix nil suffix)))) + +(defun org-babel-remove-temporary-directory () + "Remove `org-babel-temporary-directory' on Emacs shutdown." + (when (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory)) + ;; taken from `delete-directory' in files.el + (condition-case nil + (progn + (mapc (lambda (file) + ;; This test is equivalent to + ;; (and (file-directory-p fn) (not (file-symlink-p fn))) + ;; but more efficient + (if (eq t (car (file-attributes file))) + (delete-directory file) + (delete-file file))) + ;; We do not want to delete "." and "..". + (directory-files org-babel-temporary-directory 'full + "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + (delete-directory org-babel-temporary-directory)) + (error + (message "Failed to remove temporary Org-babel directory %s" + org-babel-temporary-directory))))) + +(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) + +(provide 'ob) + +;; arch-tag: 01a7ebee-06c5-4ee4-a709-e660d28c0af1 + +;;; ob.el ends here diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 31cfa8ca173..bb9f4be0964 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -32,8 +32,7 @@ (require 'org) (eval-when-compile - (require 'cl) - (require 'calendar)) + (require 'cl)) (declare-function diary-add-to-list "diary-lib" (date string specifier &optional marker globcolor literal)) @@ -63,6 +62,7 @@ (declare-function org-habit-parse-todo "org-habit" (&optional pom)) (declare-function org-habit-get-priority "org-habit" (habit &optional moment)) (defvar calendar-mode-map) +(defvar org-clock-current-task) ; defined in org-clock.el (defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el (defvar org-habit-show-habits) (defvar org-habit-show-habits-only-for-today) @@ -88,7 +88,7 @@ only needed when the text to be killed contains more than N non-white lines." (integer :tag "When more than N lines"))) (defcustom org-agenda-compact-blocks nil - "Non-nil means, make the block agenda more compact. + "Non-nil means make the block agenda more compact. This is done by leaving out unnecessary lines." :group 'org-agenda :type 'boolean) @@ -108,7 +108,7 @@ If it is a character, it will be repeated to fill the window width." :group 'org-agenda) (defcustom org-agenda-with-colors t - "Non-nil means, use colors in agenda views." + "Non-nil means use colors in agenda views." :group 'org-agenda-export :type 'boolean) @@ -143,13 +143,13 @@ specifies the maximum number of lines that will be added for each entry that is listed in the agenda view. Note that this variable is not used during display, only when exporting -the agenda. For agenda display, see org-agenda-entry-text-mode and the -variable `org-agenda-entry-text-maxlines'." +the agenda. For agenda display, see the variables `org-agenda-entry-text-mode' +and `org-agenda-entry-text-maxlines'." :group 'org-agenda :type 'integer) (defcustom org-agenda-add-entry-text-descriptive-links t - "Non-nil means, export org-links as descriptive links in agenda added text. + "Non-nil means export org-links as descriptive links in agenda added text. This variable applies to the text added to the agenda when `org-agenda-add-entry-text-maxlines' is larger than 0. When this variable nil, the URL will (also) be shown." @@ -198,6 +198,11 @@ you can \"misuse\" it to also add other text to the header. However, :group 'org-export-html :type 'string) +(defcustom org-agenda-persistent-filter nil + "When set, keep filters from one agenda view to the next." + :group 'org-agenda + :type 'boolean) + (defgroup org-agenda-custom-commands nil "Options concerning agenda views in Org-mode." :tag "Org Agenda Custom Commands" @@ -212,6 +217,7 @@ you can \"misuse\" it to also add other text to the header. However, (const todo-state-up) (const todo-state-down) (const effort-up) (const effort-down) (const habit-up) (const habit-down) + (const alpha-up) (const alpha-down) (const user-defined-up) (const user-defined-down)) "Sorting choices.") @@ -236,8 +242,12 @@ you can \"misuse\" it to also add other text to the header. However, (const org-agenda-prefix-format :value " %-12:c%?-12t% s") (string)) (list :tag "Number of days in agenda" - (const org-agenda-ndays) - (integer :value 1)) + (const org-agenda-span) + (choice (const :tag "Day" 'day) + (const :tag "Week" 'week) + (const :tag "Month" 'month) + (const :tag "Year" 'year) + (integer :tag "Custom"))) (list :tag "Fixed starting date" (const org-agenda-start-day) (string :value "2007-11-01")) @@ -258,6 +268,13 @@ you can \"misuse\" it to also add other text to the header. However, (const :format "" quote) (repeat (string :tag "+tag or -tag")))) + (list :tag "Set daily/weekly entry types" + (const org-agenda-entry-types) + (set :greedy t :value (:deadline :scheduled :timestamp :sexp) + (const :deadline) + (const :scheduled) + (const :timestamp) + (const :sexp))) (list :tag "Standard skipping condition" :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) (const org-agenda-skip-function) @@ -273,6 +290,24 @@ you can \"misuse\" it to also add other text to the header. However, :tag "Condition type" (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp)) (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp)) + (list :tag "TODO state is" :inline t + (const 'todo) + (choice + (const :tag "any not-done state" 'todo) + (const :tag "any done state" 'done) + (const :tag "any state" 'any) + (list :tag "Keyword list" + (const :format "" quote) + (repeat (string :tag "Keyword"))))) + (list :tag "TODO state is not" :inline t + (const 'nottodo) + (choice + (const :tag "any not-done state" 'todo) + (const :tag "any done state" 'done) + (const :tag "any state" 'any) + (list :tag "Keyword list" + (const :format "" quote) + (repeat (string :tag "Keyword"))))) (const :tag "scheduled" 'scheduled) (const :tag "not scheduled" 'notscheduled) (const :tag "deadline" 'deadline) @@ -499,20 +534,20 @@ this one will be used." :group 'org-agenda) (defvar org-agenda-archives-mode nil - "Non-nil means, the agenda will include archived items. + "Non-nil means the agenda will include archived items. If this is the symbol `trees', trees in the selected agenda scope that are marked with the ARCHIVE tag will be included anyway. When this is t, also all archive files associated with the current selection of agenda files will be included.") (defcustom org-agenda-skip-comment-trees t - "Non-nil means, skip trees that start with the COMMENT keyword. + "Non-nil means skip trees that start with the COMMENT keyword. When nil, these trees are also scanned by agenda commands." :group 'org-agenda-skip :type 'boolean) (defcustom org-agenda-todo-list-sublevels t - "Non-nil means, check also the sublevels of a TODO entry for TODO entries. + "Non-nil means check also the sublevels of a TODO entry for TODO entries. When nil, the sublevels of a TODO entry are not checked, resulting in potentially much shorter TODO lists." :group 'org-agenda-skip @@ -520,7 +555,7 @@ potentially much shorter TODO lists." :type 'boolean) (defcustom org-agenda-todo-ignore-with-date nil - "Non-nil means, don't show entries with a date in the global todo list. + "Non-nil means don't show entries with a date in the global todo list. You can use this if you prefer to mark mere appointments with a TODO keyword, but don't want them to show up in the TODO list. When this is set, it also covers deadlines and scheduled items, the settings @@ -531,31 +566,105 @@ See also the variable `org-agenda-tags-todo-honor-ignore-options'." :group 'org-agenda-todo-list :type 'boolean) +(defcustom org-agenda-todo-ignore-timestamp nil + "Non-nil means don't show entries with a timestamp. +This applies when creating the global todo list. +Valid values are: + +past Don't show entries for today or in the past. + +future Don't show entries with a timestamp in the future. + The idea behind this is that if it has a future + timestamp, you don't want to think about it until the + date. + +all Don't show any entries with a timestamp in the global todo list. + The idea behind this is that by setting a timestamp, you + have already \"taken care\" of this item. + +See also `org-agenda-todo-ignore-with-date'. +See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want +to make his option also apply to the tags-todo list." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :type '(choice + (const :tag "Ignore future timestamp todos" future) + (const :tag "Ignore past or present timestamp todos" past) + (const :tag "Ignore all timestamp todos" all) + (const :tag "Show timestamp todos" nil))) + (defcustom org-agenda-todo-ignore-scheduled nil - "Non-nil means, don't show scheduled entries in the global todo list. -The idea behind this is that by scheduling it, you have already taken care -of this item. + "Non-nil means, ignore some scheduled TODO items when making TODO list. +This applies when creating the global todo list. +Valid values are: + +past Don't show entries scheduled today or in the past. + +future Don't show entries scheduled in the future. + The idea behind this is that by scheduling it, you don't want to + think about it until the scheduled date. + +all Don't show any scheduled entries in the global todo list. + The idea behind this is that by scheduling it, you have already + \"taken care\" of this item. + +t Same as `all', for backward compatibility. + See also `org-agenda-todo-ignore-with-date'. -See also the variable `org-agenda-tags-todo-honor-ignore-options'." +See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want +to make his option also apply to the tags-todo list." :group 'org-agenda-skip :group 'org-agenda-todo-list - :type 'boolean) + :type '(choice + (const :tag "Ignore future-scheduled todos" future) + (const :tag "Ignore past- or present-scheduled todos" past) + (const :tag "Ignore all scheduled todos" all) + (const :tag "Ignore all scheduled todos (compatibility)" t) + (const :tag "Show scheduled todos" nil))) (defcustom org-agenda-todo-ignore-deadlines nil - "Non-nil means, don't show near deadline entries in the global todo list. -Near means closer than `org-deadline-warning-days' days. -The idea behind this is that such items will appear in the agenda anyway. + "Non-nil means ignore some deadlined TODO items when making TODO list. +There are different motivations for using different values, please think +carefully when configuring this variable. + +This applies when creating the global todo list. +Valid values are: + +near Don't show near deadline entries. A deadline is near when it is + closer than `org-deadline-warning-days' days. The idea behind this + is that such items will appear in the agenda anyway. + +far Don't show TODO entries where a deadline has been defined, but + the deadline is not near. This is useful if you don't want to + use the todo list to figure out what to do now. + +past Don't show entries with a deadline timestamp for today or in the past. + +future Don't show entries with a deadline timestamp in the future, not even + when they become `near' ones. Use it with caution. + +all Ignore all TODO entries that do have a deadline. + +t Same as `near', for backward compatibility. + See also `org-agenda-todo-ignore-with-date'. -See also the variable `org-agenda-tags-todo-honor-ignore-options'." +See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want +to make his option also apply to the tags-todo list." :group 'org-agenda-skip :group 'org-agenda-todo-list - :type 'boolean) + :type '(choice + (const :tag "Ignore near deadlines" near) + (const :tag "Ignore near deadlines (compatibility)" t) + (const :tag "Ignore far deadlines" far) + (const :tag "Ignore all TODOs with a deadlines" all) + (const :tag "Show all TODOs, even if they have a deadline" nil))) (defcustom org-agenda-tags-todo-honor-ignore-options nil - "Non-nil means, honor todo-list ...ignore options also in tags-todo search. + "Non-nil means honor todo-list ...ignore options also in tags-todo search. The variables `org-agenda-todo-ignore-with-date', - `org-agenda-todo-ignore-scheduled' + `org-agenda-todo-ignore-timestamp', + `org-agenda-todo-ignore-scheduled', `org-agenda-todo-ignore-deadlines' make the global TODO list skip entries that have time stamps of certain kinds. If this option is set, the same options will also apply for the @@ -603,6 +712,24 @@ deadlines are always turned off when the item is DONE." :group 'org-agenda-daily/weekly :type 'boolean) +(defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil + "Non-nil means skip deadline prewarning when entry is also scheduled. +This will apply on all days where a prewarning for the deadline would +be shown, but not at the day when the entry is actually due. On that day, +the deadline will be shown anyway. +This variable may be set to nil, t, or a number which will then give +the number of days before the actual deadline when the prewarnings +should resume. +This can be used in a workflow where the first showing of the deadline will +trigger you to schedule it, and then you don't want to be reminded of it +because you will take care of it on the day when scheduled." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :type '(choice + (const :tag "Alwas show prewarning" nil) + (const :tag "Remove prewarning if entry is scheduled" t) + (integer :tag "Restart prewarning N days before deadline"))) + (defcustom org-agenda-skip-additional-timestamps-same-entry t "When nil, multiple same-day timestamps in entry make multiple agenda lines. When non-nil, after the search for timestamps has matched once in an @@ -617,7 +744,7 @@ entry, the rest of the entry will not be searched." :type 'boolean) (defcustom org-agenda-dim-blocked-tasks t - "Non-nil means, dim blocked tasks in the agenda display. + "Non-nil means dim blocked tasks in the agenda display. This causes some overhead during agenda construction, but if you have turned on `org-enforce-todo-dependencies', `org-enforce-todo-checkbox-dependencies', or any other blocking @@ -639,7 +766,7 @@ will only be dimmed." (const :tag "Make invisible" invisible))) (defcustom org-timeline-show-empty-dates 3 - "Non-nil means, `org-timeline' also shows dates without an entry. + "Non-nil means `org-timeline' also shows dates without an entry. When nil, only the days which actually have entries are shown. When t, all days between the first and the last date are shown. When an integer, show also empty dates, but if there is a gap of more than @@ -655,25 +782,41 @@ N days, just insert a special line indicating the size of the gap." :tag "Org Agenda Startup" :group 'org-agenda) +(defcustom org-agenda-menu-show-matcher t + "Non-nil menas show the match string in the agenda dispatcher menu. +When nil, the matcher string is not shown, but is put into the help-echo +property so than moving the mouse over the command shows it. +Setting it to nil is good if matcher strings are very long and/or if +you wnat to use two-column display (see `org-agenda-menu-two-column')." + :group 'org-agenda + :type 'boolean) + +(defcustom org-agenda-menu-two-column nil + "Non-nil means, use two columns to show custom commands in the dispatcher. +If you use this, you probably want to set `org-agenda-menu-show-matcher' +to nil." + :group 'org-agenda + :type 'boolean) + (defcustom org-finalize-agenda-hook nil "Hook run just before displaying an agenda buffer." :group 'org-agenda-startup :type 'hook) (defcustom org-agenda-mouse-1-follows-link nil - "Non-nil means, mouse-1 on a link will follow the link in the agenda. + "Non-nil means mouse-1 on a link will follow the link in the agenda. A longer mouse click will still set point. Does not work on XEmacs. Needs to be set before org.el is loaded." :group 'org-agenda-startup :type 'boolean) (defcustom org-agenda-start-with-follow-mode nil - "The initial value of follow-mode in a newly created agenda window." + "The initial value of follow mode in a newly created agenda window." :group 'org-agenda-startup :type 'boolean) (defcustom org-agenda-show-outline-path t - "Non-il means, show outline path in echo area after line motion." + "Non-nil means show outline path in echo area after line motion." :group 'org-agenda-startup :type 'boolean) @@ -707,7 +850,7 @@ have been removed when this is called, as will any matches for regular expressions listed in `org-agenda-entry-text-exclude-regexps'.") (defvar org-agenda-include-inactive-timestamps nil - "Non-nil means, include inactive time stamps in agenda and timeline.") + "Non-nil means include inactive time stamps in agenda and timeline.") (defgroup org-agenda-windows nil "Options concerning the windows used by the Agenda in Org Mode." @@ -740,7 +883,7 @@ It only matters if `org-agenda-window-setup' is `reorganize-frame'." :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) (defcustom org-agenda-restore-windows-after-quit nil - "Non-nil means, restore window configuration open exiting agenda. + "Non-nil means restore window configuration open exiting agenda. Before the window configuration is changed for displaying the agenda, the current status is recorded. When the agenda is exited with `q' or `x' and this option is set, the old state is restored. If @@ -749,15 +892,28 @@ option will be ignored." :group 'org-agenda-windows :type 'boolean) -(defcustom org-agenda-ndays 7 - "Number of days to include in overview display. +(defcustom org-agenda-ndays nil + "Number of days to include in overview display. Should be 1 or 7. +Obsolete, see `org-agenda-span'." + :group 'org-agenda-daily/weekly + :type 'integer) + +(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1") + +(defcustom org-agenda-span 'week + "Number of days to include in overview display. +Can be day, week, month, year, or any number of days. Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly - :type 'integer) + :type '(choice (const :tag "Day" day) + (const :tag "Week" week) + (const :tag "Month" month) + (const :tag "Year" year) + (integer :tag "Custom"))) (defcustom org-agenda-start-on-weekday 1 - "Non-nil means, start the overview always on the specified weekday. + "Non-nil means start the overview always on the specified weekday. 0 denotes Sunday, 1 denotes Monday etc. When nil, always start on the current day. Custom commands can set this variable in the options section." @@ -766,7 +922,7 @@ Custom commands can set this variable in the options section." (integer :tag "Weekday No."))) (defcustom org-agenda-show-all-dates t - "Non-nil means, `org-agenda' shows every day in the selected range. + "Non-nil means `org-agenda' shows every day in the selected range. When nil, only the days which actually have entries are shown." :group 'org-agenda-daily/weekly :type 'boolean) @@ -805,6 +961,41 @@ This function makes sure that dates are aligned for easy reading." (format "%-10s %2d %s %4d%s" dayname day monthname year weekstring))) +(defcustom org-agenda-time-leading-zero nil + "Non-nil means use leading zero for military times in agenda. +For example, 9:30am would become 09:30 rather than 9:30." + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-timegrid-use-ampm nil + "When set, show AM/PM style timestamps on the timegrid." + :group 'org-agenda + :type 'boolean) + +(defun org-agenda-time-of-day-to-ampm (time) + "Convert TIME of a string like '13:45' to an AM/PM style time string." + (let* ((hour-number (string-to-number (substring time 0 -3))) + (minute (substring time -2)) + (ampm "am")) + (cond + ((equal hour-number 12) + (setq ampm "pm")) + ((> hour-number 12) + (setq ampm "pm") + (setq hour-number (- hour-number 12)))) + (concat + (if org-agenda-time-leading-zero + (format "%02d" hour-number) + (format "%02s" (number-to-string hour-number))) + ":" minute ampm))) + +(defun org-agenda-time-of-day-to-ampm-maybe (time) + "Conditionally convert TIME to AM/PM format +based on `org-agenda-timegrid-use-ampm'" + (if org-agenda-timegrid-use-ampm + (org-agenda-time-of-day-to-ampm time) + time)) + (defcustom org-agenda-weekend-days '(6 0) "Which days are weekend? These days get the special face `org-agenda-date-weekend' in the agenda @@ -825,6 +1016,12 @@ Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly :type 'boolean) +(defcustom org-agenda-include-deadlines t + "If non-nil, include entries within their deadline warning period. +Custom commands can set this variable in the options section." + :group 'org-agenda-daily/weekly + :type 'boolean) + (defcustom org-agenda-include-all-todo nil "Set means weekly/daily agenda will always contain all TODO entries. The TODO entries will be listed at the top of the agenda, before @@ -834,7 +1031,7 @@ This option is deprecated, it is better to define a block agenda instead." :type 'boolean) (defcustom org-agenda-repeating-timestamp-show-all t - "Non-nil means, show all occurrences of a repeating stamp in the agenda. + "Non-nil means show all occurrences of a repeating stamp in the agenda. When nil, only one occurrence is shown, either today or the nearest into the future." :group 'org-agenda-daily/weekly @@ -861,7 +1058,7 @@ the agenda to display all available LOG items temporarily." :type '(set :greedy t (const closed) (const clock) (const state))) (defcustom org-agenda-log-mode-add-notes t - "Non-nil means, add first line of notes to log entries in agenda views. + "Non-nil means add first line of notes to log entries in agenda views. If a log item like a state change or a clock entry is associated with notes, the first line of these notes will be added to the entry in the agenda display." @@ -891,14 +1088,40 @@ current display in the agenda." :group 'org-agenda-daily/weekly :type 'plist) -(defcustom org-agenda-search-view-search-words-only nil - "Non-nil means, the search string is interpreted as individual words -The search then looks for each word separately in each entry and -selects entries that have matches for all words. -When nil, matching as loose words will only take place if the first -word is preceded by + or -. If that is not the case, the search -string will just be matched as a substring in the entry, but with -each space character allowing for any whitespace, including newlines." +(defcustom org-agenda-search-view-always-boolean nil + "Non-nil means the search string is interpreted as individual parts. + +The search string for search view can either be interpreted as a phrase, +or as a list of snippets that define a boolean search for a number of +strings. + +When this is non-nil, the string will be split on whitespace, and each +snippet will be searched individually, and all must match in order to +select an entry. A snippet is then a single string of non-white +characters, or a string in double quotes, or a regexp in {} braces. +If a snippet is preceded by \"-\", the snippet must *not* match. +\"+\" is syntactic sugar for positive selection. Each snippet may +be found as a full word or a partial word, but see the variable +`org-agenda-search-view-force-full-words'. + +When this is nil, search will look for the entire search phrase as one, +with each space character matching any amount of whitespace, including +line breaks. + +Even when this is nil, you can still switch to Boolean search dynamically +by preceding the first snippet with \"+\" or \"-\". If the first snippet +is a regexp marked with braces like \"{abc}\", this will also switch to +boolean search." + :group 'org-agenda-search-view + :type 'boolean) + +(if (fboundp 'defvaralias) + (defvaralias 'org-agenda-search-view-search-words-only + 'org-agenda-search-view-always-boolean)) + +(defcustom org-agenda-search-view-force-full-words nil + "Non-nil means, search words must be matches as complete words. +When nil, they may also match part of a word." :group 'org-agenda-search-view :type 'boolean) @@ -908,7 +1131,7 @@ each space character allowing for any whitespace, including newlines." :group 'org-agenda) (defcustom org-agenda-search-headline-for-time t - "Non-nil means, search headline for a time-of-day. + "Non-nil means search headline for a time-of-day. If the headline contains a time-of-day in one format or another, it will be used to sort the entry into the time sequence of items for a day. Some people have time stamps in the headline that refer to the creation @@ -919,7 +1142,7 @@ for a time." :type 'boolean) (defcustom org-agenda-use-time-grid t - "Non-nil means, show a time grid in the agenda schedule. + "Non-nil means show a time grid in the agenda schedule. A time grid is a set of lines for specific times (like every two hours between 8:00 and 20:00). The items scheduled for a day at specific times are sorted in between these lines. @@ -993,6 +1216,8 @@ user-defined-up Sort according to `org-agenda-cmp-user-defined', high last. user-defined-down Sort according to `org-agenda-cmp-user-defined', high first. habit-up Put entries that are habits first habit-down Put entries that are habits last +alpha-up Sort headlines alphabetically +alpha-down Sort headlines alphabetically, reversed The different possibilities will be tried in sequence, and testing stops if one comparison returns a \"not-equal\". For example, the default @@ -1036,7 +1261,7 @@ part of an agenda sorting strategy." :type 'symbol) (defcustom org-sort-agenda-notime-is-late t - "Non-nil means, items without time are considered late. + "Non-nil means items without time are considered late. This is only relevant for sorting. When t, items which have no explicit time like 15:30 will be considered as 99:01, i.e. later than any items which do have a time. When nil, the default time is before 0:00. You can use this @@ -1046,7 +1271,7 @@ agenda entries." :type 'boolean) (defcustom org-sort-agenda-noeffort-is-high t - "Non-nil means, items without effort estimate are sorted as high effort. + "Non-nil means items without effort estimate are sorted as high effort. This also applies when filtering an agenda view with respect to the < or > effort operator. Then, tasks with no effort defined will be treated as tasks with high effort. @@ -1060,11 +1285,11 @@ When nil, such items are sorted as 0 minutes effort." :group 'org-agenda) (defcustom org-agenda-prefix-format - '((agenda . " %-12:c%?-12t% s") + '((agenda . " %i %-12:c%?-12t% s") (timeline . " % s") - (todo . " %-12:c") - (tags . " %-12:c") - (search . " %-12:c")) + (todo . " %i %-12:c") + (tags . " %i %-12:c") + (search . " %i %-12:c")) "Format specifications for the prefix of items in the agenda views. An alist with four entries, for the different agenda types. The keys to the sublists are `agenda', `timeline', `todo', and `tags'. The values @@ -1073,6 +1298,8 @@ This format works similar to a printf format, with the following meaning: %c the category of the item, \"Diary\" for entries from the diary, or as given by the CATEGORY keyword or derived from the file name. + %i the icon category of the item, as give in + `org-agenda-category-icon-alist'. %T the *last* tag of the item. Last because inherited tags come first in the list. %t the time-of-day specification if one applies to the entry, in the @@ -1151,7 +1378,7 @@ range, respectively." (function)))) (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") - "Text preceeding scheduled items in the agenda view. + "Text preceding scheduled items in the agenda view. This is a list with two strings. The first applies when the item is scheduled on the current day. The second applies when it has been scheduled previously, it may contain a %d indicating that this is the nth time that @@ -1163,8 +1390,16 @@ that passed since this item was scheduled first." (string :tag "Scheduled today ") (string :tag "Scheduled previously"))) +(defcustom org-agenda-inactive-leader "[" + "Text preceding item pulled into the agenda by inactive time stamps. +These entries are added to the agenda when pressing \"[\"." + :group 'org-agenda-line-format + :type '(list + (string :tag "Scheduled today ") + (string :tag "Scheduled previously"))) + (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") - "Text preceeding deadline items in the agenda view. + "Text preceding deadline items in the agenda view. This is a list with two strings. The first applies when the item has its deadline on the current day. The second applies when it is in the past or in the future, it may contain %d to capture how many days away the deadline @@ -1177,7 +1412,7 @@ is (was)." (function)))) (defcustom org-agenda-remove-times-when-in-prefix t - "Non-nil means, remove duplicate time specifications in agenda items. + "Non-nil means remove duplicate time specifications in agenda items. When the format `org-agenda-prefix-format' contains a `%t' specifier, a time-of-day specification in a headline or diary entry is extracted and placed into the prefix. If this option is non-nil, the original specification @@ -1185,7 +1420,7 @@ placed into the prefix. If this option is non-nil, the original specification 11:30-4pm) will be removed for agenda display. This makes the agenda less cluttered. The option can be t or nil. It may also be the symbol `beg', indicating -that the time should only be removed what it is located at the beginning of +that the time should only be removed when it is located at the beginning of the headline/diary entry." :group 'org-agenda-line-format :type '(choice @@ -1193,6 +1428,11 @@ the headline/diary entry." (const :tag "Never" nil) (const :tag "When at beginning of entry" beg))) +(defcustom org-agenda-remove-timeranges-from-blocks nil + "Non-nil means remove time ranges specifications in agenda +items that span on several days." + :group 'org-agenda-line-format + :type 'boolean) (defcustom org-agenda-default-appointment-duration nil "Default duration for appointments that only have a starting time. @@ -1204,14 +1444,14 @@ When non-nil, this must be the number of minutes, e.g. 60 for one hour." (const :tag "No default duration"))) (defcustom org-agenda-show-inherited-tags t - "Non-nil means, show inherited tags in each agenda line." + "Non-nil means show inherited tags in each agenda line." :group 'org-agenda-line-format :type 'boolean) (defcustom org-agenda-hide-tags-regexp nil "Regular expression used to filter away specific tags in agenda views. This means that these tags will be present, but not be shown in the agenda -line. Secondayt filltering will still work on the hidden tags. +line. Secondary filtering will still work on the hidden tags. Nil means don't hide any tags." :group 'org-agenda-line-format :type '(choice @@ -1219,7 +1459,7 @@ Nil means don't hide any tags." (string :tag "Regexp "))) (defcustom org-agenda-remove-tags nil - "Non-nil means, remove the tags from the headline copy in the agenda. + "Non-nil means remove the tags from the headline copy in the agenda. When this is the symbol `prefix', only remove tags when `org-agenda-prefix-format' contains a `%T' specifier." :group 'org-agenda-line-format @@ -1244,16 +1484,18 @@ it means that the tags should be flushright to that column. For example, (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) (defcustom org-agenda-fontify-priorities 'cookies - "Non-nil means, highlight low and high priorities in agenda. + "Non-nil means highlight low and high priorities in agenda. When t, the highest priority entries are bold, lowest priority italic. -However, settings in org-priority-faces will overrule these faces. +However, settings in `org-priority-faces' will overrule these faces. When this variable is the symbol `cookies', only fontify the cookies, not the entire task. This may also be an association list of priority faces, whose keys are the character values of `org-highest-priority', `org-default-priority', and `org-lowest-priority' (the default values -are ?A, ?B, and ?C, respectively). The face may be a named face, -or a list like `(:background \"Red\")'." +are ?A, ?B, and ?C, respectively). The face may be a named face, a +color as a string, or a list like `(:background \"Red\")'. +If it is a color, the variable `org-faces-easy-properties' +determines if it is a foreground or a background color." :group 'org-agenda-line-format :type '(choice (const :tag "Never" nil) @@ -1261,7 +1503,55 @@ or a list like `(:background \"Red\")'." (const :tag "Cookies only" cookies) (repeat :tag "Specify" (list (character :tag "Priority" :value ?A) - (sexp :tag "face"))))) + (choice :tag "Face " + (string :tag "Color") + (sexp :tag "Face")))))) + +(defcustom org-agenda-day-face-function nil + "Function called to determine what face should be used to display a day. +The only argument passed to that function is the day. It should +returns a face, or nil if does not want to specify a face and let +the normal rules apply." + :group 'org-agenda-line-format + :type 'function) + +(defcustom org-agenda-category-icon-alist nil + "Alist of category icon to be displayed in agenda views. + +Each entry should have the following format: + + (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS) + +Where CATEGORY-REGEXP is a regexp matching the categories where +the icon should be displayed. +FILE-OR-DATA either a file path or a string containing image data. + +The other fields can be ommited safely if not needed: +TYPE indicates the image type. +DATA-P is a boolean indicating whether the FILE-OR-DATA string is +image data. +PROPS are additional image attributes to assign to the image, +like, e.g. `:ascent center'. + + (\"Org\" \"/path/to/icon.png\" nil nil :ascent center) + +If you want to set the display properties yourself, just put a +list as second element: + + (CATEGORY-REGEXP (MY PROPERTY LIST)) + +For example, to display a 16px horizontal space for Emacs +category, you can use: + + (\"Emacs\" '(space . (:width (16))))" + :group 'org-agenda-line-format + :type '(alist :key-type (string :tag "Regexp matching category") + :value-type (choice (list :tag "Icon" + (string :tag "File or data") + (symbol :tag "Type") + (boolean :tag "Data?") + (repeat :tag "Extra image properties" :inline t symbol)) + (list :tag "Display properties" sexp)))) (defgroup org-agenda-column-view nil "Options concerning column view in the agenda." @@ -1269,12 +1559,12 @@ or a list like `(:background \"Red\")'." :group 'org-agenda) (defcustom org-agenda-columns-show-summaries t - "Non-nil means, show summaries for columns displayed in the agenda view." + "Non-nil means show summaries for columns displayed in the agenda view." :group 'org-agenda-column-view :type 'boolean) (defcustom org-agenda-columns-remove-prefix-from-item t - "Non-nil means, remove the prefix from a headline for agenda column view. + "Non-nil means remove the prefix from a headline for agenda column view. The special ITEM field in the columns format contains the current line, with all information shown in other columns (like the TODO state or a tag). When this variable is non-nil, also the agenda prefix will be removed from @@ -1284,7 +1574,7 @@ headline can be shown in the limited width of the field." :type 'boolean) (defcustom org-agenda-columns-compute-summary-properties t - "Non-nil means, recompute all summary properties before column view. + "Non-nil means recompute all summary properties before column view. When column view in the agenda is listing properties that have a summary operator, it can go to all relevant buffers and recompute the summaries there. This can mean overhead for the agenda column view, but is necessary @@ -1295,7 +1585,7 @@ computations are current." :type 'boolean) (defcustom org-agenda-columns-add-appointments-to-effort-sum nil - "Non-nil means, the duration of an appointment will add to day effort. + "Non-nil means the duration of an appointment will add to day effort. The property to which appointment durations will be added is the one given in the option `org-effort-property'. If an appointment does not have an end time, `org-agenda-default-appointment-duration' will be used. If that @@ -1309,7 +1599,10 @@ estimate." The sole argument to the function, which is called once for each possible tag, is a string giving the name of the tag. The function should return either nil if the tag should be included -as normal, or \"-<TAG>\" to exclude the tag." +as normal, or \"-<TAG>\" to exclude the tag. +Note that for the purpose of tag filtering, only the lower-case version of +all tags will be considered, so that this function will only ever see +the lower-case version of all tags." :group 'org-agenda :type 'function) @@ -1317,6 +1610,18 @@ as normal, or \"-<TAG>\" to exclude the tag." (require 'cl)) (require 'org) +(defmacro org-agenda-with-point-at-orig-entry (string &rest body) + "Execute BODY with point at location given by `org-hd-marker' property. +If STRING is non-nil, the text property will be fetched from position 0 +in that string. If STRING is nil, it will be fetched from the beginning +of the current line." + `(let ((marker (get-text-property (if string 0 (point-at-bol)) + 'org-hd-marker string))) + (with-current-buffer (marker-buffer marker) + (save-excursion + (goto-char marker) + ,@body)))) + (defun org-add-agenda-custom-command (entry) "Replace or add a command in `org-agenda-custom-commands'. This is mostly for hacking and trying a new command - once the command @@ -1342,7 +1647,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvar org-agenda-redo-command nil) (defvar org-agenda-query-string nil) (defvar org-agenda-mode-hook nil - "Hook for org-agenda-mode, run after the mode is turned on.") + "Hook for `org-agenda-mode', run after the mode is turned on.") (defvar org-agenda-type nil) (defvar org-agenda-force-single-file nil) (defvar org-agenda-bulk-marked-entries) ;; Defined further down in this file @@ -1456,6 +1761,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) (org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch) (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) +(org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines) (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) (org-defkey org-agenda-mode-map "r" 'org-agenda-redo) (org-defkey org-agenda-mode-map "g" 'org-agenda-redo) @@ -1496,7 +1802,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel) (org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel) (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto) -(org-defkey org-agenda-mode-map "J" 'org-clock-goto) +(org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto) (org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up) (org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down) (org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up) @@ -1519,10 +1825,8 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) -(org-defkey org-agenda-mode-map - (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) -(org-defkey org-agenda-mode-map - (if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) +(org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse) +(org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse) (when org-agenda-mouse-1-follows-link (org-defkey org-agenda-mode-map [follow-link] 'mouse-face)) (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" @@ -1538,24 +1842,27 @@ The following commands are available: ("View" ["Day View" org-agenda-day-view :active (org-agenda-check-type nil 'agenda) - :style radio :selected (equal org-agenda-ndays 1) + :style radio :selected (eq org-agenda-current-span 'day) :keys "v d (or just d)"] ["Week View" org-agenda-week-view :active (org-agenda-check-type nil 'agenda) - :style radio :selected (equal org-agenda-ndays 7) + :style radio :selected (eq org-agenda-current-span 'week) :keys "v w (or just w)"] ["Month View" org-agenda-month-view :active (org-agenda-check-type nil 'agenda) - :style radio :selected (member org-agenda-ndays '(28 29 30 31)) + :style radio :selected (eq org-agenda-current-span 'month) :keys "v m"] ["Year View" org-agenda-year-view :active (org-agenda-check-type nil 'agenda) - :style radio :selected (member org-agenda-ndays '(365 366)) + :style radio :selected (eq org-agenda-current-span 'year) :keys "v y"] "--" ["Include Diary" org-agenda-toggle-diary :style toggle :selected org-agenda-include-diary :active (org-agenda-check-type nil 'agenda)] + ["Include Deadlines" org-agenda-toggle-deadlines + :style toggle :selected org-agenda-include-deadlines + :active (org-agenda-check-type nil 'agenda)] ["Use Time Grid" org-agenda-toggle-time-grid :style toggle :selected org-agenda-use-time-grid :active (org-agenda-check-type nil 'agenda)] @@ -1674,7 +1981,7 @@ The following commands are available: ;;; Agenda undo (defvar org-agenda-allow-remote-undo t - "Non-nil means, allow remote undo from the agenda buffer.") + "Non-nil means allow remote undo from the agenda buffer.") (defvar org-agenda-undo-list nil "List of undoable operations in the agenda since last refresh.") (defvar org-agenda-undo-has-started-in nil @@ -1820,7 +2127,6 @@ Pressing `<' twice means to restrict to the current subtree or region (move-marker org-agenda-restrict-end (progn (org-end-of-subtree t))))))) - (require 'calendar) ; FIXME: can we avoid this for some commands? ;; For example the todo list should not need it (but does...) (cond ((setq entry (assoc keys org-agenda-custom-commands)) @@ -1918,7 +2224,8 @@ Pressing `<' twice means to restrict to the current subtree or region (custom org-agenda-custom-commands) (selstring "") restriction second-time - c entry key type match prefixes rmheader header-end custom1 desc) + c entry key type match prefixes rmheader header-end custom1 desc + line lines left right n n1) (save-window-excursion (delete-other-windows) (org-switch-to-buffer-other-window " *Agenda Commands*") @@ -1956,56 +2263,91 @@ s Search for keywords C Configure custom agenda commands (move-marker header-end (match-end 0))) (goto-char header-end) (delete-region (point) (point-max)) + + ;; Produce all the lines that describe custom commands and prefixes + (setq lines nil) (while (setq entry (pop custom1)) (setq key (car entry) desc (nth 1 entry) type (nth 2 entry) match (nth 3 entry)) (if (> (length key) 1) (add-to-list 'prefixes (string-to-char key)) - (insert - (format - "\n%-4s%-14s: %s" - (org-add-props (copy-sequence key) - '(face bold)) - (cond - ((string-match "\\S-" desc) desc) - ((eq type 'agenda) "Agenda for current week or day") - ((eq type 'alltodo) "List of all TODO entries") - ((eq type 'search) "Word search") - ((eq type 'stuck) "List of stuck projects") - ((eq type 'todo) "TODO keyword") - ((eq type 'tags) "Tags query") - ((eq type 'tags-todo) "Tags (TODO)") - ((eq type 'tags-tree) "Tags tree") - ((eq type 'todo-tree) "TODO kwd tree") - ((eq type 'occur-tree) "Occur tree") - ((functionp type) (if (symbolp type) - (symbol-name type) - "Lambda expression")) - (t "???")) - (cond - ((stringp match) - (setq match (copy-sequence match)) - (org-add-props match nil 'face 'org-warning)) - (match - (format "set of %d commands" (length match))) - (t "")))))) + (setq line + (format + "%-4s%-14s" + (org-add-props (copy-sequence key) + '(face bold)) + (cond + ((string-match "\\S-" desc) desc) + ((eq type 'agenda) "Agenda for current week or day") + ((eq type 'alltodo) "List of all TODO entries") + ((eq type 'search) "Word search") + ((eq type 'stuck) "List of stuck projects") + ((eq type 'todo) "TODO keyword") + ((eq type 'tags) "Tags query") + ((eq type 'tags-todo) "Tags (TODO)") + ((eq type 'tags-tree) "Tags tree") + ((eq type 'todo-tree) "TODO kwd tree") + ((eq type 'occur-tree) "Occur tree") + ((functionp type) (if (symbolp type) + (symbol-name type) + "Lambda expression")) + (t "???")))) + (if org-agenda-menu-show-matcher + (setq line + (concat line ": " + (cond + ((stringp match) + (setq match (copy-sequence match)) + (org-add-props match nil 'face 'org-warning)) + (match + (format "set of %d commands" (length match))) + (t "")))) + (if (org-string-nw-p match) + (add-text-properties + 0 (length line) (list 'help-echo + (concat "Matcher: "match)) line))) + (push line lines))) + (setq lines (nreverse lines)) (when prefixes (mapc (lambda (x) - (insert - (format "\n%s %s" + (push + (format "%s %s" (org-add-props (char-to-string x) - nil 'face 'bold) - (or (cdr (assoc (concat selstring (char-to-string x)) + nil 'face 'bold) + (or (cdr (assoc (concat selstring + (char-to-string x)) prefix-descriptions)) - "Prefix key")))) + "Prefix key")) + lines)) prefixes)) + + ;; Check if we should display in two columns + (if org-agenda-menu-two-column + (progn + (setq n (length lines) + n1 (+ (/ n 2) (mod n 2)) + right (nthcdr n1 lines) + left (copy-sequence lines)) + (setcdr (nthcdr (1- n1) left) nil)) + (setq left lines right nil)) + (while left + (insert "\n" (pop left)) + (when right + (if (< (current-column) 40) + (move-to-column 40 t) + (insert " ")) + (insert (pop right)))) + + ;; Make the window the right size (goto-char (point-min)) (if second-time (if (not (pos-visible-in-window-p (point-max))) (org-fit-window-to-buffer)) (setq second-time t) (org-fit-window-to-buffer)) + + ;; Ask for selection (message "Press key for agenda command%s:" (if (or restrict-ok org-agenda-overriding-restriction) (if org-agenda-overriding-restriction @@ -2109,7 +2451,7 @@ s Search for keywords C Configure custom agenda commands If CMD-KEY is a string of length 1, it is used as a key in `org-agenda-custom-commands' and triggers this command. If it is a longer string it is used as a tags/todo match string. -Paramters are alternating variable names and values that will be bound +Parameters are alternating variable names and values that will be bound before running the agenda command." (let (pars) (while parameters @@ -2137,7 +2479,7 @@ before running the agenda command." If CMD-KEY is a string of length 1, it is used as a key in `org-agenda-custom-commands' and triggers this command. If it is a longer string it is used as a tags/todo match string. -Paramters are alternating variable names and values that will be bound +Parameters are alternating variable names and values that will be bound before running the agenda command. The output gives a line for each selected agenda item. Each @@ -2186,14 +2528,14 @@ agenda-day The day in the agenda where this is listed" (princ (org-encode-for-stdout (mapconcat 'org-agenda-export-csv-mapper - '(org-category txt type todo tags date time-of-day extra + '(org-category txt type todo tags date time extra priority-letter priority agenda-day) ","))) (princ "\n")))))) (defun org-fix-agenda-info (props) - "Make sure all properties on an agenda item have a canonical form, -so the export commands can easily use it." + "Make sure all properties on an agenda item have a canonical form. +This ensures the export commands can easily use it." (let (tmp re) (when (setq tmp (plist-get props 'tags)) (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) @@ -2295,9 +2637,6 @@ higher priority settings." (interactive "FWrite agenda to file: \nP") (if (not (file-writable-p file)) (error "Cannot write agenda to file %s" file)) - (cond - ((string-match "\\.html?\\'" file) (require 'htmlize)) - ((string-match "\\.ps\\'" file) (require 'ps-print))) (org-let (if nosettings nil org-agenda-exporter-settings) '(save-excursion (save-window-excursion @@ -2305,6 +2644,8 @@ higher priority settings." (let ((bs (copy-sequence (buffer-string))) beg) (org-agenda-unmark-filtered-text) (with-temp-buffer + (rename-buffer "Agenda View" t) + (set-buffer-modified-p nil) (insert bs) (org-agenda-remove-marked-text 'org-filtered) (while (setq beg (text-property-any (point-min) (point-max) @@ -2317,6 +2658,7 @@ higher priority settings." ((org-bound-and-true-p org-mobile-creating-agendas) (org-mobile-write-agenda-for-mobile file)) ((string-match "\\.html?\\'" file) + (require 'htmlize) (set-buffer (htmlize-buffer (current-buffer))) (when (and org-agenda-export-html-style @@ -2331,18 +2673,17 @@ higher priority settings." (message "HTML written to %s" file)) ((string-match "\\.ps\\'" file) (require 'ps-print) - (flet ((ps-get-buffer-name () "Agenda View")) - (ps-print-buffer-with-faces file)) + (ps-print-buffer-with-faces file) (message "Postscript written to %s" file)) ((string-match "\\.pdf\\'" file) (require 'ps-print) - (flet ((ps-get-buffer-name () "Agenda View")) - (ps-print-buffer-with-faces - (concat (file-name-sans-extension file) ".ps"))) + (ps-print-buffer-with-faces + (concat (file-name-sans-extension file) ".ps")) (call-process "ps2pdf" nil nil nil (expand-file-name (concat (file-name-sans-extension file) ".ps")) (expand-file-name file)) + (delete-file (concat (file-name-sans-extension file) ".ps")) (message "PDF written to %s" file)) ((string-match "\\.ics\\'" file) (require 'org-icalendar) @@ -2371,9 +2712,9 @@ higher priority settings." (let ((inhibit-read-only t)) (mapc (lambda (o) - (when (equal (org-overlay-buffer o) (current-buffer)) + (when (equal (overlay-buffer o) (current-buffer)) (put-text-property - (org-overlay-start o) (org-overlay-end o) + (overlay-start o) (overlay-end o) 'org-filtered t))) org-agenda-filter-overlays))) @@ -2408,7 +2749,9 @@ Drawers will be excluded, also the line with scheduling/deadline info." (setq txt (org-agenda-get-some-entry-text m org-agenda-add-entry-text-maxlines " > ")) (end-of-line 1) - (if (string-match "\\S-" txt) (insert "\n" txt))))))) + (if (string-match "\\S-" txt) + (insert "\n" txt) + (or (eobp) (forward-char 1)))))))) (defun org-agenda-get-some-entry-text (marker n-lines &optional indent &rest keep) @@ -2557,18 +2900,23 @@ removed from the entry content. Currently only `planning' is allowed here." (defvar org-agenda-columns-active nil) (defvar org-agenda-name nil) (defvar org-agenda-filter nil) +(defvar org-agenda-filter-while-redo nil) (defvar org-agenda-filter-preset nil "A preset of the tags filter used for secondary agenda filtering. -This must be a list of strings, each string must be a single tag preceeded +This must be a list of strings, each string must be a single tag preceded by \"+\" or \"-\". This variable should not be set directly, but agenda custom commands can -bind it in the options section.") +bind it in the options section. The preset filter is a global property of +the entire agenda view. In a block agenda, it will not work reliably to +define a filter for one of the individual blocks. You need to set it in +the global options and expect it to be applied to the entire view.") (defun org-prepare-agenda (&optional name) (setq org-todo-keywords-for-agenda nil) (setq org-done-keywords-for-agenda nil) (setq org-drawers-for-agenda nil) - (setq org-agenda-filter nil) + (unless org-agenda-persistent-filter + (setq org-agenda-filter nil)) (put 'org-agenda-filter :preset-filter org-agenda-filter-preset) (if org-agenda-multi (progn @@ -2604,7 +2952,11 @@ bind it in the options section.") (switch-to-buffer-other-frame abuf)) ((equal org-agenda-window-setup 'reorganize-frame) (delete-other-windows) - (org-switch-to-buffer-other-window abuf)))) + (org-switch-to-buffer-other-window abuf))) + ;; additional test in case agenda is invoked from within agenda + ;; buffer via elisp link + (unless (equal (current-buffer) abuf) + (switch-to-buffer abuf))) (setq buffer-read-only nil) (let ((inhibit-read-only t)) (erase-buffer)) (org-agenda-mode) @@ -2643,16 +2995,16 @@ bind it in the options section.") (org-habit-insert-consistency-graphs)) (run-hooks 'org-finalize-agenda-hook) (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) - (when (get 'org-agenda-filter :preset-filter) + (when (or org-agenda-filter (get 'org-agenda-filter :preset-filter)) (org-agenda-filter-apply org-agenda-filter)) ))) (defun org-agenda-mark-clocking-task () "Mark the current clock entry in the agenda if it is present." (mapc (lambda (o) - (if (eq (org-overlay-get o 'type) 'org-agenda-clocking) - (org-delete-overlay o))) - (org-overlays-in (point-min) (point-max))) + (if (eq (overlay-get o 'type) 'org-agenda-clocking) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) (when (marker-buffer org-clock-hd-marker) (save-excursion (goto-char (point-min)) @@ -2661,18 +3013,18 @@ bind it in the options section.") (goto-char s) (when (equal (org-get-at-bol 'org-hd-marker) org-clock-hd-marker) - (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-eol)))) - (org-overlay-put ov 'type 'org-agenda-clocking) - (org-overlay-put ov 'face 'org-agenda-clocking) - (org-overlay-put ov 'help-echo + (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol)))) + (overlay-put ov 'type 'org-agenda-clocking) + (overlay-put ov 'face 'org-agenda-clocking) + (overlay-put ov 'help-echo "The clock is running in this item"))))))) (defun org-agenda-fontify-priorities () "Make highest priority lines bold, and lowest italic." (interactive) - (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) - (org-delete-overlay o))) - (org-overlays-in (point-min) (point-max))) + (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) (save-excursion (let ((inhibit-read-only t) b e p ov h l) @@ -2687,21 +3039,25 @@ bind it in the options section.") e (if (eq org-agenda-fontify-priorities 'cookies) (match-end 0) (point-at-eol)) - ov (org-make-overlay b e)) - (org-overlay-put + ov (make-overlay b e)) + (overlay-put ov 'face - (cond ((cdr (assoc p org-priority-faces))) + (cond ((org-face-from-face-or-color + 'priority nil + (cdr (assoc p org-priority-faces)))) ((and (listp org-agenda-fontify-priorities) - (cdr (assoc p org-agenda-fontify-priorities)))) + (org-face-from-face-or-color + 'priority nil + (cdr (assoc p org-agenda-fontify-priorities))))) ((equal p l) 'italic) ((equal p h) 'bold))) - (org-overlay-put ov 'org-type 'org-priority))))) + (overlay-put ov 'org-type 'org-priority))))) (defun org-agenda-dim-blocked-tasks () "Dim currently blocked TODO's in the agenda display." - (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-blocked-todo) - (org-delete-overlay o))) - (org-overlays-in (point-min) (point-max))) + (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) (save-excursion (let ((inhibit-read-only t) (org-depend-tag-blocked nil) @@ -2730,11 +3086,11 @@ bind it in the options section.") (max (point-min) (1- (point-at-bol))) (point-at-bol)) e (point-at-eol) - ov (org-make-overlay b e)) + ov (make-overlay b e)) (if invis1 - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'face 'org-agenda-dimmed-todo-face)) - (org-overlay-put ov 'org-type 'org-blocked-todo))))))) + (overlay-put ov 'invisible t) + (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) + (overlay-put ov 'org-type 'org-blocked-todo))))))) (defvar org-agenda-skip-function nil "Function to be called at each match during agenda construction. @@ -2745,7 +3101,7 @@ This may also be a Lisp form, it will be evaluated. Never set this variable using `setq' or so, because then it will apply to all future agenda commands. Instead, bind it with `let' to scope it dynamically into the agenda-constructing command. A good way to set -it is through options in org-agenda-custom-commands.") +it is through options in `org-agenda-custom-commands'.") (defun org-agenda-skip () "Throw to `:skip' in places that should be skipped. @@ -2807,10 +3163,10 @@ no longer in use." (org-agenda-get-some-entry-text m org-agenda-entry-text-maxlines " > ")))) (when (string-match "\\S-" txt) - (setq o (org-make-overlay (point-at-bol) (point-at-eol))) - (org-overlay-put o 'evaporate t) - (org-overlay-put o 'org-overlay-type 'agenda-entry-content) - (org-overlay-put o 'after-string txt)))) + (setq o (make-overlay (point-at-bol) (point-at-eol))) + (overlay-put o 'evaporate t) + (overlay-put o 'org-overlay-type 'agenda-entry-content) + (overlay-put o 'after-string txt)))) (defun org-agenda-entry-text-show () "Add entry context for all agenda lines." @@ -2827,10 +3183,20 @@ no longer in use." "Remove any shown entry context." (delq nil (mapcar (lambda (o) - (if (eq (org-overlay-get o 'org-overlay-type) + (if (eq (overlay-get o 'org-overlay-type) 'agenda-entry-content) - (progn (org-delete-overlay o) t))) - (org-overlays-in (point-min) (point-max))))) + (progn (delete-overlay o) t))) + (overlays-in (point-min) (point-max))))) + +(defun org-agenda-get-day-face (date) + "Return the face DATE should be displayed with." + (or (and (functionp org-agenda-day-face-function) + (funcall org-agenda-day-face-function date)) + (cond ((org-agenda-todayp date) + 'org-agenda-date-today) + ((member (calendar-day-of-week date) org-agenda-weekend-days) + 'org-agenda-date-weekend) + (t 'org-agenda-date)))) ;;; Agenda timeline @@ -2844,13 +3210,13 @@ under the current date. If the buffer contains an active region, only check the region for dates." (interactive "P") - (require 'calendar) (org-compile-prefix-format 'timeline) (org-set-sorting-strategy 'timeline) (let* ((dopast t) (dotodo include-all) (doclosed org-agenda-show-log) - (entry buffer-file-name) + (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) + (current-buffer)))) (date (calendar-current-date)) (beg (if (org-region-active-p) (region-beginning) (point-min))) (end (if (org-region-active-p) (region-end) (point-max))) @@ -2859,10 +3225,10 @@ dates." org-timeline-show-empty-dates)) (org-deadline-warning-days 0) (org-agenda-only-exact-dates t) - (today (time-to-days (current-time))) + (today (org-today)) (past t) args - s e rtn d emptyp wd) + s e rtn d emptyp) (setq org-agenda-redo-command (list 'progn (list 'org-switch-to-buffer-other-window (current-buffer)) @@ -2872,8 +3238,7 @@ dates." (setq day-numbers (delq nil (mapcar (lambda(x) (if (>= x today) x nil)) day-numbers)))) - (org-prepare-agenda (concat "Timeline " - (file-name-nondirectory buffer-file-name))) + (org-prepare-agenda (concat "Timeline " (file-name-nondirectory entry))) (if doclosed (push :closed args)) (push :timestamp args) (push :deadline args) @@ -2897,8 +3262,7 @@ dates." (progn (setq past nil) (insert (make-string 79 ?-) "\n"))) - (setq date (calendar-gregorian-from-absolute d) - wd (calendar-day-of-week date)) + (setq date (calendar-gregorian-from-absolute d)) (setq s (point)) (setq rtn (and (not emptyp) (apply 'org-agenda-get-day-entries entry @@ -2912,9 +3276,7 @@ dates." (funcall org-agenda-format-date date)) "\n") (put-text-property s (1- (point)) 'face - (if (member wd org-agenda-weekend-days) - 'org-agenda-date-weekend - 'org-agenda-date)) + (org-agenda-get-day-face date)) (put-text-property s (1- (point)) 'org-date-line t) (put-text-property s (1- (point)) 'org-agenda-date-header t) (if (equal d today) @@ -2940,7 +3302,7 @@ When EMPTY is non-nil, also include days without any entries." (if inactive org-ts-regexp-both org-ts-regexp))) dates dates1 date day day1 day2 ts1 ts2) (if force-today - (setq dates (list (time-to-days (current-time))))) + (setq dates (list (org-today)))) (save-excursion (goto-char beg) (while (re-search-forward re end t) @@ -2976,13 +3338,47 @@ When EMPTY is non-nil, also include days without any entries." (defvar org-agenda-start-day nil ; dynamically scoped parameter "Custom commands can set this variable in the options section.") (defvar org-agenda-last-arguments nil - "The arguments of the previous call to org-agenda") + "The arguments of the previous call to `org-agenda'.") (defvar org-starting-day nil) ; local variable in the agenda buffer -(defvar org-agenda-span nil) ; local variable in the agenda buffer +(defvar org-agenda-current-span nil + "The current span used in the agenda view.") ; local variable in the agenda buffer (defvar org-include-all-loc nil) ; local variable +(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) + "List of types searched for when creating the daily/weekly agenda. +This variable is a list of symbols that controls the types of +items that appear in the daily/weekly agenda. Allowed symbols in this +list are are + + :timestamp List items containing a date stamp or date range matching + the selected date. This includes sexp entries in + angular brackets. + + :sexp List entries resulting from plain diary-like sexps. + + :deadline List deadline due on that date. When the date is today, + also list any deadlines past due, or due within + `org-deadline-warning-days'. `:deadline' must appear before + `:scheduled' if the setting of + `org-agenda-skip-scheduled-if-deadline-is-shown' is to have + any effect. + + :scheduled List all items which are scheduled for the given date. + The diary for *today* also contains items which were + scheduled earlier and are not yet marked DONE. + +By default, all four types are turned on. + +Never set this variable globally using `setq', because then it +will apply to all future agenda commands. Instead, bind it with +`let' to scope it dynamically into the the agenda-constructing +command. A good way to set it is through options in +`org-agenda-custom-commands'. For a more flexible (though +somewhat less efficient) way of determining what is included in +the daily/weekly agenda, see `org-agenda-skip-function'.") + ;;;###autoload -(defun org-agenda-list (&optional include-all start-day ndays) +(defun org-agenda-list (&optional include-all start-day span) "Produce a daily/weekly view from all files in variable `org-agenda-files'. The view will be for the current day or week, but from the overview buffer you will be able to go to other days/weeks. @@ -2993,38 +3389,36 @@ This feature is considered obsolete, please use the TODO list or a block agenda instead. With a numeric prefix argument in an interactive call, the agenda will -span INCLUDE-ALL days. Lisp programs should instead specify NDAYS to change -the number of days. NDAYS defaults to `org-agenda-ndays'. +span INCLUDE-ALL days. Lisp programs should instead specify SPAN to change +the number of days. SPAN defaults to `org-agenda-span'. START-DAY defaults to TODAY, or to the most recent match for the weekday given in `org-agenda-start-on-weekday'." (interactive "P") (if (and (integerp include-all) (> include-all 0)) - (setq ndays include-all include-all nil)) - (setq ndays (or ndays org-agenda-ndays) - start-day (or start-day org-agenda-start-day)) + (setq span include-all include-all nil)) + (setq start-day (or start-day org-agenda-start-day)) (if org-agenda-overriding-arguments (setq include-all (car org-agenda-overriding-arguments) start-day (nth 1 org-agenda-overriding-arguments) - ndays (nth 2 org-agenda-overriding-arguments))) + span (nth 2 org-agenda-overriding-arguments))) (if (stringp start-day) ;; Convert to an absolute day number (setq start-day (time-to-days (org-read-date nil t start-day)))) - (setq org-agenda-last-arguments (list include-all start-day ndays)) + (setq org-agenda-last-arguments (list include-all start-day span)) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) - (require 'calendar) - (let* ((org-agenda-start-on-weekday - (if (or (equal ndays 7) (and (null ndays) (equal 7 org-agenda-ndays))) - org-agenda-start-on-weekday nil)) + (let* ((span (org-agenda-ndays-to-span (or span org-agenda-ndays org-agenda-span))) + (today (org-today)) + (sd (or start-day today)) + (ndays (org-agenda-span-to-ndays span sd)) + (org-agenda-start-on-weekday + (if (eq ndays 7) + org-agenda-start-on-weekday)) (thefiles (org-agenda-files nil 'ifmode)) (files thefiles) - (today (time-to-days - (time-subtract (current-time) - (list 0 (* 3600 org-extend-today-until) 0)))) - (sd (or start-day today)) (start (if (or (null org-agenda-start-on-weekday) - (< org-agenda-ndays 7)) + (< ndays 7)) sd (let* ((nt (calendar-day-of-week (calendar-gregorian-from-absolute sd))) @@ -3034,24 +3428,19 @@ given in `org-agenda-start-on-weekday'." (day-numbers (list start)) (day-cnt 0) (inhibit-redisplay (not debug-on-error)) - s e rtn rtnall file date d start-pos end-pos todayp nd wd - clocktable-start clocktable-end) + s e rtn rtnall file date d start-pos end-pos todayp + clocktable-start clocktable-end filter) (setq org-agenda-redo-command - (list 'org-agenda-list (list 'quote include-all) start-day ndays)) - ;; Make the list of days - (setq ndays (or ndays org-agenda-ndays) - nd ndays) - (while (> ndays 1) - (push (1+ (car day-numbers)) day-numbers) - (setq ndays (1- ndays))) + (list 'org-agenda-list (list 'quote include-all) start-day (list 'quote span))) + (dotimes (n (1- ndays)) + (push (1+ (car day-numbers)) day-numbers)) (setq day-numbers (nreverse day-numbers)) (setq clocktable-start (car day-numbers) clocktable-end (1+ (or (org-last day-numbers) 0))) (org-prepare-agenda "Day/Week") (org-set-local 'org-starting-day (car day-numbers)) (org-set-local 'org-include-all-loc include-all) - (org-set-local 'org-agenda-span - (org-agenda-ndays-to-span nd)) + (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) (when (and (or include-all org-agenda-include-all-todo) (member today day-numbers)) (setq files thefiles @@ -3079,7 +3468,7 @@ given in `org-agenda-start-on-weekday'." (if org-agenda-overriding-header (insert (org-add-props (copy-sequence org-agenda-overriding-header) nil 'face 'org-agenda-structure) "\n") - (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd))) + (insert (org-agenda-span-name span) "-agenda" (if (< (- d2 d1) 350) (if (= w1 w2) @@ -3092,7 +3481,6 @@ given in `org-agenda-start-on-weekday'." (org-agenda-mark-header-line s)) (while (setq d (pop day-numbers)) (setq date (calendar-gregorian-from-absolute d) - wd (calendar-day-of-week date) s (point)) (if (or (setq todayp (= d today)) (and (not start-pos) (= d sd))) @@ -3104,18 +3492,22 @@ given in `org-agenda-start-on-weekday'." (while (setq file (pop files)) (catch 'nextfile (org-check-agenda-file file) - (cond - ((eq org-agenda-show-log 'only) - (setq rtn (org-agenda-get-day-entries - file date :closed))) - (org-agenda-show-log - (setq rtn (org-agenda-get-day-entries - file date - :deadline :scheduled :timestamp :sexp :closed))) - (t - (setq rtn (org-agenda-get-day-entries - file date - :deadline :scheduled :sexp :timestamp)))) + (let ((org-agenda-entry-types org-agenda-entry-types)) + (unless org-agenda-include-deadlines + (setq org-agenda-entry-types + (delq :deadline org-agenda-entry-types))) + (cond + ((eq org-agenda-show-log 'only) + (setq rtn (org-agenda-get-day-entries + file date :closed))) + (org-agenda-show-log + (setq rtn (apply 'org-agenda-get-day-entries + file date + (append '(:closed) org-agenda-entry-types)))) + (t + (setq rtn (apply 'org-agenda-get-day-entries + file date + org-agenda-entry-types))))) (setq rtnall (append rtnall rtn)))) (if org-agenda-include-diary (let ((org-agenda-search-headline-for-time t)) @@ -3132,19 +3524,16 @@ given in `org-agenda-start-on-weekday'." (funcall org-agenda-format-date date)) "\n") (put-text-property s (1- (point)) 'face - (if (member wd org-agenda-weekend-days) - 'org-agenda-date-weekend - 'org-agenda-date)) + (org-agenda-get-day-face date)) (put-text-property s (1- (point)) 'org-date-line t) (put-text-property s (1- (point)) 'org-agenda-date-header t) (put-text-property s (1- (point)) 'org-day-cnt day-cnt) (when todayp - (put-text-property s (1- (point)) 'org-today t) - (put-text-property s (1- (point)) 'face 'org-agenda-date-today)) + (put-text-property s (1- (point)) 'org-today t)) (if rtnall (insert (org-finalize-agenda-entries (org-agenda-add-time-grid-maybe - rtnall nd todayp)) + rtnall ndays todayp)) "\n")) (put-text-property s (1- (point)) 'day d) (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) @@ -3157,6 +3546,15 @@ given in `org-agenda-start-on-weekday'." (setq p (plist-put p :tstart clocktable-start)) (setq p (plist-put p :tend clocktable-end)) (setq p (plist-put p :scope 'agenda)) + (when (and (eq org-agenda-clockreport-mode 'with-filter) + (setq filter (or org-agenda-filter-while-redo + (get 'org-agenda-filter :preset-filter)))) + (setq p (plist-put p :tags (mapconcat (lambda (x) + (if (string-match "[<>=]" x) + "" + x)) + filter "")))) + (message "%s" (plist-get p :tags)) (sit-for 2) (setq tbl (apply 'org-get-clocktable p)) (insert tbl))) (goto-char (point-min)) @@ -3176,7 +3574,31 @@ given in `org-agenda-start-on-weekday'." (message ""))) (defun org-agenda-ndays-to-span (n) - (cond ((< n 7) 'day) ((= n 7) 'week) ((< n 32) 'month) (t 'year))) + "Return a span symbol for a span of N days, or N if none matches." + (cond ((symbolp n) n) + ((= n 1) 'day) + ((= n 7) 'week) + (t n))) + +(defun org-agenda-span-to-ndays (span start-day) + "Return ndays from SPAN starting at START-DAY." + (cond ((numberp span) span) + ((eq span 'day) 1) + ((eq span 'week) 7) + ((eq span 'month) + (let ((date (calendar-gregorian-from-absolute start-day))) + (calendar-last-day-of-month (car date) (caddr date)))) + ((eq span 'year) + (let ((date (calendar-gregorian-from-absolute start-day))) + (if (calendar-leap-year-p (caddr date)) 366 365))))) + +(defun org-agenda-span-name (span) + "Return a SPAN name." + (if (null span) + "" + (if (symbolp span) + (capitalize (symbol-name span)) + (format "%d days" span)))) ;;; Agenda word search @@ -3195,11 +3617,11 @@ that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") (modify-syntax-entry ?` "." org-search-syntax-table)) org-search-syntax-table) +(defvar org-agenda-last-search-view-search-was-boolean nil) + ;;;###autoload (defun org-search-view (&optional todo-only string edit-at) - "Show all entries that contain words or regular expressions. -If the first character of the search string is an asterisks, -search only the headlines. + "Show all entries that contain a phrase or words or regular expressions. With optional prefix argument TODO-ONLY, only consider entries that are TODO entries. The argument STRING can be used to pass a default search @@ -3207,28 +3629,37 @@ string into this function. If EDIT-AT is non-nil, it means that the user should get a chance to edit this string, with cursor at position EDIT-AT. -The search string is broken into \"words\" by splitting at whitespace. -Depending on the variable `org-agenda-search-view-search-words-only' -and on whether the first character in the search string is \"+\" or \"-\", -The string is then interpreted either as a substring with variable amounts -of whitespace, or as a list or individual words that should be matched. - -The default is a substring match, where each space in the search string -can expand to an arbitrary amount of whitespace, including newlines. - -If matching individual words, these words are then interpreted as a -boolean expression with logical AND. Words prefixed with a minus must -not occur in the entry. Words without a prefix or prefixed with a plus -must occur in the entry. Matching is case-insensitive and the words -are enclosed by word delimiters. - -Words enclosed by curly braces are interpreted as regular expressions -that must or must not match in the entry. - -If the search string starts with an asterisk, search only in headlines. -If (possibly after the leading star) the search string starts with an -exclamation mark, this also means to look at TODO entries only, an effect -that can also be achieved with a prefix argument. +The search string can be viewed either as a phrase that should be found as +is, or it can be broken into a number of snippets, each of which must match +in a Boolean way to select an entry. The default depends on the variable +`org-agenda-search-view-always-boolean'. +Even if this is turned off (the default) you can always switch to +Boolean search dynamically by preceding the first word with \"+\" or \"-\". + +The default is a direct search of the whole phrase, where each space in +the search string can expand to an arbitrary amount of whitespace, +including newlines. + +If using a Boolean search, the search string is split on whitespace and +each snippet is searched separately, with logical AND to select an entry. +Words prefixed with a minus must *not* occur in the entry. Words without +a prefix or prefixed with a plus must occur in the entry. Matching is +case-insensitive. Words are enclosed by word delimiters (i.e. they must +match whole words, not parts of a word) if +`org-agenda-search-view-force-full-words' is set (default is nil). + +Boolean search snippets enclosed by curly braces are interpreted as +regular expressions that must or (when preceded with \"-\") must not +match in the entry. Snippets enclosed into double quotes will be taken +as a whole, to include whitespace. + +- If the search string starts with an asterisk, search only in headlines. +- If (possibly after the leading star) the search string starts with an + exclamation mark, this also means to look at TODO entries only, an effect + that can also be achieved with a prefix argument. +- If (possibly after star and exclamation mark) the search string starts + with a colon, this will mean that the (non-regexp) snippets of the + Boolean search must match as full words. This command searches the agenda files, and in addition the files listed in `org-agenda-text-search-extra-files'." @@ -3243,17 +3674,22 @@ in `org-agenda-text-search-extra-files'." 'org-complex-heading-regexp org-complex-heading-regexp 'mouse-face 'highlight 'help-echo (format "mouse-2 or RET jump to location"))) + (full-words org-agenda-search-view-force-full-words) + (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) regexp rtn rtnall files file pos - marker category tags c neg re as-words + marker category tags c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) (unless (and (not edit-at) (stringp string) (string-match "\\S-" string)) - (setq string (read-string "[+-]Word/{Regexp} ...: " - (cond - ((integerp edit-at) (cons string edit-at)) - (edit-at string)) - 'org-agenda-search-history))) + (setq string (read-string + (if org-agenda-search-view-always-boolean + "[+-]Word/{Regexp} ...: " + "Phrase, or [+-]Word/{Regexp} ...: ") + (cond + ((integerp edit-at) (cons string edit-at)) + (edit-at string)) + 'org-agenda-search-history))) (org-set-local 'org-todo-only todo-only) (setq org-agenda-redo-command (list 'org-search-view (if todo-only t nil) string @@ -3267,21 +3703,55 @@ in `org-agenda-text-search-extra-files'." (when (equal (string-to-char words) ?!) (setq todo-only t words (substring words 1))) - (if (or org-agenda-search-view-search-words-only - (member (string-to-char string) '(?- ?+))) - (setq as-words t)) + (when (equal (string-to-char words) ?:) + (setq full-words t + words (substring words 1))) + (if (or org-agenda-search-view-always-boolean + (member (string-to-char words) '(?- ?+ ?\{))) + (setq boolean t)) (setq words (org-split-string words)) - (if as-words + (let (www w) + (while (setq w (pop words)) + (while (and (string-match "\\\\\\'" w) words) + (setq w (concat (substring w 0 -1) " " (pop words)))) + (push w www)) + (setq words (nreverse www) www nil) + (while (setq w (pop words)) + (when (and (string-match "\\`[-+]?{" w) + (not (string-match "}\\'" w))) + (while (and words (not (string-match "}\\'" (car words)))) + (setq w (concat w " " (pop words)))) + (setq w (concat w " " (pop words)))) + (push w www)) + (setq words (nreverse www))) + (setq org-agenda-last-search-view-search-was-boolean boolean) + (when boolean + (let (wds w) + (while (setq w (pop words)) + (if (or (equal (substring w 0 1) "\"") + (and (> (length w) 1) + (member (substring w 0 1) '("+" "-")) + (equal (substring w 1 2) "\""))) + (while (and words (not (equal (substring w -1) "\""))) + (setq w (concat w " " (pop words))))) + (and (string-match "\\`\\([-+]?\\)\"" w) + (setq w (replace-match "\\1" nil nil w))) + (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) + (push w wds)) + (setq words (nreverse wds)))) + (if boolean (mapc (lambda (w) (setq c (string-to-char w)) (if (equal c ?-) (setq neg t w (substring w 1)) (if (equal c ?+) (setq neg nil w (substring w 1)) - (setq neg nil))) + (setq neg nil))) (if (string-match "\\`{.*}\\'" w) (setq re (substring w 1 -1)) - (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))) + (if full-words + (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) + (setq re (regexp-quote (downcase w))))) (if neg (push re regexps-) (push re regexps+))) words) (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+") @@ -3397,17 +3867,17 @@ in `org-agenda-text-search-extra-files'." ;;;###autoload (defun org-todo-list (arg) - "Show all TODO entries from all agenda file in a single list. + "Show all (not done) TODO entries from all agenda file in a single list. The prefix arg can be used to select a specific TODO keyword and limit the list to these. When using \\[universal-argument], you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'." (interactive "P") - (require 'calendar) (org-compile-prefix-format 'todo) (org-set-sorting-strategy 'todo) (org-prepare-agenda "TODO") - (let* ((today (time-to-days (current-time))) + (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) + (let* ((today (org-today)) (date (calendar-gregorian-from-absolute today)) (kwds org-todo-keywords-for-agenda) (completion-ignore-case t) @@ -3475,11 +3945,12 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (org-compile-prefix-format 'tags) (org-set-sorting-strategy 'tags) (let* ((org-tags-match-list-sublevels -;?????? (if todo-only t org-tags-match-list-sublevels)) org-tags-match-list-sublevels) (completion-ignore-case t) rtn rtnall files file pos matcher buffer) + (when (and (stringp match) (not (string-match "\\S-" match))) + (setq match nil)) (setq matcher (org-make-tags-matcher match) match (car matcher) matcher (cdr matcher)) (org-prepare-agenda (concat "TAGS " match)) @@ -3548,7 +4019,7 @@ This variable should not be set directly, but custom commands can bind it in the options section.") (defun org-agenda-skip-entry-when-regexp-matches () - "Checks if the current entry contains match for `org-agenda-skip-regexp'. + "Check if the current entry contains match for `org-agenda-skip-regexp'. If yes, it returns the end position of this entry, causing agenda commands to skip the entry but continuing the search in the subtree. This is a function that can be put into `org-agenda-skip-function' for the duration @@ -3560,7 +4031,7 @@ of a command." (and skip end))) (defun org-agenda-skip-subtree-when-regexp-matches () - "Checks if the current subtree contains match for `org-agenda-skip-regexp'. + "Check if the current subtree contains match for `org-agenda-skip-regexp'. If yes, it returns the end position of this tree, causing agenda commands to skip this subtree. This is a function that can be put into `org-agenda-skip-function' for the duration of a command." @@ -3571,7 +4042,7 @@ to skip this subtree. This is a function that can be put into (and skip end))) (defun org-agenda-skip-entry-when-regexp-matches-in-subtree () - "Checks if the current subtree contains match for `org-agenda-skip-regexp'. + "Check if the current subtree contains match for `org-agenda-skip-regexp'. If yes, it returns the end position of the current entry (NOT the tree), causing agenda commands to skip the entry but continuing the search in the subtree. This is a function that can be put into @@ -3610,10 +4081,26 @@ timestamp Check if there is a timestamp (also deadline or scheduled) nottimestamp Check if there is no timestamp (also deadline or scheduled) regexp Check if regexp matches notregexp Check if regexp does not match. +todo Check if TODO keyword matches +nottodo Check if TODO keyword does not match The regexp is taken from the conditions list, it must come right after the `regexp' or `notregexp' element. +`todo' and `nottodo' accept as an argument a list of todo +keywords, which may include \"*\" to match any todo keyword. + + (org-agenda-skip-entry-if 'todo '(\"TODO\" \"WAITING\")) + +would skip all entries with \"TODO\" or \"WAITING\" keywords. + +Instead of a list a keyword class may be given + + (org-agenda-skip-entry-if 'nottodo 'done) + +would skip entries that haven't been marked with any of \"DONE\" +keywords. Possible classes are: `todo', `done', `any'. + If any of these conditions is met, this function returns the end point of the entity, causing the search to continue from there. This is a function that can be put into `org-agenda-skip-function' for the duration of a command." @@ -3643,16 +4130,51 @@ that can be put into `org-agenda-skip-function' for the duration of a command." (re-search-forward (nth 1 m) end t)) (and (setq m (memq 'notregexp conditions)) (stringp (nth 1 m)) - (not (re-search-forward (nth 1 m) end t)))) + (not (re-search-forward (nth 1 m) end t))) + (and (or + (setq m (memq 'todo conditions)) + (setq m (memq 'nottodo conditions))) + (org-agenda-skip-if-todo m end))) end))) +(defun org-agenda-skip-if-todo (args end) + "Helper function for `org-agenda-skip-if', do not use it directly. +ARGS is a list with first element either `todo' or `nottodo'. +The remainder is either a list of TODO keywords, or a state symbol +`todo' or `done' or `any'." + (let ((kw (car args)) + (arg (cadr args)) + todo-wds todo-re) + (setq todo-wds + (org-uniquify + (cond + ((listp arg) ;; list of keywords + (if (member "*" arg) + (mapcar 'substring-no-properties org-todo-keywords-1) + arg)) + ((symbolp arg) ;; keyword class name + (cond + ((eq arg 'todo) + (org-delete-all org-done-keywords + (mapcar 'substring-no-properties + org-todo-keywords-1))) + ((eq arg 'done) org-done-keywords) + ((eq arg 'any) + (mapcar 'substring-no-properties org-todo-keywords-1))))))) + (setq todo-re + (concat "^\\*+[ \t]+\\<\\(" + (mapconcat 'identity todo-wds "\\|") + "\\)\\>")) + (if (eq kw 'todo) + (re-search-forward todo-re end t) + (not (re-search-forward todo-re end t))))) + ;;;###autoload (defun org-agenda-list-stuck-projects (&rest ignore) "Create agenda view for projects that are stuck. Stuck projects are project that have no next actions. For the definitions of what a project is and how to check if it stuck, customize the variable -`org-stuck-projects'. -MATCH is being ignored." +`org-stuck-projects'." (interactive) (let* ((org-agenda-skip-function 'org-agenda-skip-entry-when-regexp-matches-in-subtree) @@ -3674,11 +4196,11 @@ MATCH is being ignored." "\\)\\>")) (tags (nth 2 org-stuck-projects)) (tags-re (if (member "*" tags) - (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$") + (org-re "^\\*+ .*:[[:alnum:]_@#%]+:[ \t]*$") (if tags (concat "^\\*+ .*:\\(" (mapconcat 'identity tags "\\|") - (org-re "\\):[[:alnum:]_@:]*[ \t]*$"))))) + (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$"))))) (gen-re (nth 3 org-stuck-projects)) (re-list (delq nil @@ -3706,7 +4228,6 @@ MATCH is being ignored." "Get the (Emacs Calendar) diary entries for DATE." (require 'diary-lib) (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") - (fancy-diary-buffer diary-fancy-buffer) (diary-display-hook '(fancy-diary-display)) (diary-display-function 'fancy-diary-display) (pop-up-frames nil) @@ -3744,7 +4265,7 @@ MATCH is being ignored." (setq x (org-format-agenda-item "" x "Diary" nil 'time)) ;; Extend the text properties to the beginning of the line (org-add-props x (text-properties-at (1- (length x)) x) - 'type "diary" 'date date)) + 'type "diary" 'date date 'face 'org-agenda-diary)) entries))))) (defvar org-agenda-cleanup-fancy-diary-hook nil @@ -3811,33 +4332,16 @@ Needed to avoid empty dates which mess up holiday display." (apply 'diary-add-to-list args) (apply 'add-to-diary-list args))) +(defvar org-diary-last-run-time nil) + ;;;###autoload (defun org-diary (&rest args) "Return diary information from org-files. This function can be used in a \"sexp\" diary entry in the Emacs calendar. It accesses org files and extracts information from those files to be listed in the diary. The function accepts arguments specifying what -items should be listed. The following arguments are allowed: - - :timestamp List the headlines of items containing a date stamp or - date range matching the selected date. Deadlines will - also be listed, on the expiration day. - - :sexp List entries resulting from diary-like sexps. - - :deadline List any deadlines past due, or due within - `org-deadline-warning-days'. The listing occurs only - in the diary for *today*, not at any other date. If - an entry is marked DONE, it is no longer listed. - - :scheduled List all items which are scheduled for the given date. - The diary for *today* also contains items which were - scheduled earlier and are not yet marked DONE. - - :todo List all TODO items from the org-file. This may be a - long list - so this is not turned on by default. - Like deadlines, these entries only show up in the - diary for *today*, not at any other date. +items should be listed. For a list of arguments allowed here, see the +variable `org-agenda-entry-types'. The call in the diary file should look like this: @@ -3867,8 +4371,14 @@ function from a program - use `org-agenda-get-day-entries' instead." (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) (list entry) (org-agenda-files t))) + (time (org-float-time)) file rtn results) - (org-prepare-agenda-buffers files) + (when (or (not org-diary-last-run-time) + (> (- time + org-diary-last-run-time) + 3)) + (org-prepare-agenda-buffers files)) + (setq org-diary-last-run-time time) ;; If this is called during org-agenda, don't return any entries to ;; the calendar. Org Agenda will list these entries itself. (if org-disable-agenda-to-diary (setq files nil)) @@ -3986,20 +4496,58 @@ the documentation of `org-diary'." (nreverse ee))) ;;;###autoload -(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item (&optional end) - "Do we have a reason to ignore this todo entry because it has a time stamp?" +(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item + (&optional end) + "Do we have a reason to ignore this TODO entry because it has a time stamp?" (when (or org-agenda-todo-ignore-with-date org-agenda-todo-ignore-scheduled - org-agenda-todo-ignore-deadlines) + org-agenda-todo-ignore-deadlines + org-agenda-todo-ignore-timestamp) (setq end (or end (save-excursion (outline-next-heading) (point)))) (save-excursion (or (and org-agenda-todo-ignore-with-date (re-search-forward org-ts-regexp end t)) (and org-agenda-todo-ignore-scheduled - (re-search-forward org-scheduled-time-regexp end t)) + (re-search-forward org-scheduled-time-regexp end t) + (cond + ((eq org-agenda-todo-ignore-scheduled 'future) + (> (org-days-to-time (match-string 1)) 0)) + ((eq org-agenda-todo-ignore-scheduled 'past) + (<= (org-days-to-time (match-string 1)) 0)) + (t))) (and org-agenda-todo-ignore-deadlines (re-search-forward org-deadline-time-regexp end t) - (org-deadline-close (match-string 1))))))) + (cond + ((memq org-agenda-todo-ignore-deadlines '(t all)) t) + ((eq org-agenda-todo-ignore-deadlines 'far) + (not (org-deadline-close (match-string 1)))) + ((eq org-agenda-todo-ignore-deadlines 'future) + (> (org-days-to-time (match-string 1)) 0)) + ((eq org-agenda-todo-ignore-deadlines 'past) + (<= (org-days-to-time (match-string 1)) 0)) + (t (org-deadline-close (match-string 1))))) + (and org-agenda-todo-ignore-timestamp + (let ((buffer (current-buffer)) + (regexp + (concat + org-scheduled-time-regexp "\\|" org-deadline-time-regexp)) + (start (point))) + ;; Copy current buffer into a temporary one + (with-temp-buffer + (insert-buffer-substring buffer start end) + (goto-char (point-min)) + ;; Delete SCHEDULED and DEADLINE items + (while (re-search-forward regexp end t) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (point-min)) + ;; No search for timestamp left + (when (re-search-forward org-ts-regexp nil t) + (cond + ((eq org-agenda-todo-ignore-timestamp 'future) + (> (org-days-to-time (match-string 1)) 0)) + ((eq org-agenda-todo-ignore-timestamp 'past) + (<= (org-days-to-time (match-string 1)) 0)) + (t)))))))))) (defconst org-agenda-no-heading-message "No heading for this item in buffer or region.") @@ -4064,7 +4612,7 @@ the documentation of `org-diary'." clockp (and org-agenda-include-inactive-timestamps (or (string-match org-clock-string tmp) (string-match "]-+\\'" tmp))) - todo-state (org-get-todo-state) + todo-state (ignore-errors (org-get-todo-state)) donep (member todo-state org-done-keywords)) (if (or scheduledp deadlinep closedp clockp (and donep org-agenda-skip-timestamp-if-done)) @@ -4083,7 +4631,7 @@ the documentation of `org-diary'." (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (match-string 1)) (setq txt (org-format-agenda-item - (if inactivep "[" nil) + (if inactivep org-agenda-inactive-leader nil) head category tags timestr nil remove-re))) (setq priority (org-get-priority txt)) @@ -4128,19 +4676,46 @@ the documentation of `org-diary'." category (org-get-category beg) todo-state (org-get-todo-state)) - (if (string-match "\\S-" result) - (setq txt result) - (setq txt "SEXP entry returned empty string")) - - (setq txt (org-format-agenda-item - "" txt category tags 'time)) - (org-add-props txt props 'org-marker marker) - (org-add-props txt nil - 'org-category category 'date date 'todo-state todo-state - 'type "sexp") - (push txt ee)))) + (dolist (r (if (stringp result) + (list result) + result)) ;; we expect a list here + (if (string-match "\\S-" r) + (setq txt r) + (setq txt "SEXP entry returned empty string")) + + (setq txt (org-format-agenda-item + "" txt category tags 'time)) + (org-add-props txt props 'org-marker marker) + (org-add-props txt nil + 'org-category category 'date date 'todo-state todo-state + 'type "sexp") + (push txt ee))))) (nreverse ee))) +(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) + "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. +The order of the first 2 times 3 arguments depends on the variable +`calendar-date-style' or, if that is not defined, on `european-calendar-style'. +So for American calendars, give this as MONTH DAY YEAR, for European as +DAY MONTH YEAR, and for ISO as YEAR MONTH DAY. +DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS +is any number of ISO weeks in the block period for which the item should +be skipped." + (let* ((date1 (calendar-absolute-from-gregorian + (org-order-calendar-date-args m1 d1 y1))) + (date2 (calendar-absolute-from-gregorian + (org-order-calendar-date-args m2 d2 y2))) + (d (calendar-absolute-from-gregorian date))) + (and + (<= date1 d) + (<= d date2) + (= (calendar-day-of-week date) dayname) + (or (not skip-weeks) + (progn + (require 'cal-iso) + (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) + entry))) + (defalias 'org-get-closed 'org-agenda-get-progress) (defun org-agenda-get-progress () "Return the logged TODO entries for agenda display." @@ -4198,15 +4773,15 @@ the documentation of `org-diary'." (setq clocked (match-string 2 rest))) (setq clocked "-"))) (save-excursion + (setq extra nil) (cond - ((not org-agenda-log-mode-add-notes) (setq extra nil)) + ((not org-agenda-log-mode-add-notes)) (statep (and (looking-at ".*\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") (setq extra (match-string 1)))) (clockp (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") - (setq extra (match-string 1)))) - (t (setq extra nil))) + (setq extra (match-string 1))))) (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) @@ -4248,11 +4823,22 @@ the documentation of `org-diary'." (todayp (org-agenda-todayp date)) ; DATE bound by calendar (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar d2 diff dfrac wdays pos pos1 category tags + suppress-prewarning ee txt head face s todo-state upcomingp donep timestr) (goto-char (point-min)) (while (re-search-forward regexp nil t) + (setq suppress-prewarning nil) (catch :skip (org-agenda-skip) + (when (and org-agenda-skip-deadline-prewarning-if-scheduled + (save-match-data + (string-match org-scheduled-time-regexp + (buffer-substring (point-at-bol) + (point-at-eol))))) + (setq suppress-prewarning + (if (integerp org-agenda-skip-deadline-prewarning-if-scheduled) + org-agenda-skip-deadline-prewarning-if-scheduled + 0))) (setq s (match-string 1) txt nil pos (1- (match-beginning 1)) @@ -4260,7 +4846,10 @@ the documentation of `org-diary'." (match-string 1) d1 'past org-agenda-repeating-timestamp-show-all) diff (- d2 d1) - wdays (org-get-wdays s) + wdays (if suppress-prewarning + (let ((org-deadline-warning-days suppress-prewarning)) + (org-get-wdays s)) + (org-get-wdays s)) dfrac (/ (* 1.0 (- wdays diff)) (max wdays 1)) upcomingp (and todayp (> diff 0))) ;; When to show a deadline in the calendar: @@ -4472,13 +5061,20 @@ FRACTION is what fraction of the head-warning time has passed." (setq tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (match-string 1)) - (setq txt (org-format-agenda-item - (format - (nth (if (= d1 d2) 0 1) - org-agenda-timerange-leaders) - (1+ (- d0 d1)) (1+ (- d2 d1))) - head category tags - (if (= d0 d1) timestr)))) + (let ((remove-re + (if org-agenda-remove-timeranges-from-blocks + (concat + "<" (regexp-quote s1) ".*?>" + "--" + "<" (regexp-quote s2) ".*?>") + nil))) + (setq txt (org-format-agenda-item + (format + (nth (if (= d1 d2) 0 1) + org-agenda-timerange-leaders) + (1+ (- d0 d1)) (1+ (- d2 d1))) + head category tags + timestr nil remove-re)))) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date @@ -4505,6 +5101,14 @@ The flag is set if the currently compiled format contains a `%e'.") (defvar org-prefix-category-max-length nil "Used by `org-compile-prefix-format' to remember the category field width.") +(defun org-agenda-get-category-icon (category) + "Return an image for CATEGORY according to `org-agenda-category-icon-alist'." + (dolist (entry org-agenda-category-icon-alist) + (when (org-string-match-p (car entry) category) + (if (listp (cadr entry)) + (return (cadr entry)) + (return (apply 'create-image (cdr entry))))))) + (defun org-format-agenda-item (extra txt &optional category tags dotime noprefix remove-re habitp) "Format TXT to be inserted into the agenda buffer. @@ -4529,11 +5133,17 @@ Any match of REMOVE-RE will be removed from TXT." org-agenda-show-inherited-tags org-agenda-hide-tags-regexp)) (let* ((category (or category - org-category + (if (stringp org-category) + org-category + (and org-category (symbol-name org-category))) (if buffer-file-name (file-name-sans-extension (file-name-nondirectory buffer-file-name)) ""))) + (category-icon (org-agenda-get-category-icon category)) + (category-icon (if category-icon + (propertize " " 'display category-icon) + "")) ;; time, tag, effort are needed for the eval of the prefix format (tag (if tags (nth (1- (length tags)) tags) "")) time effort neffort @@ -4589,7 +5199,7 @@ Any match of REMOVE-RE will be removed from TXT." (setq h (/ m 60) m (- m (* h 60))) (setq s2 (format "%02d:%02d" h m)))) - (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") + (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) ;; Tags are in the string (if (or (eq org-agenda-remove-tags t) @@ -4619,8 +5229,15 @@ Any match of REMOVE-RE will be removed from TXT." (if noprefix (setq rtn txt) ;; Prepare the variables needed in the eval of the compiled format - (setq time (cond (s2 (concat s1 "-" s2)) - (s1 (concat s1 "......")) + (setq time (cond (s2 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + "-" (org-agenda-time-of-day-to-ampm-maybe s2) + (if org-agenda-timegrid-use-ampm " "))) + (s1 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + (if org-agenda-timegrid-use-ampm + "........ " + "......"))) (t "")) extra (or (and (not habitp) extra) "") category (if (symbolp category) (symbol-name category) category) @@ -4663,18 +5280,18 @@ Any match of REMOVE-RE will be removed from TXT." The modified list may contain inherited tags, and tags matched by `org-agenda-hide-tags-regexp' will be removed." (when (or add-inherited hide-re) - (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") txt) + (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) (setq txt (substring txt 0 (match-beginning 0)))) + (setq tags + (delq nil + (mapcar (lambda (tg) + (if (or (and hide-re (string-match hide-re tg)) + (and (not add-inherited) + (get-text-property 0 'inherited tg))) + nil + tg)) + tags))) (when tags - (setq tags - (delq nil - (mapcar (lambda (tg) - (if (or (and hide-re (string-match hide-re tg)) - (and (not add-inherited) - (get-text-property 0 'inherited tg))) - nil - tg)) - tags))) (let ((have-i (get-text-property 0 'inherited (car tags))) i) (setq txt (concat txt " :" @@ -4719,13 +5336,13 @@ The modified list may contain inherited tags, and tags matched by (throw 'exit list)) (while (setq time (pop gridtimes)) (unless (and remove (member time have)) - (setq time (int-to-string time)) + (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) (push (org-format-agenda-item nil string "" nil (concat (substring time 0 -2) ":" (substring time -2))) new) (put-text-property - 1 (length (car new)) 'face 'org-time-grid (car new)))) + 2 (length (car new)) 'face 'org-time-grid (car new)))) (if (member 'time-up org-agenda-sorting-strategy-selected) (append new list) (append list new))))) @@ -4744,11 +5361,11 @@ The resulting form is returned and stored in the variable (t " %-12:c%?-12t% s"))) (start 0) varform vars var e c f opt) - (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctse]\\)" + (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctsei]\\)" s start) (setq var (cdr (assoc (match-string 4 s) '(("c" . category) ("t" . time) ("s" . extra) - ("T" . tag) ("e" . effort)))) + ("i" . category-icon) ("T" . tag) ("e" . effort)))) c (or (match-string 3 s) "") opt (match-beginning 1) start (1+ (match-beginning 0))) @@ -4805,20 +5422,45 @@ HH:MM." (mod h1 24) h1)) (t0 (+ (* 100 h2) m)) (t1 (concat (if (>= h1 24) "+" " ") + (if (and org-agenda-time-leading-zero + (< t0 1000)) "0" "") (if (< t0 100) "0" "") (if (< t0 10) "0" "") (int-to-string t0)))) (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) +(defvar org-agenda-before-sorting-filter-function nil + "Function to be applied to agenda items prior to sorting. +Prior to sorting also means just before they are inserted into the agenda. + +To aid sorting, you may revisit the original entries and add more text +properties which will later be used by the sorting functions. + +The function should take a string argument, an agenda line. +It has access to the text properties in that line, which contain among +other things, the property `org-hd-marker' that points to the entry +where the line comes from. Note that not all lines going into the agenda +have this property, only most. + +The function should return the modified string. It is probably best +to ONLY change text properties. + +You can also use this function as a filter, by returning nil for lines +you don't want to have in the agenda at all. For this application, you +could bind the variable in the options section of a custom command.") + (defun org-finalize-agenda-entries (list &optional nosort) "Sort and concatenate the agenda items." (setq list (mapcar 'org-agenda-highlight-todo list)) (if nosort list + (when org-agenda-before-sorting-filter-function + (setq list (delq nil (mapcar org-agenda-before-sorting-filter-function list)))) (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))) (defun org-agenda-highlight-todo (x) (let ((org-done-keywords org-done-keywords-for-agenda) + (case-fold-search nil) re pl) (if (eq x 'line) (save-excursion @@ -4841,11 +5483,12 @@ HH:MM." (or (match-end 1) (match-end 0)) (match-end 0) (list 'face (org-get-todo-face (match-string 2 x))) x) - (setq x (concat (substring x 0 (match-end 1)) - (format org-agenda-todo-keyword-format - (match-string 2 x)) - (org-add-props " " (text-properties-at 0 x)) - (substring x (match-end 3))))) + (when (match-end 1) + (setq x (concat (substring x 0 (match-end 1)) + (format org-agenda-todo-keyword-format + (match-string 2 x)) + (org-add-props " " (text-properties-at 0 x)) + (substring x (match-end 3)))))) x))) (defsubst org-cmp-priority (a b) @@ -4896,6 +5539,28 @@ HH:MM." ((< lb la) +1) (t nil)))) +(defsubst org-cmp-alpha (a b) + "Compare the headlines, alphabetically." + (let* ((pla (get-text-property 0 'prefix-length a)) + (plb (get-text-property 0 'prefix-length b)) + (ta (and pla (substring a pla))) + (tb (and plb (substring b plb)))) + (when pla + (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta) + (setq ta (substring ta (match-end 0)))) + (setq ta (downcase ta))) + (when plb + (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "") + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb) + (setq tb (substring tb (match-end 0)))) + (setq tb (downcase tb))) + (cond ((not ta) +1) + ((not tb) -1) + ((string-lessp ta tb) -1) + ((string-lessp tb ta) +1) + (t nil)))) + (defsubst org-cmp-tag (a b) "Compare the string values of the first tags of A and B." (let ((ta (car (last (get-text-property 1 'tags a)))) @@ -4923,27 +5588,42 @@ HH:MM." ((and (not ha) hb) +1) (t nil)))) +(defsubst org-em (x y list) (or (memq x list) (memq y list))) + (defun org-entries-lessp (a b) "Predicate for sorting agenda entries." ;; The following variables will be used when the form is evaluated. ;; So even though the compiler complains, keep them. - (let* ((time-up (org-cmp-time a b)) - (time-down (if time-up (- time-up) nil)) - (priority-up (org-cmp-priority a b)) - (priority-down (if priority-up (- priority-up) nil)) - (effort-up (org-cmp-effort a b)) - (effort-down (if effort-up (- effort-up) nil)) - (category-up (org-cmp-category a b)) - (category-down (if category-up (- category-up) nil)) - (category-keep (if category-up +1 nil)) - (tag-up (org-cmp-tag a b)) - (tag-down (if tag-up (- tag-up) nil)) - (todo-state-up (org-cmp-todo-state a b)) + (let* ((ss org-agenda-sorting-strategy-selected) + (time-up (and (org-em 'time-up 'time-down ss) + (org-cmp-time a b))) + (time-down (if time-up (- time-up) nil)) + (priority-up (and (org-em 'priority-up 'priority-down ss) + (org-cmp-priority a b))) + (priority-down (if priority-up (- priority-up) nil)) + (effort-up (and (org-em 'effort-up 'effort-down ss) + (org-cmp-effort a b))) + (effort-down (if effort-up (- effort-up) nil)) + (category-up (and (or (org-em 'category-up 'category-down ss) + (memq 'category-keep ss)) + (org-cmp-category a b))) + (category-down (if category-up (- category-up) nil)) + (category-keep (if category-up +1 nil)) + (tag-up (and (org-em 'tag-up 'tag-down ss) + (org-cmp-tag a b))) + (tag-down (if tag-up (- tag-up) nil)) + (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) + (org-cmp-todo-state a b))) (todo-state-down (if todo-state-up (- todo-state-up) nil)) - (habit-up (org-cmp-habit-p a b)) - (habit-down (if habit-up (- habit-up) nil)) + (habit-up (and (org-em 'habit-up 'habit-down ss) + (org-cmp-habit-p a b))) + (habit-down (if habit-up (- habit-up) nil)) + (alpha-up (and (org-em 'alpha-up 'alpha-down ss) + (org-cmp-alpha a b))) + (alpha-down (if alpha-up (- alpha-up) nil)) + (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) user-defined-up user-defined-down) - (if (and org-agenda-cmp-user-defined + (if (and need-user-cmp org-agenda-cmp-user-defined (functionp org-agenda-cmp-user-defined)) (setq user-defined-up (funcall org-agenda-cmp-user-defined a b) @@ -4954,12 +5634,12 @@ HH:MM." ;;; Agenda restriction lock -(defvar org-agenda-restriction-lock-overlay (org-make-overlay 1 1) +(defvar org-agenda-restriction-lock-overlay (make-overlay 1 1) "Overlay to mark the headline to which agenda commands are restricted.") -(org-overlay-put org-agenda-restriction-lock-overlay - 'face 'org-agenda-restriction-lock) -(org-overlay-put org-agenda-restriction-lock-overlay - 'help-echo "Agendas are currently limited to this subtree.") +(overlay-put org-agenda-restriction-lock-overlay + 'face 'org-agenda-restriction-lock) +(overlay-put org-agenda-restriction-lock-overlay + 'help-echo "Agendas are currently limited to this subtree.") (org-detach-overlay org-agenda-restriction-lock-overlay) (defun org-agenda-set-restriction-lock (&optional type) @@ -4982,7 +5662,7 @@ in the file. Otherwise, restriction will be to the current subtree." (put 'org-agenda-files 'org-restrict (list (buffer-file-name (buffer-base-buffer)))) (org-back-to-heading t) - (org-move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) + (move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) (move-marker org-agenda-restrict-begin (point)) (move-marker org-agenda-restrict-end (save-excursion (org-end-of-subtree t))) @@ -5071,8 +5751,9 @@ Org-mode buffers visited directly by the user will not be touched." (org-agenda-quit)) (defun org-agenda-execute (arg) - "Execute another agenda command, keeping same window.\\<global-map> -So this is just a shortcut for `\\[org-agenda]', available in the agenda." + "Execute another agenda command, keeping same window. +So this is just a shortcut for \\<global-map>`\\[org-agenda]', available +in the agenda." (interactive "P") (let ((org-agenda-window-setup 'current-window)) (org-agenda arg))) @@ -5084,6 +5765,7 @@ When this is the global TODO list, a prefix argument will be interpreted." (let* ((org-agenda-keep-modes t) (filter org-agenda-filter) (preset (get 'org-agenda-filter :preset-filter)) + (org-agenda-filter-while-redo (or filter preset)) (cols org-agenda-columns-active) (line (org-current-line)) (window-line (- line (org-current-line (window-start)))) @@ -5127,7 +5809,7 @@ to switch to narrowing." (effort-prompt "") (inhibit-read-only t) (current org-agenda-filter) - char a n tag) + a n tag) (unless char (message "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: " @@ -5168,9 +5850,8 @@ to switch to narrowing." (org-agenda-filter-by-tag-show-all) (when org-agenda-auto-exclude-function (setq org-agenda-filter '()) - (dolist (tag org-tag-alist-for-agenda) - (let ((modifier (funcall org-agenda-auto-exclude-function - (car tag)))) + (dolist (tag (org-agenda-get-represented-tags)) + (let ((modifier (funcall org-agenda-auto-exclude-function tag))) (if modifier (push modifier org-agenda-filter)))) (if (not (null org-agenda-filter)) @@ -5197,6 +5878,17 @@ to switch to narrowing." (org-agenda-filter-apply org-agenda-filter)) (t (error "Invalid tag selection character %c" char))))) +(defun org-agenda-get-represented-tags () + "Get a list of all tags currently represented in the agenda." + (let (p tags) + (save-excursion + (goto-char (point-min)) + (while (setq p (next-single-property-change (point) 'tags)) + (goto-char p) + (mapc (lambda (x) (add-to-list 'tags x)) + (get-text-property (point) 'tags)))) + tags)) + (defun org-agenda-filter-by-tag-refine (strip &optional char) "Refine the current filter. See `org-agenda-filter-by-tag." (interactive "P") @@ -5219,7 +5911,7 @@ to switch to narrowing." (defun org-agenda-filter-effort-form (e) "Return the form to compare the effort of the current line with what E says. -E looks line \"+<2:25\"." +E looks like \"+<2:25\"." (let (op) (setq e (substring e 1)) (setq op (string-to-char e) e (substring e 1)) @@ -5254,29 +5946,31 @@ If the line does not have an effort defined, return nil." (if (not (eval org-agenda-filter-form)) (org-agenda-filter-by-tag-hide-line)) (beginning-of-line 2)) - (beginning-of-line 2)))))) + (beginning-of-line 2)))) + (if (get-char-property (point) 'invisible) + (org-agenda-previous-line)))) (defun org-agenda-filter-by-tag-hide-line () (let (ov) - (setq ov (org-make-overlay (max (point-min) (1- (point-at-bol))) + (setq ov (make-overlay (max (point-min) (1- (point-at-bol))) (point-at-eol))) - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'type 'tags-filter) + (overlay-put ov 'invisible t) + (overlay-put ov 'type 'tags-filter) (push ov org-agenda-filter-overlays))) (defun org-agenda-fix-tags-filter-overlays-at (&optional pos) (setq pos (or pos (point))) (save-excursion - (dolist (ov (org-overlays-at pos)) - (when (and (org-overlay-get ov 'invisible) - (eq (org-overlay-get ov 'type) 'tags-filter)) + (dolist (ov (overlays-at pos)) + (when (and (overlay-get ov 'invisible) + (eq (overlay-get ov 'type) 'tags-filter)) (goto-char pos) - (if (< (org-overlay-start ov) (point-at-eol)) - (org-move-overlay ov (point-at-eol) - (org-overlay-end ov))))))) + (if (< (overlay-start ov) (point-at-eol)) + (move-overlay ov (point-at-eol) + (overlay-end ov))))))) (defun org-agenda-filter-by-tag-show-all () - (mapc 'org-delete-overlay org-agenda-filter-overlays) + (mapc 'delete-overlay org-agenda-filter-overlays) (setq org-agenda-filter-overlays nil) (setq org-agenda-filter nil) (setq org-agenda-filter-form nil) @@ -5284,22 +5978,22 @@ If the line does not have an effort defined, return nil." (defun org-agenda-manipulate-query-add () "Manipulate the query by adding a search term with positive selection. -Positive selection means, the term must be matched for selection of an entry." +Positive selection means the term must be matched for selection of an entry." (interactive) (org-agenda-manipulate-query ?\[)) (defun org-agenda-manipulate-query-subtract () "Manipulate the query by adding a search term with negative selection. -Negative selection means, term must not be matched for selection of an entry." +Negative selection means term must not be matched for selection of an entry." (interactive) (org-agenda-manipulate-query ?\])) (defun org-agenda-manipulate-query-add-re () "Manipulate the query by adding a search regexp with positive selection. -Positive selection means, the regexp must match for selection of an entry." +Positive selection means the regexp must match for selection of an entry." (interactive) (org-agenda-manipulate-query ?\{)) (defun org-agenda-manipulate-query-subtract-re () "Manipulate the query by adding a search regexp with negative selection. -Negative selection means, regexp must not match for selection of an entry." +Negative selection means regexp must not match for selection of an entry." (interactive) (org-agenda-manipulate-query ?\})) (defun org-agenda-manipulate-query (char) @@ -5311,8 +6005,10 @@ Negative selection means, regexp must not match for selection of an entry." ((eq org-agenda-type 'search) (org-add-to-string 'org-agenda-query-string - (cdr (assoc char '((?\[ . " +") (?\] . " -") - (?\{ . " +{}") (?\} . " -{}"))))) + (if org-agenda-last-search-view-search-was-boolean + (cdr (assoc char '((?\[ . " +") (?\] . " -") + (?\{ . " +{}") (?\} . " -{}")))) + " ")) (setq org-agenda-redo-command (list 'org-search-view org-todo-only @@ -5329,7 +6025,9 @@ Negative selection means, regexp must not match for selection of an entry." (defun org-agenda-goto-date (date) "Jump to DATE in agenda." - (interactive (list (org-read-date))) + (interactive (list (let ((org-read-date-prefer-future + (eval org-agenda-jump-prefer-future))) + (org-read-date)))) (org-agenda-list nil date)) (defun org-agenda-goto-today () @@ -5340,13 +6038,10 @@ Negative selection means, regexp must not match for selection of an entry." (cond (tdpos (goto-char tdpos)) ((eq org-agenda-type 'agenda) - (let* ((sd (time-to-days - (time-subtract (current-time) - (list 0 (* 3600 org-extend-today-until) 0)))) - (comp (org-agenda-compute-time-span sd org-agenda-span)) + (let* ((sd (org-agenda-compute-starting-span + (org-today) (or org-agenda-ndays org-agenda-span))) (org-agenda-overriding-arguments org-agenda-last-arguments)) - (setf (nth 1 org-agenda-overriding-arguments) (car comp)) - (setf (nth 2 org-agenda-overriding-arguments) (cdr comp)) + (setf (nth 1 org-agenda-overriding-arguments) sd) (org-agenda-redo) (org-agenda-find-same-or-today-or-agenda))) (t (error "Cannot find today"))))) @@ -5363,28 +6058,28 @@ Negative selection means, regexp must not match for selection of an entry." With prefix ARG, go forward that many times the current span." (interactive "p") (org-agenda-check-type t 'agenda) - (let* ((span org-agenda-span) + (let* ((span org-agenda-current-span) (sd org-starting-day) (greg (calendar-gregorian-from-absolute sd)) (cnt (org-get-at-bol 'org-day-cnt)) - greg2 nd) + greg2) (cond ((eq span 'day) - (setq sd (+ arg sd) nd 1)) + (setq sd (+ arg sd))) ((eq span 'week) - (setq sd (+ (* 7 arg) sd) nd 7)) + (setq sd (+ (* 7 arg) sd))) ((eq span 'month) (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) sd (calendar-absolute-from-gregorian greg2)) - (setcar greg2 (1+ (car greg2))) - (setq nd (- (calendar-absolute-from-gregorian greg2) sd))) + (setcar greg2 (1+ (car greg2)))) ((eq span 'year) (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) sd (calendar-absolute-from-gregorian greg2)) - (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))) - (setq nd (- (calendar-absolute-from-gregorian greg2) sd)))) + (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))) + (t + (setq sd (+ (* span arg) sd)))) (let ((org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) sd nd t))) + (list (car org-agenda-last-arguments) sd span t))) (org-agenda-redo) (org-agenda-find-same-or-today-or-agenda cnt)))) @@ -5397,8 +6092,9 @@ With prefix ARG, go backward that many times the current span." (defun org-agenda-view-mode-dispatch () "Call one of the view mode commands." (interactive) - (message "View: [d]ay [w]eek [m]onth [y]ear [l]og [L]og-all [a]rch-trees [A]rch-files - clock[R]eport time[G]rid [[]inactive [E]ntryText include[D]iary") + (message "View: [d]ay [w]eek [m]onth [y]ear [q]uit/abort + time[G]rid [[]inactive [f]ollow [l]og [L]og-all [E]ntryText + [a]rch-trees [A]rch-files clock[R]eport include[D]iary") (let ((a (read-char-exclusive))) (case a (?d (call-interactively 'org-agenda-day-view)) @@ -5406,6 +6102,7 @@ With prefix ARG, go backward that many times the current span." (?m (call-interactively 'org-agenda-month-view)) (?y (call-interactively 'org-agenda-year-view)) (?l (call-interactively 'org-agenda-log-mode)) + (?L (org-agenda-log-mode '(4))) ((?F ?f) (call-interactively 'org-agenda-follow-mode)) (?a (call-interactively 'org-agenda-archives-mode)) (?A (org-agenda-archives-mode 'files)) @@ -5413,6 +6110,7 @@ With prefix ARG, go backward that many times the current span." ((?E ?e) (call-interactively 'org-agenda-entry-text-mode)) (?G (call-interactively 'org-agenda-toggle-time-grid)) (?D (call-interactively 'org-agenda-toggle-diary)) + (?\! (call-interactively 'org-agenda-toggle-deadlines)) (?\[ (let ((org-agenda-include-inactive-timestamps t)) (org-agenda-check-type t 'timeline 'agenda) (org-agenda-redo)) @@ -5424,7 +6122,6 @@ With prefix ARG, go backward that many times the current span." "Switch to daily view for agenda. With argument DAY-OF-YEAR, switch to that day of the year." (interactive "P") - (setq org-agenda-ndays 1) (org-agenda-change-time-span 'day day-of-year)) (defun org-agenda-week-view (&optional iso-week) "Switch to daily view for agenda. @@ -5434,7 +6131,6 @@ week. Any digits before this encode a year. So 200712 means week 12 of year 2007. Years in the range 1938-2037 can also be written as 2-digit years." (interactive "P") - (setq org-agenda-ndays 7) (org-agenda-change-time-span 'week iso-week)) (defun org-agenda-month-view (&optional month) "Switch to monthly view for agenda. @@ -5459,70 +6155,61 @@ written as 2-digit years." "Change the agenda view to SPAN. SPAN may be `day', `week', `month', `year'." (org-agenda-check-type t 'agenda) - (if (and (not n) (equal org-agenda-span span)) + (if (and (not n) (equal org-agenda-current-span span)) (error "Viewing span is already \"%s\"" span)) (let* ((sd (or (org-get-at-bol 'day) org-starting-day)) - (computed (org-agenda-compute-time-span sd span n)) + (sd (org-agenda-compute-starting-span sd span n)) (org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) - (car computed) (cdr computed) t))) + (list (car org-agenda-last-arguments) sd span t))) (org-agenda-redo) (org-agenda-find-same-or-today-or-agenda)) (org-agenda-set-mode-name) (message "Switched to %s view" span)) -(defun org-agenda-compute-time-span (sd span &optional n) - "Compute starting date and number of days for agenda. +(defun org-agenda-compute-starting-span (sd span &optional n) + "Compute starting date for agenda. SPAN may be `day', `week', `month', `year'. The return value is a cons cell with the starting date and the number of days, so that the date SD will be in that range." (let* ((greg (calendar-gregorian-from-absolute sd)) (dg (nth 1 greg)) (mg (car greg)) - (yg (nth 2 greg)) - nd w1 y1 m1 thisweek) + (yg (nth 2 greg))) (cond ((eq span 'day) (when n (setq sd (+ (calendar-absolute-from-gregorian (list mg 1 yg)) - n -1))) - (setq nd 1)) + n -1)))) ((eq span 'week) (let* ((nt (calendar-day-of-week (calendar-gregorian-from-absolute sd))) (d (if org-agenda-start-on-weekday (- nt org-agenda-start-on-weekday) - 0))) + 0)) + y1) (setq sd (- sd (+ (if (< d 0) 7 0) d))) (when n (require 'cal-iso) - (setq thisweek (car (calendar-iso-from-absolute sd))) (when (> n 99) (setq y1 (org-small-year-to-year (/ n 100)) n (mod n 100))) (setq sd (calendar-absolute-from-iso (list n 1 - (or y1 (nth 2 (calendar-iso-from-absolute sd))))))) - (setq nd 7))) + (or y1 (nth 2 (calendar-iso-from-absolute sd))))))))) ((eq span 'month) - (when (and n (> n 99)) - (setq y1 (org-small-year-to-year (/ n 100)) - n (mod n 100))) - (setq sd (calendar-absolute-from-gregorian - (list (or n mg) 1 (or y1 yg))) - nd (- (calendar-absolute-from-gregorian - (list (1+ (or n mg)) 1 (or y1 yg))) - sd))) + (let (y1) + (when (and n (> n 99)) + (setq y1 (org-small-year-to-year (/ n 100)) + n (mod n 100))) + (setq sd (calendar-absolute-from-gregorian + (list (or n mg) 1 (or y1 yg)))))) ((eq span 'year) (setq sd (calendar-absolute-from-gregorian - (list 1 1 (or n yg))) - nd (- (calendar-absolute-from-gregorian - (list 1 1 (1+ (or n yg)))) - sd)))) - (cons sd nd))) + (list 1 1 (or n yg)))))) + sd)) (defun org-agenda-next-date-line (&optional arg) "Jump to the next line indicating a date in agenda buffer." @@ -5546,17 +6233,16 @@ so that the date SD will be in that range." (error "No previous date before this line in this buffer"))) ;; Initialize the highlight -(defvar org-hl (org-make-overlay 1 1)) -(org-overlay-put org-hl 'face 'highlight) +(defvar org-hl (make-overlay 1 1)) +(overlay-put org-hl 'face 'highlight) (defun org-highlight (begin end &optional buffer) "Highlight a region with overlay." - (funcall (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay) - org-hl begin end (or buffer (current-buffer)))) + (move-overlay org-hl begin end (or buffer (current-buffer)))) (defun org-unhighlight () "Detach overlay INDEX." - (funcall (if (featurep 'xemacs) 'detach-extent 'delete-overlay) org-hl)) + (org-detach-overlay org-hl)) ;; FIXME this is currently not used. (defun org-highlight-until-next-command (beg end &optional buffer) @@ -5581,9 +6267,8 @@ so that the date SD will be in that range." (defun org-agenda-entry-text-mode (&optional arg) "Toggle entry text mode in an agenda buffer." (interactive "P") - (if (integerp arg) - (setq org-agenda-entry-text-mode t) - (setq org-agenda-entry-text-mode (not org-agenda-entry-text-mode))) + (setq org-agenda-entry-text-mode (or (integerp arg) + (not org-agenda-entry-text-mode))) (org-agenda-entry-text-hide) (and org-agenda-entry-text-mode (let ((org-agenda-entry-text-maxlines @@ -5594,11 +6279,15 @@ so that the date SD will be in that range." (if org-agenda-entry-text-mode "on" "off") (if (integerp arg) arg org-agenda-entry-text-maxlines))) -(defun org-agenda-clockreport-mode () - "Toggle clocktable mode in an agenda buffer." - (interactive) +(defun org-agenda-clockreport-mode (&optional with-filter) + "Toggle clocktable mode in an agenda buffer. +With prefix arg WITH-FILTER, make the clocktable respect the current +agenda filter." + (interactive "P") (org-agenda-check-type t 'agenda) - (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)) + (if with-filter + (setq org-agenda-clockreport-mode 'with-filter) + (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))) (org-agenda-set-mode-name) (org-agenda-redo) (message "Clocktable mode is %s" @@ -5650,6 +6339,16 @@ When called with a prefix argument, include all archive files as well." (message "Diary inclusion turned %s" (if org-agenda-include-diary "on" "off"))) +(defun org-agenda-toggle-deadlines () + "Toggle inclusion of entries with a deadline in an agenda buffer." + (interactive) + (org-agenda-check-type t 'agenda) + (setq org-agenda-include-deadlines (not org-agenda-include-deadlines)) + (org-agenda-redo) + (org-agenda-set-mode-name) + (message "Deadlines inclusion turned %s" + (if org-agenda-include-deadlines "on" "off"))) + (defun org-agenda-toggle-time-grid () "Toggle time grid in an agenda buffer." (interactive) @@ -5663,31 +6362,36 @@ When called with a prefix argument, include all archive files as well." (defun org-agenda-set-mode-name () "Set the mode name to indicate all the small mode settings." (setq mode-name - (concat "Org-Agenda" - (if (equal org-agenda-ndays 1) " Day" "") - (if (equal org-agenda-ndays 7) " Week" "") - (if org-agenda-follow-mode " Follow" "") - (if org-agenda-entry-text-mode " ETxt" "") - (if org-agenda-include-diary " Diary" "") - (if org-agenda-use-time-grid " Grid" "") - (if (and (boundp 'org-habit-show-habits) - org-habit-show-habits) " Habit" "") - (if (consp org-agenda-show-log) " LogAll" - (if org-agenda-show-log " Log" "")) - (if (or org-agenda-filter (get 'org-agenda-filter - :preset-filter)) - (concat " {" (mapconcat - 'identity - (append (get 'org-agenda-filter - :preset-filter) - org-agenda-filter) "") "}") - "") - (if org-agenda-archives-mode - (if (eq org-agenda-archives-mode t) - " Archives" - (format " :%s:" org-archive-tag)) - "") - (if org-agenda-clockreport-mode " Clock" ""))) + (list "Org-Agenda" + (if (get 'org-agenda-files 'org-restrict) " []" "") + " " + '(:eval (org-agenda-span-name org-agenda-current-span)) + (if org-agenda-follow-mode " Follow" "") + (if org-agenda-entry-text-mode " ETxt" "") + (if org-agenda-include-diary " Diary" "") + (if org-agenda-include-deadlines " Ddl" "") + (if org-agenda-use-time-grid " Grid" "") + (if (and (boundp 'org-habit-show-habits) + org-habit-show-habits) " Habit" "") + (if (consp org-agenda-show-log) " LogAll" + (if org-agenda-show-log " Log" "")) + (if (or org-agenda-filter (get 'org-agenda-filter + :preset-filter)) + (concat " {" (mapconcat + 'identity + (append (get 'org-agenda-filter + :preset-filter) + org-agenda-filter) "") "}") + "") + (if org-agenda-archives-mode + (if (eq org-agenda-archives-mode t) + " Archives" + (format " :%s:" org-archive-tag)) + "") + (if org-agenda-clockreport-mode + (if (eq org-agenda-clockreport-mode 'with-filter) + " Clock{}" " Clock") + ""))) (force-mode-line-update)) (defun org-agenda-post-command-hook () @@ -5697,20 +6401,19 @@ When called with a prefix argument, include all archive files as well." 'org-agenda-type)))) (defun org-agenda-next-line () - "Move cursor to the next line, and show if follow-mode is active." + "Move cursor to the next line, and show if follow mode is active." (interactive) (call-interactively 'next-line) (org-agenda-do-context-action)) (defun org-agenda-previous-line () "Move cursor to the previous line, and show if follow-mode is active." - (interactive) (call-interactively 'previous-line) (org-agenda-do-context-action)) (defun org-agenda-do-context-action () - "Show outline path and, maybe, follow-mode window." + "Show outline path and, maybe, follow mode window." (let ((m (org-get-at-bol 'org-marker))) (if (and org-agenda-follow-mode m) (org-agenda-show)) @@ -5744,6 +6447,7 @@ and by additional input from the age of a schedules or deadline entry." (pos (marker-position marker))) (switch-to-buffer-other-window buffer) (widen) + (push-mark) (goto-char pos) (when (org-mode-p) (org-show-context 'agenda) @@ -5860,7 +6564,7 @@ If this information is not given, the function uses the tree at point." (delete-region (point-at-bol) (1+ (point-at-eol))))) (beginning-of-line 0)))))) -(defun org-agenda-refile (&optional goto rfloc) +(defun org-agenda-refile (&optional goto rfloc no-update) "Refile the item at point." (interactive "P") (if (equal goto '(16)) @@ -5879,7 +6583,8 @@ If this information is not given, the function uses the tree at point." (widen) (goto-char marker) (org-remove-subtree-entries-from-agenda) - (org-refile goto buffer rfloc))))))) + (org-refile goto buffer rfloc))))) + (unless no-update (org-agenda-redo)))) (defun org-agenda-open-link (&optional arg) "Follow the link in the current line, if any. @@ -6089,8 +6794,8 @@ docstring of `org-agenda-show-1'." This calls the command `org-tree-to-indirect-buffer' from the original Org-mode buffer. With numerical prefix arg ARG, go up to this level and then take that tree. -With a C-u prefix, make a separate frame for this tree (i.e. don't use the -dedicated frame)." +With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't +use the dedicated frame)." (interactive) (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) @@ -6128,8 +6833,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (buffer (marker-buffer marker)) (pos (marker-position marker)) (hdmarker (org-get-at-bol 'org-hd-marker)) - (todayp (equal (org-get-at-bol 'day) - (time-to-days (current-time)))) + (todayp (org-agenda-todayp (org-get-at-bol 'day))) (inhibit-read-only t) org-agenda-headline-snapshot-before-repeat newhead just-one) (org-with-remote-undo buffer @@ -6238,7 +6942,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (let ((inhibit-read-only t) l c) (save-excursion (goto-char (if line (point-at-bol) (point-min))) - (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") + (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") (if line (point-at-eol) nil) t) (add-text-properties (match-beginning 2) (match-end 2) @@ -6256,7 +6960,8 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (goto-char (match-beginning 1)) (insert (org-add-props (make-string (max 1 (- c (current-column))) ?\ ) - (text-properties-at (point))))) + (plist-put (copy-sequence (text-properties-at (point))) + 'face nil)))) (goto-char (point-min)) (org-font-lock-add-tag-faces (point-max))))) @@ -6523,14 +7228,15 @@ be used to request time specification in the time stamp." (with-current-buffer buffer (widen) (goto-char pos) - (if (not (org-at-timestamp-p)) + (if (not (org-at-timestamp-p t)) (error "Cannot find time stamp")) - (org-time-stamp arg)) + (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) (org-agenda-show-new-time marker org-last-changed-timestamp)) (message "Time stamp changed to %s" org-last-changed-timestamp))) (defun org-agenda-schedule (arg) - "Schedule the item at point." + "Schedule the item at point. +Arg is passed through to `org-schedule'." (interactive "P") (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) (org-agenda-check-no-diary) @@ -6551,7 +7257,8 @@ be used to request time specification in the time stamp." (message "Item scheduled for %s" ts))) (defun org-agenda-deadline (arg) - "Schedule the item at point." + "Schedule the item at point. +Arg is passed through to `org-deadline'." (interactive "P") (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) (org-agenda-check-no-diary) @@ -6577,13 +7284,14 @@ m Mark the entry at point for an agenda action s Schedule the marked entry to the date at the cursor d Set the deadline of the marked entry to the date at the cursor r Call `org-remember' with cursor date as the default date +c Call `org-capture' with cursor date as the default date SPC Show marked entry in other window TAB Visit marked entry in other window The cursor may be at a date in the calendar, or in the Org agenda." (interactive) (let (ans) - (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [ ]show") + (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [c]apture [ ]show") (setq ans (read-char-exclusive)) (cond ((equal ans ?m) @@ -6604,6 +7312,8 @@ The cursor may be at a date in the calendar, or in the Org agenda." (org-agenda-do-action '(org-deadline nil org-overriding-default-time))) ((equal ans ?r) (org-agenda-do-action '(org-remember) t)) + ((equal ans ?c) + (org-agenda-do-action '(org-capture) t)) ((equal ans ?\ ) (let ((cw (selected-window))) (org-switch-to-buffer-other-window @@ -6655,9 +7365,9 @@ The cursor may be at a date in the calendar, or in the Org agenda." (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead hdmarker))))) -(defun org-agenda-clock-out (&optional arg) +(defun org-agenda-clock-out () "Stop the currently running clock." - (interactive "P") + (interactive) (unless (marker-buffer org-clock-marker) (error "No running clock")) (let ((marker (make-marker)) newhead) @@ -6682,6 +7392,23 @@ The cursor may be at a date in the calendar, or in the Org agenda." (org-with-remote-undo (marker-buffer org-clock-marker) (org-clock-cancel))) +(defun org-agenda-clock-goto () + "Jump to the currently clocked in task within the agenda. +If the currently clocked in task is not listed in the agenda +buffer, display it in another window." + (interactive) + (let (pos) + (mapc (lambda (o) + (if (eq (overlay-get o 'type) 'org-agenda-clocking) + (setq pos (overlay-start o)))) + (overlays-in (point-min) (point-max))) + (cond (pos (goto-char pos)) + ;; If the currently clocked entry is not in the agenda + ;; buffer, we visit it in another window: + (org-clock-current-task + (org-switch-to-buffer-other-window (org-clock-goto))) + (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) + (defun org-agenda-diary-entry-in-org-file () "Make a diary entry in the file `org-agenda-diary-file'." (let (d1 d2 char (text "") dp1 dp2) @@ -6719,6 +7446,7 @@ The cursor may be at a date in the calendar, or in the Org agenda." ((equal char ?j) (org-switch-to-buffer-other-window (find-file-noselect org-agenda-diary-file)) + (require 'org-datetree) (org-datetree-find-date-create d1) (org-reveal t)) (t (error "Invalid selection character `%c'" char))))) @@ -6734,6 +7462,11 @@ top-level as top-level entries at the end of the file." (const :tag "in a date tree" date-tree) (const :tag "as top level at end of file" top-level))) +(defcustom org-agenda-insert-diary-extract-time nil + "Non-nil means extract any time specification from the diary entry." + :group 'org-agenda + :type 'boolean) + (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) "Add a diary entry with TYPE to `org-agenda-diary-file'. If TEXT is not empty, it will become the headline of the new entry, and @@ -6761,20 +7494,38 @@ the resulting entry will not be shown. When TEXT is empty, switch to (let ((calendar-date-display-form (if (if (boundp 'calendar-date-style) (eq calendar-date-style 'european) - european-calendar-style) ; Emacs 22 + (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1 + (org-bound-and-true-p european-calendar-style))) ; Emacs 22 '(day " " month " " year) '(month " " day " " year)))) (insert (format "%%%%(diary-anniversary %s) %s" (calendar-date-string d1 nil t) text)))) ((eq type 'day) - (if (eq org-agenda-insert-diary-strategy 'top-level) - (org-agenda-insert-diary-as-top-level text) - (require 'org-datetree) - (org-datetree-find-date-create d1) - (org-agenda-insert-diary-make-new-entry text)) - (org-insert-time-stamp (org-time-from-absolute - (calendar-absolute-from-gregorian d1))) + (let ((org-prefix-has-time t) + (org-agenda-time-leading-zero t) + fmt time time2) + (if org-agenda-insert-diary-extract-time + ;; Use org-format-agenda-item to parse text for a time-range and + ;; remove it. FIXME: This is a hack, we should refactor + ;; that function to make time extraction available separately + (setq fmt (org-format-agenda-item nil text nil nil t) + time (get-text-property 0 'time fmt) + time2 (if (> (length time) 0) + ;; split-string removes trailing ...... if + ;; no end time given. First space + ;; separates time from date. + (concat " " (car (split-string time "\\."))) + nil) + text (get-text-property 0 'txt fmt))) + (if (eq org-agenda-insert-diary-strategy 'top-level) + (org-agenda-insert-diary-as-top-level text) + (require 'org-datetree) + (org-datetree-find-date-create d1) + (org-agenda-insert-diary-make-new-entry text)) + (org-insert-time-stamp (org-time-from-absolute + (calendar-absolute-from-gregorian d1)) + nil nil nil nil time2)) (end-of-line 0)) ((eq type 'block) (if (> (calendar-absolute-from-gregorian d1) @@ -6823,7 +7574,7 @@ a timestamp can be added there." (org-back-over-empty-lines) (or (looking-at "[ \t]*$") (progn (insert "\n") (backward-char 1))) - (org-insert-heading) + (org-insert-heading nil t) (org-do-demote) (setq col (current-column)) (insert text "\n") @@ -6940,9 +7691,7 @@ argument, latitude and longitude will be prompted for." (date (calendar-gregorian-from-absolute day)) (calendar-move-hook nil) (calendar-view-holidays-initially-flag nil) - (calendar-view-diary-initially-flag nil) - (view-calendar-holidays-initially nil) - (view-diary-entries-initially nil)) + (calendar-view-diary-initially-flag nil)) (calendar) (calendar-goto-date date))) @@ -6992,23 +7741,26 @@ This is a command that has to be installed in `calendar-mode-map'." (eq (get-char-property (point-at-bol) 'type) 'org-marked-entry-overlay)) -(defun org-agenda-bulk-mark () +(defun org-agenda-bulk-mark (&optional arg) "Mark the entry at point for future bulk action." - (interactive) - (org-agenda-check-no-diary) - (let* ((m (org-get-at-bol 'org-hd-marker)) - ov) - (unless (org-agenda-bulk-marked-p) - (unless m (error "Nothing to mark at point")) - (push m org-agenda-bulk-marked-entries) - (setq ov (org-make-overlay (point-at-bol) (+ 2 (point-at-bol)))) - (org-overlay-display ov "> " - (org-get-todo-face "TODO") - 'evaporate) - (org-overlay-put ov 'type 'org-marked-entry-overlay)) - (beginning-of-line 2) - (message "%d entries marked for bulk action" - (length org-agenda-bulk-marked-entries)))) + (interactive "p") + (dotimes (i (max arg 1)) + (unless (org-get-at-bol 'org-agenda-diary-link) + (let* ((m (org-get-at-bol 'org-hd-marker)) + ov) + (unless (org-agenda-bulk-marked-p) + (unless m (error "Nothing to mark at point")) + (push m org-agenda-bulk-marked-entries) + (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) + (org-overlay-display ov "> " + (org-get-todo-face "TODO") + 'evaporate) + (overlay-put ov 'type 'org-marked-entry-overlay)) + (beginning-of-line 2) + (while (and (get-char-property (point) 'invisible) (not (eobp))) + (beginning-of-line 2)) + (message "%d entries marked for bulk action" + (length org-agenda-bulk-marked-entries)))))) (defun org-agenda-bulk-unmark () "Unmark the entry at point for future bulk action." @@ -7020,6 +7772,8 @@ This is a command that has to be installed in `calendar-mode-map'." (delete (org-get-at-bol 'org-hd-marker) org-agenda-bulk-marked-entries))) (beginning-of-line 2) + (while (and (get-char-property (point) 'invisible) (not (eobp))) + (beginning-of-line 2)) (message "%d entries marked for bulk action" (length org-agenda-bulk-marked-entries))) @@ -7038,9 +7792,9 @@ This only removes the overlays, it does not remove the markers from the list in `org-agenda-bulk-marked-entries'." (interactive) (mapc (lambda (ov) - (and (eq (org-overlay-get ov 'type) 'org-marked-entry-overlay) - (org-delete-overlay ov))) - (org-overlays-in (or beg (point-min)) (or end (point-max))))) + (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay) + (delete-overlay ov))) + (overlays-in (or beg (point-min)) (or end (point-max))))) (defun org-agenda-bulk-remove-all-marks () "Remove all marks in the agenda buffer. @@ -7050,14 +7804,17 @@ This will remove the markers, and the overlays." (setq org-agenda-bulk-marked-entries nil) (org-agenda-bulk-remove-overlays (point-min) (point-max))) -(defun org-agenda-bulk-action () - "Execute an remote-editing action on all marked entries." - (interactive) +(defun org-agenda-bulk-action (&optional arg) + "Execute an remote-editing action on all marked entries. +The prefix arg is passed through to the command if possible." + (interactive "P") (unless org-agenda-bulk-marked-entries (error "No entries are marked")) - (message "Bulk: [r]efile [$]archive [A]rch->sib [t]odo [+/-]tag [s]chedule [d]eadline") + (message "Bulk: [r]efile [$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [S]catter [d]eadline") (let* ((action (read-char-exclusive)) + (org-log-refile (if org-log-refile 'time nil)) (entries (reverse org-agenda-bulk-marked-entries)) + redo-at-end cmd rfloc state e tag pos (cnt 0) (cntskip 0)) (cond ((equal action ?$) @@ -7071,13 +7828,15 @@ This will remove the markers, and the overlays." "Refile to: " (marker-buffer (car org-agenda-bulk-marked-entries)) org-refile-allow-creating-parent-nodes)) - (setcar (nthcdr 3 rfloc) - (move-marker (make-marker) (nth 3 rfloc) - (or (get-file-buffer (nth 1 rfloc)) - (find-buffer-visiting (nth 1 rfloc)) - (error "This should not happen")))) + (if (nth 3 rfloc) + (setcar (nthcdr 3 rfloc) + (move-marker (make-marker) (nth 3 rfloc) + (or (get-file-buffer (nth 1 rfloc)) + (find-buffer-visiting (nth 1 rfloc)) + (error "This should not happen"))))) - (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc)))) + (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t) + redo-at-end t)) ((equal action ?t) (setq state (org-icompleting-read @@ -7098,20 +7857,44 @@ This will remove the markers, and the overlays." (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) ((memq action '(?s ?d)) - (let* ((date (org-read-date - nil nil nil - (if (eq action ?s) "(Re)Schedule to" "Set Deadline to"))) - (ans org-read-date-final-answer) + (let* ((date (unless arg + (org-read-date + nil nil nil + (if (eq action ?s) "(Re)Schedule to" "Set Deadline to")))) + (ans (if arg nil org-read-date-final-answer)) (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) (setq cmd `(let* ((bound (fboundp 'read-string)) (old (and bound (symbol-function 'read-string)))) (unwind-protect (progn (fset 'read-string (lambda (&rest ignore) ,ans)) - (call-interactively ',c1)) + (eval '(,c1 arg))) (if bound (fset 'read-string old) (fmakunbound 'read-string))))))) + + ((eq action '?S) + (let ((days (read-number + (format "Scatter tasks across how many %sdays: " + (if arg "week" "")) 7))) + (setq cmd + `(let ((distance (random ,(1+ days)))) + (if arg + (let ((dist distance) + (day-of-week + (calendar-day-of-week + (calendar-gregorian-from-absolute (org-today))))) + (dotimes (i (1+ dist)) + (while (member day-of-week org-agenda-weekend-days) + (incf distance) + (incf day-of-week) + (if (= day-of-week 7) + (setq day-of-week 0))) + (incf day-of-week) + (if (= day-of-week 7) + (setq day-of-week 0))))) + (org-agenda-date-later distance))))) + (t (error "Invalid bulk action"))) ;; Sort the markers, to make sure that parents are handled before children @@ -7137,6 +7920,7 @@ This will remove the markers, and the overlays." (setq cnt (1+ cnt)))) (setq org-agenda-bulk-marked-entries nil) (org-agenda-bulk-remove-all-marks) + (when redo-at-end (org-agenda-redo)) (message "Acted on %d entries%s" cnt (if (= cntskip 0) @@ -7216,13 +8000,15 @@ either 'headline or 'category. For example: will only add headlines containing IMPORTANT or headlines belonging to the \"Work\" category." (interactive "P") - (require 'calendar) (if refresh (setq appt-time-msg-list nil)) (if (eq filter t) (setq filter (read-from-minibuffer "Regexp filter: "))) (let* ((cnt 0) ; count added events (org-agenda-new-buffers nil) (org-deadline-warning-days 0) + ;; Do not use `org-today' here because appt only takes + ;; time and without date as argument, so it may pass wrong + ;; information otherwise (today (org-date-to-gregorian (time-to-days (current-time)))) (org-agenda-restrict nil) @@ -7265,14 +8051,10 @@ belonging to the \"Work\" category." (defun org-agenda-todayp (date) "Does DATE mean today, when considering `org-extend-today-until'?" - (let (today h) - (if (listp date) (setq date (calendar-absolute-from-gregorian date))) - (setq today (calendar-absolute-from-gregorian (calendar-current-date))) - (setq h (nth 2 (decode-time (current-time)))) - (or (and (>= h org-extend-today-until) - (= date today)) - (and (< h org-extend-today-until) - (= date (1- today)))))) + (let ((today (org-today)) + (date (if (and date (listp date)) (calendar-absolute-from-gregorian date) + date))) + (eq date today))) (provide 'org-agenda) diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index 81226b2809a..ae52df65bdd 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -40,7 +40,12 @@ :type '(choice (const org-archive-subtree) (const org-archive-to-archive-sibling) - (const org-archive-set-tag))) + (const org-archive-set-tag))) + +(defcustom org-archive-reversed-order nil + "Non-nil means make the tree first child under the archive heading, not last." + :group 'org-archive + :type 'boolean) (defcustom org-archive-sibling-heading "Archive" "Name of the local archive sibling that is used to archive entries locally. @@ -50,7 +55,7 @@ See `org-archive-to-archive-sibling' for more information." :type 'string) (defcustom org-archive-mark-done nil - "Non-nil means, mark entries as DONE when they are moved to the archive file. + "Non-nil means mark entries as DONE when they are moved to the archive file. This can be a string to set the keyword to use. When t, Org-mode will use the first keyword in its list that means done." :group 'org-archive @@ -60,7 +65,7 @@ use the first keyword in its list that means done." (string :tag "Use this keyword"))) (defcustom org-archive-stamp-time t - "Non-nil means, add a time stamp to entries moved to an archive file. + "Non-nil means add a time stamp to entries moved to an archive file. This variable is obsolete and has no effect anymore, instead add or remove `time' from the variable `org-archive-save-context-info'." :group 'org-archive @@ -110,7 +115,7 @@ information." ((or (re-search-backward re nil t) (re-search-forward re nil t)) (match-string 1)) - (t org-archive-location (match-string 1))))))) + (t org-archive-location)))))) (defun org-add-archive-files (files) "Splice the archive files into the list of files. @@ -263,7 +268,7 @@ this heading." (progn (if (re-search-forward (concat "^" (regexp-quote heading) - (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) + (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")) nil t) (goto-char (match-end 0)) ;; Heading not found, just insert it at the end @@ -273,7 +278,11 @@ this heading." (end-of-line 0)) ;; Make the subtree visible (show-subtree) - (org-end-of-subtree t) + (if org-archive-reversed-order + (progn + (org-back-to-heading t) + (outline-next-heading)) + (org-end-of-subtree t)) (skip-chars-backward " \t\r\n") (and (looking-at "[ \t\r\n]*") (replace-match "\n\n"))) @@ -355,7 +364,9 @@ sibling does not exist, it will be created at the end of the subtree." (beginning-of-line 0) (org-toggle-tag org-archive-tag 'on)) (beginning-of-line 1) - (org-end-of-subtree t t) + (if org-archive-reversed-order + (outline-next-heading) + (org-end-of-subtree t t)) (save-excursion (goto-char pos) (let ((this-command this-command)) (org-cut-subtree))) @@ -389,7 +400,8 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." (progn (setq re1 (concat "^" (regexp-quote (make-string - (1+ (- (match-end 0) (match-beginning 0) 1)) + (+ (- (match-end 0) (match-beginning 0) 1) + (if org-odd-levels-only 2 1)) ?*)) " ")) (move-marker begm (point)) diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el index edf2eb37982..7de895eb93e 100644 --- a/lisp/org/org-ascii.el +++ b/lisp/org/org-ascii.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -26,7 +26,10 @@ ;; ;;; Commentary: +;;; Code: + (require 'org-exp) + (eval-when-compile (require 'cl)) @@ -52,19 +55,34 @@ Org-mode file." :type '(repeat character)) (defcustom org-export-ascii-links-to-notes t - "Non-nil means, convert links to notes before the next headline. + "Non-nil means convert links to notes before the next headline. When nil, the link will be exported in place. If the line becomes long in this way, it will be wrapped." :group 'org-export-ascii :type 'boolean) (defcustom org-export-ascii-table-keep-all-vertical-lines nil - "Non-nil means, keep all vertical lines in ASCII tables. + "Non-nil means keep all vertical lines in ASCII tables. When nil, vertical lines will be removed except for those needed for column grouping." :group 'org-export-ascii :type 'boolean) +(defcustom org-export-ascii-table-widen-columns t + "Non-nil means widen narrowed columns for export. +When nil, narrowed columns will look in ASCII export just like in org-mode, +i.e. with \"=>\" as ellipsis." + :group 'org-export-ascii + :type 'boolean) + +(defvar org-export-ascii-entities 'ascii + "The ascii representation to be used during ascii export. +Possible values are: + +ascii Only use plain ASCII characters +latin1 Include Latin-1 character +utf8 Use all UTF-8 characters") + ;;; Hooks (defvar org-export-ascii-final-hook nil @@ -75,6 +93,41 @@ for column grouping." (defvar org-ascii-current-indentation nil) ; For communication ;;;###autoload +(defun org-export-as-latin1 (&rest args) + "Like `org-export-as-ascii', use latin1 encoding for special symbols." + (interactive) + (org-export-as-encoding 'org-export-as-ascii (interactive-p) + 'latin1 args)) + +;;;###autoload +(defun org-export-as-latin1-to-buffer (&rest args) + "Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols." + (interactive) + (org-export-as-encoding 'org-export-as-ascii-to-buffer (interactive-p) + 'latin1 args)) + +;;;###autoload +(defun org-export-as-utf8 (&rest args) + "Like `org-export-as-ascii', use use encoding for special symbols." + (interactive) + (org-export-as-encoding 'org-export-as-ascii (interactive-p) + 'utf8 args)) + +;;;###autoload +(defun org-export-as-utf8-to-buffer (&rest args) + "Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols." + (interactive) + (org-export-as-encoding 'org-export-as-ascii-to-buffer (interactive-p) + 'utf8 args)) + +(defun org-export-as-encoding (command interactivep encoding &rest args) + (let ((org-export-ascii-entities encoding)) + (if interactivep + (call-interactively command) + (apply command args)))) + + +;;;###autoload (defun org-export-as-ascii-to-buffer (arg) "Call `org-export-as-ascii` with output to a temporary buffer. No file is created. The prefix ARG is passed through to `org-export-as-ascii'." @@ -156,6 +209,7 @@ resulting ASCII as a string. When BODY-ONLY is set, don't produce the file header and footer. When PUB-DIR is set, use this as the publishing directory." (interactive "P") + (run-hooks 'org-export-first-hook) (setq-default org-todo-line-regexp org-todo-line-regexp) (let* ((opt-plist (org-combine-plists (org-default-export-plist) ext-plist @@ -181,6 +235,11 @@ publishing directory." (if subtree-p (org-export-add-subtree-options opt-plist rbeg) opt-plist))) + ;; The following two are dynamically scoped into other + ;; routines below. + (org-current-export-dir + (or pub-dir (org-export-directory :html opt-plist))) + (org-current-export-file buffer-file-name) (custom-times org-display-custom-times) (org-ascii-current-indentation '(0 . 0)) (level 0) line txt @@ -219,8 +278,10 @@ publishing directory." (and (not (plist-get opt-plist :skip-before-1st-heading)) (org-export-grab-title-from-buffer)) - (file-name-sans-extension - (file-name-nondirectory bfname)))) + (and (buffer-file-name) + (file-name-sans-extension + (file-name-nondirectory bfname))) + "UNTITLED")) (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) @@ -250,7 +311,7 @@ publishing directory." :add-text (plist-get opt-plist :text)) "\n")) thetoc have-headings first-heading-pos - table-open table-buffer link-buffer link desc desc0 rpl wrap) + table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc) (let ((inhibit-read-only t)) (org-unmodified (remove-text-properties (point-min) (point-max) @@ -286,8 +347,10 @@ publishing directory." (if (and (or author email) org-export-author-info) - (insert(concat (nth 1 lang-words) ": " (or author "") - (if email (concat " <" email ">") "") + (insert (concat (nth 1 lang-words) ": " (or author "") + (if (and org-export-email-info + email (string-match "\\S-" email)) + (concat " <" email ">") "") "\n"))) (cond @@ -337,7 +400,7 @@ publishing directory." (if (and (memq org-export-with-tags '(not-in-toc nil)) (string-match - (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") + (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") txt)) (setq txt (replace-match "" t t txt))) (if (string-match quote-re0 txt) @@ -368,10 +431,12 @@ publishing directory." ;; Remove the quoted HTML tags. (setq line (org-html-expand-for-ascii line)) ;; Replace links with the description when possible - (while (string-match org-bracket-link-regexp line) - (setq link (match-string 1 line) - desc0 (match-string 3 line) - desc (or desc0 (match-string 1 line))) + (while (string-match org-bracket-link-analytic-regexp++ line) + (setq path (match-string 3 line) + link (concat (match-string 1 line) path) + type (match-string 2 line) + desc0 (match-string 5 line) + desc (or desc0 link)) (if (and (> (length link) 8) (equal (substring link 0 8) "coderef:")) (setq line (replace-match @@ -380,15 +445,18 @@ publishing directory." (substring link 8) org-export-code-refs))) t t line)) - (setq rpl (concat "[" - (or (match-string 3 line) (match-string 1 line)) - "]")) - (when (and desc0 (not (equal desc0 link))) - (if org-export-ascii-links-to-notes - (push (cons desc0 link) link-buffer) - (setq rpl (concat rpl " (" link ")") - wrap (+ (length line) (- (length (match-string 0 line))) - (length desc))))) + (setq rpl (concat "[" desc "]")) + (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) + (setq rpl (or (save-match-data + (funcall fnc (org-link-unescape path) + desc0 'ascii)) + rpl)) + (when (and desc0 (not (equal desc0 link))) + (if org-export-ascii-links-to-notes + (push (cons desc0 link) link-buffer) + (setq rpl (concat rpl " (" link ")") + wrap (+ (length line) (- (length (match-string 0 line))) + (length desc)))))) (setq line (replace-match rpl t t line)))) (when custom-times (setq line (org-translate-time line))) @@ -419,7 +487,8 @@ publishing directory." (org-format-table-ascii table-buffer) "\n") "\n"))) (t - (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line) + (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" + line) (setq line (replace-match "\\1\\3:" t nil line))) (setq line (org-fix-indentation line org-ascii-current-indentation)) ;; Remove forced line breaks @@ -481,19 +550,39 @@ publishing directory." (current-buffer)))) (defun org-export-ascii-preprocess (parameters) - "Do extra work for ASCII export" + "Do extra work for ASCII export." + ;; + ;; Realign tables to get rid of narrowing + (when org-export-ascii-table-widen-columns + (let ((org-table-do-narrow nil)) + (goto-char (point-min)) + (org-ascii-replace-entities) + (goto-char (point-min)) + (org-table-map-tables + (lambda () (org-if-unprotected (org-table-align))) + 'quietly))) ;; Put quotes around verbatim text (goto-char (point-min)) (while (re-search-forward org-verbatim-re nil t) - (goto-char (match-end 2)) - (backward-delete-char 1) (insert "'") - (goto-char (match-beginning 2)) - (delete-char 1) (insert "`") - (goto-char (match-end 2))) + (org-if-unprotected-at (match-beginning 4) + (goto-char (match-end 2)) + (backward-delete-char 1) (insert "'") + (goto-char (match-beginning 2)) + (delete-char 1) (insert "`") + (goto-char (match-end 2)))) ;; Remove target markers (goto-char (point-min)) (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t) - (replace-match "\\1\\2"))) + (org-if-unprotected-at (match-beginning 1) + (replace-match "\\1\\2"))) + ;; Remove list start counters + (goto-char (point-min)) + (while (org-search-forward-unenclosed + "\\[@\\(?:start:\\)?[0-9]+\\][ \t]*" nil t) + (replace-match "")) + (remove-text-properties + (point-min) (point-max) + '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil))) (defun org-html-expand-for-ascii (line) "Handle quoted HTML for ASCII export." @@ -503,6 +592,15 @@ publishing directory." (setq line (replace-match "" nil nil line)))) line) +(defun org-ascii-replace-entities () + "Replace entities with the ASCII representation." + (let (e) + (while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" nil t) + (org-if-unprotected-at (match-beginning 1) + (setq e (org-entity-get-representation (match-string 1) + org-export-ascii-entities)) + (and e (replace-match e t t)))))) + (defun org-export-ascii-wrap (line where) "Wrap LINE at or before WHERE." (let ((ind (org-get-indentation line)) @@ -556,7 +654,7 @@ publishing directory." (insert "\n")) (setq char (nth (- umax level) (reverse org-export-ascii-underline))) (unless org-export-with-tags - (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) (setq title (replace-match "" t t title)))) (if org-export-with-section-numbers (setq title (concat (org-section-number level) " " title))) diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 4eaa8bf46c0..7f0f32b08ba 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -4,7 +4,7 @@ ;; Author: John Wiegley <johnw@newartisans.com> ;; Keywords: org data task -;; Version: 6.33x +;; Version: 7.4 ;; This file is part of GNU Emacs. ;; @@ -92,7 +92,7 @@ ln create a hard link. Note that this is not supported :type 'boolean) (defcustom org-attach-allow-inheritance t - "Non-nil means, allow attachment directories be inherited." + "Non-nil means allow attachment directories be inherited." :group 'org-attach :type 'boolean) @@ -241,12 +241,17 @@ the ATTACH_DIR property) their own attachment directory." "Commit changes to git if `org-attach-directory' is properly initialized. This checks for the existence of a \".git\" directory in that directory." (let ((dir (expand-file-name org-attach-directory))) - (if (file-exists-p (expand-file-name ".git" dir)) - (shell-command - (concat "(cd " dir "; " - " git add .; " - " git ls-files --deleted -z | xargs -0 git rm; " - " git commit -m 'Synchronized attachments')"))))) + (when (file-exists-p (expand-file-name ".git" dir)) + (with-temp-buffer + (cd dir) + (shell-command "git add .") + (shell-command "git ls-files --deleted" t) + (mapc '(lambda (file) + (unless (string= file "") + (shell-command + (concat "git rm \"" file "\"")))) + (split-string (buffer-string) "\n")) + (shell-command "git commit -m 'Synchronized attachments'"))))) (defun org-attach-tag (&optional off) "Turn the autotag on or (if OFF is set) off." @@ -322,7 +327,8 @@ The attachment is created as an Emacs buffer." (setq file (expand-file-name file attach-dir)) (unless (file-exists-p file) (error "No such attachment: %s" file)) - (delete-file file))) + (delete-file file) + (org-attach-commit))) (defun org-attach-delete-all (&optional force) "Delete all attachments from the current task. diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index ac5b245c6e3..2d3e9298c22 100644 --- a/lisp/org/org-bbdb.el +++ b/lisp/org/org-bbdb.el @@ -7,7 +7,7 @@ ;; Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -207,7 +207,7 @@ date year)." (defun org-bbdb-export (path desc format) "Create the export version of a BBDB link specified by PATH or DESC. If exporting to either HTML or LaTeX FORMAT the link will be -italicised, in all other cases it is left unchanged." +italicized, in all other cases it is left unchanged." (cond ((eq format 'html) (format "<i>%s</i>" (or desc path))) ((eq format 'latex) (format "\\textit{%s}" (or desc path))) @@ -322,8 +322,8 @@ This is used by Org to re-create the anniversary hash table." (when rec (let* ((class (or (nth 2 rec) org-bbdb-default-anniversary-format)) - (form (or (cdr (assoc class - org-bbdb-anniversary-format-alist)) + (form (or (cdr (assoc-string + class org-bbdb-anniversary-format-alist t)) class)) ; (as format string) (name (nth 1 rec)) (years (- y (car rec))) @@ -338,8 +338,7 @@ This is used by Org to re-create the anniversary hash table." (setq text (append text (list tmp))) (setq text (list tmp))))) )) - (when text - (mapconcat 'identity text "; ")))) + text)) (defun org-bbdb-complete-link () "Read a bbdb link with name completion." diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el new file mode 100644 index 00000000000..c88df859f79 --- /dev/null +++ b/lisp/org/org-beamer.el @@ -0,0 +1,636 @@ +;;; org-beamer.el --- Beamer-specific LaTeX export for org-mode +;; +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; +;; Version: 7.4 +;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com> +;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> +;; Keywords: org, wp, tex + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This library implement the special treatment needed by using the +;; beamer class during LaTeX export. + +;;; Code: + +(require 'org) +(require 'org-exp) + +(defvar org-export-latex-header) +(defvar org-export-latex-options-plist) +(defvar org-export-opt-plist) + +(defgroup org-beamer nil + "Options specific for using the beamer class in LaTeX export." + :tag "Org Beamer" + :group 'org-export-latex) + +(defcustom org-beamer-use-parts nil + "" + :group 'org-beamer + :type 'boolean) + +(defcustom org-beamer-frame-level 1 + "The level that should be interpreted as a frame. +The levels above this one will be translated into a sectioning structure. +Setting this to 2 will allow sections, 3 will allow subsections as well. +You can set this to 4 as well, if you at the same time set +`org-beamer-use-parts' to make the top levels `\part'." + :group 'org-beamer + :type '(choice + (const :tag "Frames need a BEAMER_env property" nil) + (integer :tag "Specific level makes a frame"))) + +(defcustom org-beamer-frame-default-options "" + "Default options string to use for frames, should contains the [brackets]. +And example for this is \"[allowframebreaks]\"." + :group 'org-beamer + :type '(string :tag "[options]")) + +(defcustom org-beamer-column-view-format + "%45ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Env Args) %4BEAMER_col(Col) %8BEAMER_extra(Extra)" + "Default column view format that should be used to fill the template." + :group 'org-beamer + :type '(choice + (const :tag "Do not insert Beamer column view format" nil) + (string :tag "Beamer column view format"))) + +(defcustom org-beamer-themes + "\\usetheme{default}\\usecolortheme{default}" + "Default string to be used for extra heading stuff in beamer presentations. +When a beamer template is filled, this will be the default for +BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}." + :group 'org-beamer + :type '(choice + (const :tag "Do not insert Beamer themes" nil) + (string :tag "Beamer themes"))) + +(defconst org-beamer-column-widths + "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC" +"The column widths that should be installed as allowed property values.") + +(defconst org-beamer-transitions + "\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC" + "Transitions available for beamer. +These are just a completion help.") + +(defconst org-beamer-environments-default + '(("frame" "f" "dummy- special handling hard coded" "dummy") + ("columns" "C" "\\begin{columns}%o %% %h%x" "\\end{columns}") + ("column" "c" "\\begin{column}%o{%h\\textwidth}%x" "\\end{column}") + ("block" "b" "\\begin{block}%a{%h}%x" "\\end{block}") + ("alertblock" "a" "\\begin{alertblock}%a{%h}%x" "\\end{alertblock}") + ("verse" "v" "\\begin{verse}%a %% %h%x" "\\end{verse}") + ("quotation" "q" "\\begin{quotation}%a %% %h%x" "\\end{quotation}") + ("quote" "Q" "\\begin{quote}%a %% %h%x" "\\end{quote}") + ("structureenv" "s" "\\begin{structureenv}%a %% %h%x" "\\end{structureenv}") + ("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}") + ("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}") + ("example" "e" "\\begin{example}%a%U%x" "\\end{example}") + ("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}") + ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}") + ("normal" "h" "%h" "") ; Emit the heading as normal text + ("note" "n" "\\note%o%a{%h" "}") + ("noteNH" "N" "\\note%o%a{" "}") ; note, ignore heading + ("ignoreheading" "i" "%%%% %h" "")) + "Environments triggered by properties in Beamer export. +These are the defaults - for user definitions, see +`org-beamer-environments-extra'. +\"normal\" is a special fake environment, which emit the heading as +normal text. It is needed when an environment should be surrounded +by normal text. Since beamer export converts nodes into environments, +you need to have a node to end the environment. +For example + + ** a frame + some text + *** Blocktitle :B_block: + inside the block + *** After the block :B_normal: + continuing here + ** next frame") + +(defcustom org-beamer-environments-extra nil + "Environments triggered by tags in Beamer export. +Each entry has 4 elements: + +name Name of the environment +key Selection key for `org-beamer-select-environment' +open The opening template for the environment, with the following escapes + %a the action/overlay specification + %A the default action/overlay specification + %o the options argument of the template + %h the headline text + %H if there is headline text, that text in {} braces + %U if there is headline text, that text in [] brackets +close The closing string of the environment." + + :group 'org-beamer + :type '(repeat + (list + (string :tag "Environment") + (string :tag "Selection key") + (string :tag "Begin") + (string :tag "End")))) + +(defvar org-beamer-frame-level-now nil) +(defvar org-beamer-header-extra nil) +(defvar org-beamer-export-is-beamer-p nil) +(defvar org-beamer-inside-frame-at-level nil) +(defvar org-beamer-columns-open nil) +(defvar org-beamer-column-open nil) + +(defun org-beamer-cleanup-column-width (width) + "Make sure the width is not empty, and that it has a unit." + (setq width (org-trim (or width ""))) + (unless (string-match "\\S-" width) (setq width "0.5")) + (if (string-match "\\`[.0-9]+\\'" width) + (setq width (concat width "\\textwidth"))) + width) + +(defun org-beamer-open-column (&optional width opt) + (org-beamer-close-column-maybe) + (setq org-beamer-column-open t) + (setq width (org-beamer-cleanup-column-width width)) + (insert (format "\\begin{column}%s{%s}\n" (or opt "") width))) +(defun org-beamer-close-column-maybe () + (when org-beamer-column-open + (setq org-beamer-column-open nil) + (insert "\\end{column}\n"))) +(defun org-beamer-open-columns-maybe (&optional opts) + (unless org-beamer-columns-open + (setq org-beamer-columns-open t) + (insert (format "\\begin{columns}%s\n" (or opts ""))))) +(defun org-beamer-close-columns-maybe () + (org-beamer-close-column-maybe) + (when org-beamer-columns-open + (setq org-beamer-columns-open nil) + (insert "\\end{columns}\n"))) + +(defun org-beamer-select-environment () + "Select the environment to be used by beamer for this entry. +While this uses (for convenience) a tag selection interface, the result +of this command will be that the BEAMER_env *property* of the entry is set. + +In addition to this, the command will also set a tag as a visual aid, but +the tag does not have any semantic meaning." + (interactive) + (let* ((envs (append org-beamer-environments-extra + org-beamer-environments-default)) + (org-tag-alist + (append '((:startgroup)) + (mapcar (lambda (e) (cons (concat "B_" (car e)) + (string-to-char (nth 1 e)))) + envs) + '((:endgroup)) + '(("BMCOL" . ?|)))) + (org-fast-tag-selection-single-key t)) + (org-set-tags) + (let ((tags (or (ignore-errors (org-get-tags-string)) ""))) + (cond + ((equal org-last-tag-selection-key ?|) + (if (string-match ":BMCOL:" tags) + (org-set-property "BEAMER_col" (read-string "Column width: ")) + (org-delete-property "BEAMER_col"))) + ((string-match (concat ":B_\\(" + (mapconcat 'car envs "\\|") + "\\):") + tags) + (org-entry-put nil "BEAMER_env" (match-string 1 tags))) + (t (org-entry-delete nil "BEAMER_env")))))) + + +(defun org-beamer-sectioning (level text) + "Return the sectioning entry for the current headline. +LEVEL is the reduced level of the headline. +TEXT is the text of the headline, everything except the leading stars. +The return value is a cons cell. The car is the headline text, usually +just TEXT, but possibly modified if options have been extracted from the +text. The cdr is the sectioning entry, similar to what is given +in org-export-latex-classes." + (let* ((frame-level (or org-beamer-frame-level-now org-beamer-frame-level)) + (default + (if org-beamer-use-parts + '((1 . ("\\part{%s}" . "\\part*{%s}")) + (2 . ("\\section{%s}" . "\\section*{%s}")) + (3 . ("\\subsection{%s}" . "\\subsection*{%s}"))) + '((1 . ("\\section{%s}" . "\\section*{%s}")) + (2 . ("\\subsection{%s}" . "\\subsection*{%s}"))))) + (envs (append org-beamer-environments-extra + org-beamer-environments-default)) + (props (org-get-text-property-any 0 'org-props text)) + (in "") (out "") option action defaction environment extra + columns-option column-option + env have-text ass tmp) + (if (= frame-level 0) (setq frame-level nil)) + (when (and org-beamer-inside-frame-at-level + (<= level org-beamer-inside-frame-at-level)) + (setq org-beamer-inside-frame-at-level nil)) + (when (setq tmp (org-beamer-assoc-not-empty "BEAMER_col" props)) + (if (and (string-match "\\`[0-9.]+\\'" tmp) + (or (= (string-to-number tmp) 1.0) + (= (string-to-number tmp) 0.0))) + ;; column width 1 means close columns, go back to full width + (org-beamer-close-columns-maybe) + (when (setq ass (assoc "BEAMER_envargs" props)) + (let (case-fold-search) + (while (string-match "C\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass)) + (setq columns-option (match-string 1 (cdr ass))) + (setcdr ass (replace-match "" t t (cdr ass)))) + (while (string-match "c\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass)) + (setq column-option (match-string 1 (cdr ass))) + (setcdr ass (replace-match "" t t (cdr ass)))))) + (org-beamer-open-columns-maybe columns-option) + (org-beamer-open-column tmp column-option))) + (cond + ((or (equal (cdr (assoc "BEAMER_env" props)) "frame") + (and frame-level (= level frame-level))) + ;; A frame + (org-beamer-get-special props) + + (setq in (org-fill-template + "\\begin{frame}%a%A%o%T%S%x" + (list (cons "a" (or action "")) + (cons "A" (or defaction "")) + (cons "o" (or option org-beamer-frame-default-options "")) + (cons "x" (if extra (concat "\n" extra) "")) + (cons "h" "%s") + (cons "T" (if (string-match "\\S-" text) + "\n\\frametitle{%s}" "")) + (cons "S" (if (string-match "\\\\\\\\" text) + "\n\\framesubtitle{%s}" "")))) + out (copy-sequence "\\end{frame}")) + (org-add-props out + '(org-insert-hook org-beamer-close-columns-maybe)) + (setq org-beamer-inside-frame-at-level level) + (cons text (list in out in out))) + ((and (setq env (cdr (assoc "BEAMER_env" props))) + (setq ass (assoc env envs))) + ;; A beamer environment selected by the BEAMER_env property + (if (string-match "[ \t]+:[ \t]*$" text) + (setq text (replace-match "" t t text))) + (if (member env '("note" "noteNH")) + ;; There should be no labels in a note, so we remove the targets + ;; FIXME??? + (remove-text-properties 0 (length text) '(target nil) text)) + (org-beamer-get-special props) + (setq text (org-trim text)) + (setq have-text (string-match "\\S-" text)) + (setq in (org-fill-template + (nth 2 ass) + (list (cons "a" (or action "")) + (cons "A" (or defaction "")) + (cons "o" (or option "")) + (cons "x" (if extra (concat "\n" extra) "")) + (cons "h" "%s") + (cons "H" (if have-text (concat "{" text "}") "")) + (cons "U" (if have-text (concat "[" text "]") "")))) + out (nth 3 ass)) + (cond + ((equal out "\\end{columns}") + (setq org-beamer-columns-open t) + (setq out (org-add-props (copy-sequence out) + '(org-insert-hook + (lambda () + (org-beamer-close-column-maybe) + (setq org-beamer-columns-open nil)))))) + ((equal out "\\end{column}") + (org-beamer-open-columns-maybe))) + (cons text (list in out in out))) + ((and (not org-beamer-inside-frame-at-level) + (or (not frame-level) + (< level frame-level)) + (assoc level default)) + ;; Normal sectioning + (cons text (cdr (assoc level default)))) + (t nil)))) + +(defvar extra) +(defvar option) +(defvar action) +(defvar defaction) +(defvar environment) +(defun org-beamer-get-special (props) + "Extract an option, action, and default action string from text. +The variables option, action, defaction, extra are all scoped into +this function dynamically." + (let (tmp) + (setq environment (org-beamer-assoc-not-empty "BEAMER_env" props)) + (setq extra (org-beamer-assoc-not-empty "BEAMER_extra" props)) + (when extra + (setq extra (replace-regexp-in-string "\\\\n" "\n" extra))) + (setq tmp (org-beamer-assoc-not-empty "BEAMER_envargs" props)) + (when tmp + (setq tmp (copy-sequence tmp)) + (if (string-match "\\[<[^][<>]*>\\]" tmp) + (setq defaction (match-string 0 tmp) + tmp (replace-match "" t t tmp))) + (if (string-match "\\[[^][]*\\]" tmp) + (setq option (match-string 0 tmp) + tmp (replace-match "" t t tmp))) + (if (string-match "<[^<>]*>" tmp) + (setq action (match-string 0 tmp) + tmp (replace-match "" t t tmp)))))) + +(defun org-beamer-assoc-not-empty (elt list) + (let ((tmp (cdr (assoc elt list)))) + (and tmp (string-match "\\S-" tmp) tmp))) + + +(defvar org-beamer-mode-map (make-sparse-keymap) + "The keymap for `org-beamer-mode'.") +(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment) + +(define-minor-mode org-beamer-mode + "Special support for editing Org-mode files made to export to beamer." + nil " Bm" nil) +(when (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords + 'org-mode + '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend)) + 'prepent)) + +(defun org-beamer-place-default-actions-for-lists () + "Find default overlay specifications in items, and move them. +The need to be after the begin statement of the environment." + (when org-beamer-export-is-beamer-p + (let (dovl) + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*\\\\begin{\\(itemize\\|enumerate\\|description\\)}[ \t\n]*\\\\item\\>\\( ?\\(<[^<>\n]*>\\|\\[[^][\n*]\\]\\)\\)?[ \t]*\\S-" nil t) + (if (setq dovl (cdr (assoc "BEAMER_dovl" + (get-text-property (match-end 0) + 'org-props)))) + (save-excursion + (goto-char (1+ (match-end 1))) + (insert dovl))))))) + +(defun org-beamer-amend-header () + "Add `org-beamer-header-extra' to the LaTeX header. +If the file contains the string BEAMER-HEADER-EXTRA-HERE on a line +by itself, it will be replaced with `org-beamer-header-extra'. If not, +the value will be inserted right after the documentclass statement." + (when (and org-beamer-export-is-beamer-p + org-beamer-header-extra) + (goto-char (point-min)) + (cond + ((re-search-forward + "^[ \t]*\\[?BEAMER-HEADER-EXTRA\\(-HERE\\)?\\]?[ \t]*$" nil t) + (replace-match org-beamer-header-extra t t) + (or (bolp) (insert "\n"))) + ((re-search-forward "^[ \t]*\\\\begin{document}" nil t) + (beginning-of-line 1) + (insert org-beamer-header-extra) + (or (bolp) (insert "\n")))))) + +(defcustom org-beamer-fragile-re "^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\)}" + "If this regexp matches in a frame, the frame is marked as fragile." + :group 'org-beamer + :type 'regexp) + +(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40)))) + "The special face for beamer tags." + :group 'org-beamer) + + +;; Functions to initialize and post-process +;; These fuctions will be hooked into various places in the export process + +(defun org-beamer-initialize-open-trackers () + "Reset variables that track if certain environments are open during export." + (setq org-beamer-columns-open nil) + (setq org-beamer-column-open nil) + (setq org-beamer-inside-frame-at-level nil) + (setq org-beamer-export-is-beamer-p nil)) + +(defun org-beamer-after-initial-vars () + "Find special settings for beamer and store them. +The effect is that these values will be accessible during export." + ;; First verify that we are exporting using the beamer class + (setq org-beamer-export-is-beamer-p + (string-match "\\\\documentclass\\(\\[[^][]*?\\]\\)?{beamer}" + org-export-latex-header)) + (when org-beamer-export-is-beamer-p + ;; Find the frame level + (setq org-beamer-frame-level-now + (or (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (and (looking-at org-complex-heading-regexp) + (org-entry-get nil "BEAMER_FRAME_LEVEL" 'selective)))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (and (re-search-forward + "^#\\+BEAMER_FRAME_LEVEL:[ \t]*\\(.*?\\)[ \t]*$" nil t) + (match-string 1)))) + (plist-get org-export-latex-options-plist :beamer-frame-level) + org-beamer-frame-level)) + ;; Normalize the value so that the functions can trust the value + (cond + ((not org-beamer-frame-level-now) + (setq org-beamer-frame-level-now nil)) + ((stringp org-beamer-frame-level-now) + (setq org-beamer-frame-level-now + (string-to-number org-beamer-frame-level-now)))) + ;; Find the header additons, most likely theme commands + (setq org-beamer-header-extra + (or (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (and (looking-at org-complex-heading-regexp) + (org-entry-get nil "BEAMER_HEADER_EXTRA" + 'selective)))) + (save-excursion + (save-restriction + (widen) + (let ((txt "")) + (goto-char (point-min)) + (while (re-search-forward + "^#\\+BEAMER_HEADER_EXTRA:[ \t]*\\(.*?\\)[ \t]*$" + nil t) + (setq txt (concat txt "\n" (match-string 1)))) + (if (> (length txt) 0) (substring txt 1))))) + (plist-get org-export-latex-options-plist + :beamer-header-extra))) + (let ((inhibit-read-only t) + (case-fold-search nil) + props) + (org-unmodified + (remove-text-properties (point-min) (point-max) '(org-props nil)) + (org-map-entries + '(progn + (setq props (org-entry-properties nil 'standard)) + (if (and (not (assoc "BEAMER_env" props)) + (looking-at ".*?:B_\\(note\\(NH\\)?\\):")) + (push (cons "BEAMER_env" (match-string 1)) props)) + (put-text-property (point-at-bol) (point-at-eol) 'org-props props))) + (setq org-export-latex-options-plist + (plist-put org-export-latex-options-plist :tags nil)))))) + +(defun org-beamer-auto-fragile-frames () + "Mark any frames containing verbatim environments as fragile. +This function will run in the final LaTeX document." + (when org-beamer-export-is-beamer-p + (let (opts) + (goto-char (point-min)) + ;; Find something that might be fragile + (while (re-search-forward org-beamer-fragile-re nil t) + (save-excursion + ;; Are we inside a frame here? + (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}" + nil t) + (equal (match-string 1) "begin")) + ;; yes, inside a frame, make sure "fragile" is one of the options + (goto-char (match-end 0)) + (if (not (looking-at "\\[.*?\\]")) + (insert "[fragile]") + (setq opts (substring (match-string 0) 1 -1)) + (delete-region (match-beginning 0) (match-end 0)) + (setq opts (org-split-string opts ",")) + (add-to-list 'opts "fragile") + (insert "[" (mapconcat 'identity opts ",") "]")))))))) + +(defcustom org-beamer-outline-frame-title "Outline" + "Default title of a frame containing an outline." + :group 'org-beamer + :type '(string :tag "Outline frame title") +) + +(defcustom org-beamer-outline-frame-options nil + "Outline frame options appended after \\begin{frame}. +You might want to put e.g. [allowframebreaks=0.9] here. Remember to +include square brackets." + :group 'org-beamer + :type '(string :tag "Outline frame options") +) + +(defun org-beamer-fix-toc () + "Fix the table of contents by removing the vspace line." + (when org-beamer-export-is-beamer-p + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "\\(\\\\setcounter{tocdepth.*\n\\\\tableofcontents.*\n\\)\\(\\\\vspace\\*.*\\)" + nil t) + (replace-match + (concat "\\\\begin{frame}" org-beamer-outline-frame-options + "\n\\\\frametitle{" + org-beamer-outline-frame-title + "}\n\\1\\\\end{frame}") + t nil))))) + +(defun org-beamer-property-changed (property value) + "Track the BEAMER_env property with tags." + (cond + ((equal property "BEAMER_env") + (save-excursion + (org-back-to-heading t) + (let ((tags (org-get-tags))) + (setq tags (delq nil (mapcar (lambda (x) + (if (string-match "^B_" x) nil x)) + tags))) + (org-set-tags-to tags)) + (when (and value (stringp value) (string-match "\\S-" value)) + (org-toggle-tag (concat "B_" value) 'on)))) + ((equal property "BEAMER_col") + (org-toggle-tag "BMCOL" (if (and value (string-match "\\S-" value)) + 'on 'off))))) + +(defun org-beamer-select-beamer-code () + "Take code marked for BEAMER and turn it into marked for LaTeX." + (when org-beamer-export-is-beamer-p + (goto-char (point-min)) + (while (re-search-forward + "^\\([ \]*#\\+\\(begin_\\|end_\\)?\\)\\(beamer\\)\\>" nil t) + (replace-match "\\1latex")))) + +;; OK, hook all these functions into appropriate places +(add-hook 'org-export-first-hook + 'org-beamer-initialize-open-trackers) +(add-hook 'org-property-changed-functions + 'org-beamer-property-changed) +(add-hook 'org-export-latex-after-initial-vars-hook + 'org-beamer-after-initial-vars) +(add-hook 'org-export-latex-final-hook + 'org-beamer-place-default-actions-for-lists) +(add-hook 'org-export-latex-final-hook + 'org-beamer-auto-fragile-frames) +(add-hook 'org-export-latex-final-hook + 'org-beamer-fix-toc) +(add-hook 'org-export-latex-final-hook + 'org-beamer-amend-header) +(add-hook 'org-export-preprocess-before-selecting-backend-code-hook + 'org-beamer-select-beamer-code) + +(defun org-insert-beamer-options-template (kind) + "Insert a settings template, to make sure users do this right." + (interactive (progn + (message "Current [s]ubtree or [g]lobal?") + (if (equal (read-char-exclusive) ?g) + (list 'global) + (list 'subtree)))) + (if (eq kind 'subtree) + (progn + (org-back-to-heading t) + (org-reveal) + (org-entry-put nil "LaTeX_CLASS" "beamer") + (org-entry-put nil "LaTeX_CLASS_OPTIONS" "[presentation]") + (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf") + (org-entry-put nil "BEAMER_FRAME_LEVEL" (number-to-string + org-beamer-frame-level)) + (when org-beamer-themes + (org-entry-put nil "BEAMER_HEADER_EXTRA" org-beamer-themes)) + (when org-beamer-column-view-format + (org-entry-put nil "COLUMNS" org-beamer-column-view-format)) + (org-entry-put nil "BEAMER_col_ALL" "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC")) + (insert "#+LaTeX_CLASS: beamer\n") + (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n") + (insert (format "#+BEAMER_FRAME_LEVEL: %d\n" org-beamer-frame-level) "\n") + (when org-beamer-themes + (insert "#+BEAMER_HEADER_EXTRA: " org-beamer-themes "\n")) + (when org-beamer-column-view-format + (insert "#+COLUMNS: " org-beamer-column-view-format "\n")) + (insert "#+PROPERTY: BEAMER_col_ALL 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC\n"))) + + +(defun org-beamer-allowed-property-values (property) + "Supply allowed values for BEAMER properties." + (cond + ((and (equal property "BEAMER_env") + (not (org-entry-get nil (concat property "_ALL") 'inherit))) + ;; If no allowed values for BEAMER_env have been defined, + ;; supply all defined environments + (mapcar 'car (append org-beamer-environments-extra + org-beamer-environments-default))) + ((and (equal property "BEAMER_col") + (not (org-entry-get nil (concat property "_ALL") 'inherit))) + ;; If no allowed values for BEAMER_col have been defined, + ;; supply some + '("0.1" "0.2" "0.3" "0.4" "0.5" "0.6" "0.7" "0.8" "0.9" "" ":ETC")) + (t nil))) + +(add-hook 'org-property-allowed-value-functions + 'org-beamer-allowed-property-values) + +(provide 'org-beamer) + +;; arch-tag: 68bac91a-a946-43a3-8173-a9269306f67c + +;;; org-beamer.el ends here diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index 3eb18013c1c..4ecde0c47ce 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -5,7 +5,7 @@ ;; Author: Bastien Guerry <bzg at altern dot org> ;; Carsten Dominik <carsten dot dominik at gmail dot com> ;; Keywords: org, wp, remember -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el new file mode 100644 index 00000000000..2ca98452141 --- /dev/null +++ b/lisp/org/org-capture.el @@ -0,0 +1,1390 @@ +;;; org-capture.el --- Fast note taking in Org-mode + +;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 7.4 +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains an alternative implementation of the same functionality +;; that is also provided by org-remember.el. The implementation is more +;; streamlined, can produce more target types (e.g. plain list items or +;; table lines). Also, it does not use a temporary buffer for editing +;; the captured entry - instead it uses an indirect buffer that visits +;; the new entry already in the target buffer (this was an idea by Samuel +;; Wales). John Wiegley's excellent `remember.el' is not needed for this +;; implementation, even though we borrow heavily from its ideas. + +;; This implementation heavily draws on ideas by James TD Smith and +;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration. + +;;; TODO + +;; - find a clever way to not always insert an annotation maybe a +;; predicate function that can check for conditions for %a to be +;; used. This could be one of the properties. + +;; - Should there be plist members that arrange for properties to be +;; asked for, like James proposed in his RFC? + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'org) +(require 'org-mks) + +(declare-function org-datetree-find-date-create "org-datetree" + (DATE &optional KEEP-RESTRICTION)) +(declare-function org-table-get-specials "org-table" ()) +(declare-function org-table-goto-line "org-table" (N)) +(defvar org-remember-default-headline) +(defvar org-remember-templates) +(defvar org-table-hlines) + +(defvar org-capture-clock-was-started nil + "Internal flag, noting if the clock was started.") + +(defvar org-capture-last-stored-marker (make-marker) + "Marker pointing to the entry most recently stored with `org-capture'.") + +;; The following variable is scoped dynamically by org-protocol +;; to indicate that the link properties have already been stored +(defvar org-capture-link-is-already-stored nil) + +(defgroup org-capture nil + "Options concerning capturing new entries." + :tag "Org Capture" + :group 'org) + +(defcustom org-capture-templates nil + "Templates for the creation of new entries. + +Each entry is a list with the following items: + +keys The keys that will select the template, as a string, characters + only, for example \"a\" for a template to be selected with a + single key, or \"bt\" for selection with two keys. When using + several keys, keys using the same prefix key must be together + in the list and preceded by a 2-element entry explaining the + prefix key, for example + + (\"b\" \"Templates for marking stuff to buy\") + + The \"C\" key is used by default for quick access to the + customization of the template variable. But if you want to use + that key for a template, you can. + +description A short string describing the template, will be shown during + selection. + +type The type of entry. Valid types are: + entry an Org-mode node, with a headline. Will be + filed as the child of the target entry or as + a top-level entry. + item a plain list item, will be placed in the + first plain list at the target + location. + checkitem a checkbox item. This differs from the + plain list item only is so far as it uses a + different default template. + table-line a new line in the first table at target location. + plain text to be inserted as it is. + +target Specification of where the captured item should be placed. + In Org-mode files, targets usually define a node. Entries will + become children of this node, other types will be added to the + table or list in the body of this node. + + Valid values are: + + (file \"path/to/file\") + Text will be placed at the beginning or end of that file + + (id \"id of existing org entry\") + File as child of this entry, or in the body of the entry + + (file+headline \"path/to/file\" \"node headline\") + Fast configuration if the target heading is unique in the file + + (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...) + For non-unique headings, the full path is safer + + (file+regexp \"path/to/file\" \"regexp to find location\") + File to the entry matching regexp + + (file+datetree \"path/to/file\") + Will create a heading in a date tree for today's date + + (file+datetree+prompt \"path/to/file\") + Will create a heading in a date tree, promts for date + + (file+function \"path/to/file\" function-finding-location) + A function to find the right location in the file + + (clock) + File to the entry that is currently being clocked + + (function function-finding-location) + Most general way, write your own function to find both + file and location + +template The template for creating the capture item. If you leave this + empty, an appropriate default template will be used. See below + for more details. Instead of a string, this may also be one of + + (file \"/path/to/template-file\") + (function function-returning-the-template) + + in order to get a template from a file, or dynamically + from a function. + +The rest of the entry is a property list of additional options. Recognized +properties are: + + :prepend Normally newly captured information will be appended at + the target location (last child, last table line, + last list item...). Setting this property will + change that. + + :immediate-finish When set, do not offer to edit the information, just + file it away immediately. This makes sense if the + template only needs information that can be added + automatically. + + :empty-lines Set this to the number of lines the should be inserted + before and after the new item. Default 0, only common + other value is 1. + + :clock-in Start the clock in this item. + + :clock-resume Start the interrupted clock when finishing the capture. + + :unnarrowed Do not narrow the target buffer, simply show the + full buffer. Default is to narrow it so that you + only see the new stuff. + + :table-line-pos Specification of the location in the table where the + new line should be inserted. It looks like \"II-3\" + which means that the new line should become the third + line before the second horizontal separator line. + + :kill-buffer If the target file was not yet visited by a buffer when + capture was invoked, kill the buffer again after capture + is finalized. + +The template defines the text to be inserted. Often this is an org-mode +entry (so the first line should start with a star) that will be filed as a +child of the target headline. It can also be freely formatted text. +Furthermore, the following %-escapes will be replaced with content: + + %^{prompt} prompt the user for a string and replace this sequence with it. + A default value and a completion table ca be specified like this: + %^{prompt|default|completion2|completion3|...} + %t time stamp, date only + %T time stamp with date and time + %u, %U like the above, but inactive time stamps + %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. + You may define a prompt like %^{Please specify birthday + %n user name (taken from `user-full-name') + %a annotation, normally the link created with `org-store-link' + %i initial content, copied from the active region. If %i is + indented, the entire inserted text will be indented as well. + %c current kill ring head + %x content of the X clipboard + %^C interactive selection of which kill or clip to use + %^L like %^C, but insert as link + %k title of currently clocked task + %K link to currently clocked task + %^g prompt for tags, with completion on tags in target file + %^G prompt for tags, with completion on all tags in all agenda files + %^{prop}p prompt the user for a value for property `prop' + %:keyword specific information for certain link types, see below + %[pathname] insert the contents of the file given by `pathname' + %(sexp) evaluate elisp `(sexp)' and replace with the result + + %? After completing the template, position cursor here. + +Apart from these general escapes, you can access information specific to the +link type that is created. For example, calling `org-capture' in emails +or gnus will record the author and the subject of the message, which you +can access with \"%:from\" and \"%:subject\", respectively. Here is a +complete list of what is recorded for each link type. + +Link type | Available information +------------------------+------------------------------------------------------ +bbdb | %:type %:name %:company +vm, wl, mh, mew, rmail | %:type %:subject %:message-id + | %:from %:fromname %:fromaddress + | %:to %:toname %:toaddress + | %:fromto (either \"to NAME\" or \"from NAME\") + | %:date + | %:date-timestamp (as active timestamp) + | %:date-timestamp-inactive (as inactive timestamp) +gnus | %:group, for messages also all email fields +w3, w3m | %:type %:url +info | %:type %:file %:node +calendar | %:type %:date" + :group 'org-capture + :type + '(repeat + (choice :value ("" "" entry (file "~/org/notes.org") "") + (list :tag "Multikey description" + (string :tag "Keys ") + (string :tag "Description")) + (list :tag "Template entry" + (string :tag "Keys ") + (string :tag "Description ") + (choice :tag "Capture Type " :value entry + (const :tag "Org entry" entry) + (const :tag "Plain list item" item) + (const :tag "Checkbox item" checkitem) + (const :tag "Plain text" plain) + (const :tag "Table line" table-line)) + (choice :tag "Target location" + (list :tag "File" + (const :format "" file) + (file :tag " File")) + (list :tag "ID" + (const :format "" id) + (string :tag " ID")) + (list :tag "File & Headline" + (const :format "" file+headline) + (file :tag " File ") + (string :tag " Headline")) + (list :tag "File & Outline path" + (const :format "" file+olp) + (file :tag " File ") + (repeat :tag "Outline path" :inline t + (string :tag "Headline"))) + (list :tag "File & Regexp" + (const :format "" file+regexp) + (file :tag " File ") + (regexp :tag " Regexp")) + (list :tag "File & Date tree" + (const :format "" file+datetree) + (file :tag " File")) + (list :tag "File & Date tree, prompt for date" + (const :format "" file+datetree+prompt) + (file :tag " File")) + (list :tag "File & function" + (const :format "" file+function) + (file :tag " File ") + (sexp :tag " Function")) + (list :tag "Current clocking task" + (const :format "" clock)) + (list :tag "Function" + (const :format "" function) + (sexp :tag " Function"))) + (choice :tag "Template" + (string) + (list :tag "File" + (const :format "" file) + (file :tag "Template file")) + (list :tag "Function" + (const :format "" function) + (function :tag "Template function"))) + (plist :inline t + ;; Give the most common options as checkboxes + :options (((const :format "%v " :prepend) (const t)) + ((const :format "%v " :immediate-finish) (const t)) + ((const :format "%v " :empty-lines) (const 1)) + ((const :format "%v " :clock-in) (const t)) + ((const :format "%v " :clock-resume) (const t)) + ((const :format "%v " :unnarrowed) (const t)) + ((const :format "%v " :kill-buffer) (const t)))))))) + +(defcustom org-capture-before-finalize-hook nil + "Hook that is run right before a remember process is finalized. +The remember buffer is still current when this hook runs." + :group 'org-capture + :type 'hook) + +(defcustom org-capture-after-finalize-hook nil + "Hook that is run right after a capture process is finalized. + Suitable for window cleanup" + :group 'org-capture + :type 'hook) + +;;; The property list for keeping information about the capture process + +(defvar org-capture-plist nil + "Plist for the current capture process, global, to avoid having to pass it.") +(defvar org-capture-current-plist nil + "Local variable holding the plist in a capture buffer. +This is used to store the plist for use when finishing a capture process. +Another such process might have changed the global variable by then.") + +(defun org-capture-put (&rest stuff) + (while stuff + (setq org-capture-plist (plist-put org-capture-plist + (pop stuff) (pop stuff))))) +(defun org-capture-get (prop &optional local) + (plist-get (if local org-capture-current-plist org-capture-plist) prop)) + +(defun org-capture-member (prop) + (plist-get org-capture-plist prop)) + +;;; The minor mode + +(defvar org-capture-mode-map (make-sparse-keymap) + "Keymap for `org-capture-mode', a minor mode. +Use this map to set additional keybindings for when Org-mode is used +for a Remember buffer.") + +(defvar org-capture-mode-hook nil + "Hook for the minor `org-capture-mode'.") + +(define-minor-mode org-capture-mode + "Minor mode for special key bindings in a remember buffer." + nil " Rem" org-capture-mode-map + (org-set-local + 'header-line-format + "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")) +(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) +(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) +(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) + +;;; The main commands + +;;;###autoload +(defun org-capture (&optional goto keys) + "Capture something. +\\<org-capture-mode-map> +This will let you select a template from `org-capture-templates', and then +file the newly captured information. The text is immediately inserted +at the target location, and an indirect buffer is shown where you can +edit it. Pressing \\[org-capture-finalize] brings you back to the previous state +of Emacs, so that you can continue your work. + +When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture +anything, just go to the file/headline where the selected template +stores its notes. With a double prefix argument \ +\\[universal-argument] \\[universal-argument], go to the last note +stored. + +When called with a `C-0' (zero) prefix, insert a template at point. + +Lisp programs can set KEYS to a string associated with a template in +`org-capture-templates'. In this case, interactive selection will be +bypassed." + (interactive "P") + (cond + ((equal goto '(4)) (org-capture-goto-target)) + ((equal goto '(16)) (org-capture-goto-last-stored)) + (t + ;; FIXME: Are these needed? + (let* ((orig-buf (current-buffer)) + (annotation (if (and (boundp 'org-capture-link-is-already-stored) + org-capture-link-is-already-stored) + (plist-get org-store-link-plist :annotation) + (org-store-link nil))) + (initial (and (org-region-active-p) + (buffer-substring (point) (mark)))) + (entry (org-capture-select-template keys))) + (when (stringp initial) + (remove-text-properties 0 (length initial) '(read-only t) initial)) + (when (stringp annotation) + (remove-text-properties 0 (length annotation) + '(read-only t) annotation)) + (cond + ((equal entry "C") + (customize-variable 'org-capture-templates)) + ((equal entry "q") + (error "Abort")) + (t + (org-capture-set-plist entry) + (org-capture-get-template) + (org-capture-put :original-buffer orig-buf :annotation annotation + :initial initial) + (org-capture-put :default-time + (or org-overriding-default-time + (org-current-time))) + (org-capture-set-target-location) + (condition-case error + (org-capture-put :template (org-capture-fill-template)) + ((error quit) + (if (get-buffer "*Capture*") (kill-buffer "*Capture*")) + (error "Capture abort: %s" error))) + + (if (equal goto 0) + ;;insert at point + (org-capture-insert-template-here) + (condition-case error + (org-capture-place-template) + ((error quit) + (if (and (buffer-base-buffer (current-buffer)) + (string-match "\\`CAPTURE-" (buffer-name))) + (kill-buffer (current-buffer))) + (set-window-configuration (org-capture-get :return-to-wconf)) + (error "Capture template `%s': %s" + (org-capture-get :key) + (nth 1 error)))) + (if (org-capture-get :immediate-finish) + (org-capture-finalize) + (if (and (org-mode-p) + (org-capture-get :clock-in)) + (condition-case nil + (progn + (if (org-clock-is-active) + (org-capture-put :interrupted-clock + (copy-marker org-clock-marker))) + (org-clock-in) + (org-set-local 'org-capture-clock-was-started t)) + (error + "Could not start the clock in this capture buffer"))))))))))) + + +(defun org-capture-get-template () + "Get the template from a file or a function if necessary." + (let ((txt (org-capture-get :template)) file) + (cond + ((and (listp txt) (eq (car txt) 'file)) + (if (file-exists-p + (setq file (expand-file-name (nth 1 txt) org-directory))) + (setq txt (org-file-contents file)) + (setq txt (format "* Template file %s not found" (nth 1 txt))))) + ((and (listp txt) (eq (car txt) 'function)) + (if (fboundp (nth 1 txt)) + (setq txt (funcall (nth 1 txt))) + (setq txt (format "* Template function %s not found" (nth 1 txt))))) + ((not txt) (setq txt "")) + ((stringp txt)) + (t (setq txt "* Invalid capture template"))) + (org-capture-put :template txt))) + +(defun org-capture-finalize (&optional stay-with-capture) + "Finalize the capture process. +With prefix argument STAY-WITH-CAPTURE, jump to the location of the +captured item after finalizing." + (interactive "P") + (unless (and org-capture-mode + (buffer-base-buffer (current-buffer))) + (error "This does not seem to be a capture buffer for Org-mode")) + + ;; Did we start the clock in this capture buffer? + (when (and org-capture-clock-was-started + org-clock-marker (marker-buffer org-clock-marker) + (equal (marker-buffer org-clock-marker) (buffer-base-buffer)) + (> org-clock-marker (point-min)) + (< org-clock-marker (point-max))) + ;; Looks like the clock we started is still running. Clock out. + (let (org-log-note-clock-out) (org-clock-out)) + (when (and (org-capture-get :clock-resume 'local) + (markerp (org-capture-get :interrupted-clock 'local)) + (buffer-live-p (marker-buffer + (org-capture-get :interrupted-clock 'local)))) + (let ((clock-in-task (org-capture-get :interrupted-clock 'local))) + (org-with-point-at clock-in-task + (org-clock-in))) + (message "Interrupted clock has been resumed"))) + + (let ((beg (point-min)) + (end (point-max)) + (abort-note nil)) + (widen) + + (if org-note-abort + (let ((m1 (org-capture-get :begin-marker 'local)) + (m2 (org-capture-get :end-marker 'local))) + (if (and m1 m2 (= m1 beg) (= m2 end)) + (progn + (setq abort-note 'clean) + (kill-region m1 m2)) + (setq abort-note 'dirty))) + + ;; Make sure that the empty lines after are correct + (when (and (> (point-max) end) ; indeed, the buffer was still narrowed + (member (org-capture-get :type 'local) + '(entry item checkitem plain))) + (save-excursion + (goto-char end) + (or (bolp) (newline)) + (org-capture-empty-lines-after + (or (org-capture-get :empty-lines 'local) 0)))) + ;; Postprocessing: Update Statistics cookies, do the sorting + (when (org-mode-p) + (save-excursion + (when (ignore-errors (org-back-to-heading)) + (org-update-parent-todo-statistics) + (org-update-checkbox-count))) + ;; FIXME Here we should do the sorting + ;; If we have added a table line, maybe recompute? + (when (and (eq (org-capture-get :type 'local) 'table-line) + (org-at-table-p)) + (if (org-table-get-stored-formulas) + (org-table-recalculate 'all) ;; FIXME: Should we iterate??? + (org-table-align))) + ) + ;; Store this place as the last one where we stored something + ;; Do the marking in the base buffer, so that it makes sense after + ;; the indirect buffer has been killed. + (org-capture-bookmark-last-stored-position) + + ;; Run the hook + (run-hooks 'org-capture-before-finalize-hook) + ) + + ;; Kill the indirect buffer + (save-buffer) + (let ((return-wconf (org-capture-get :return-to-wconf 'local)) + (new-buffer (org-capture-get :new-buffer 'local)) + (kill-buffer (org-capture-get :kill-buffer 'local)) + (base-buffer (buffer-base-buffer (current-buffer)))) + + ;; Kill the indiret buffer + (kill-buffer (current-buffer)) + + ;; Kill the target buffer if that is desired + (when (and base-buffer new-buffer kill-buffer) + (with-current-buffer base-buffer (save-buffer)) + (kill-buffer base-buffer)) + + ;; Restore the window configuration before capture + (set-window-configuration return-wconf)) + + (run-hooks 'org-capture-after-finalize-hook) + ;; Special cases + (cond + (abort-note + (cond + ((equal abort-note 'clean) + (message "Capture process aborted and target buffer cleaned up")) + ((equal abort-note 'dirty) + (error "Capture process aborted, but target buffer could not be cleaned up correctly")))) + (stay-with-capture + (org-capture-goto-last-stored))) + ;; Return if we did store something + (not abort-note))) + +(defun org-capture-refile () + "Finalize the current capture and then refile the entry. +Refiling is done from the base buffer, because the indirect buffer is then +already gone. Any prefix argument will be passed to the refile comand." + (interactive) + (unless (eq (org-capture-get :type 'local) 'entry) + (error + "Refiling from a capture buffer makes only sense for `entry'-type templates")) + (let ((pos (point)) + (base (buffer-base-buffer (current-buffer))) + (org-refile-for-capture t)) + (org-capture-finalize) + (save-window-excursion + (with-current-buffer (or base (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (call-interactively 'org-refile))))))) + +(defun org-capture-kill () + "Abort the current capture process." + (interactive) + ;; FIXME: This does not do the right thing, we need to remove the new stuff + ;; By hand it is easy: undo, then kill the buffer + (let ((org-note-abort t) (org-capture-before-finalize-hook nil)) + (org-capture-finalize))) + +(defun org-capture-goto-last-stored () + "Go to the location where the last remember note was stored." + (interactive) + (org-goto-marker-or-bmk org-capture-last-stored-marker + "org-capture-last-stored") + (message "This is the last note stored by a capture process")) + +;;; Supporting functions for handling the process + +(defun org-capture-set-target-location (&optional target) + "Find target buffer and position and store then in the property list." + (let ((target-entry-p t)) + (setq target (or target (org-capture-get :target))) + (save-excursion + (cond + ((eq (car target) 'file) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (setq target-entry-p nil)) + + ((eq (car target) 'id) + (let ((loc (org-id-find (nth 1 target)))) + (if (not loc) + (error "Cannot find target ID \"%s\"" (nth 1 target)) + (set-buffer (org-capture-target-buffer (car loc))) + (goto-char (cdr loc))))) + + ((eq (car target) 'file+headline) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (let ((hd (nth 2 target))) + (goto-char (point-min)) + (unless (org-mode-p) + (error "Target buffer for file+headline should be in Org mode")) + (if (re-search-forward + (format org-complex-heading-regexp-format (regexp-quote hd)) + nil t) + (goto-char (point-at-bol)) + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (insert "* " hd "\n") + (beginning-of-line 0)))) + + ((eq (car target) 'file+olp) + (let ((m (org-find-olp (cdr target)))) + (set-buffer (marker-buffer m)) + (goto-char m))) + + ((eq (car target) 'file+regexp) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (goto-char (point-min)) + (if (re-search-forward (nth 2 target) nil t) + (progn + (goto-char (if (org-capture-get :prepend) + (match-beginning 0) (match-end 0))) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) + (error "No match for target regexp in file %s" (nth 1 target)))) + + ((memq (car target) '(file+datetree file+datetree+prompt)) + (require 'org-datetree) + (set-buffer (org-capture-target-buffer (nth 1 target))) + ;; Make a date tree entry, with the current date (or yesterday, + ;; if we are extending dates for a couple of hours) + (org-datetree-find-date-create + (calendar-gregorian-from-absolute + (cond + + (org-overriding-default-time + ;; use the overriding default time + (time-to-days org-overriding-default-time)) + + ((eq (car target) 'file+datetree+prompt) + ;; prompt for date + (time-to-days (org-read-date + nil t nil "Date for tree entry:" + (days-to-time (org-today))))) + (t + ;; current date, possible corrected for late night workers + (org-today)))))) + + ((eq (car target) 'file+function) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (funcall (nth 2 target)) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) + + ((eq (car target) 'function) + (funcall (nth 1 target)) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) + + ((eq (car target) 'clock) + (if (and (markerp org-clock-hd-marker) + (marker-buffer org-clock-hd-marker)) + (progn (set-buffer (marker-buffer org-clock-hd-marker)) + (goto-char org-clock-hd-marker)) + (error "No running clock that could be used as capture target"))) + + (t (error "Invalid capture target specification"))) + + (org-capture-put :buffer (current-buffer) :pos (point) + :target-entry-p target-entry-p)))) + +(defun org-capture-target-buffer (file) + "Get a buffer for FILE." + (setq file (or (org-string-nw-p file) + org-default-notes-file + (error "No notes file specified, and no default available"))) + (or (org-find-base-buffer-visiting file) + (progn (org-capture-put :new-buffer t) + (find-file-noselect (expand-file-name file org-directory))))) + +(defun org-capture-steal-local-variables (buffer) + "Install Org-mode local variables." + (mapc (lambda (v) + (ignore-errors (org-set-local (car v) (cdr v)))) + (buffer-local-variables buffer))) + +(defun org-capture-place-template () + "Insert the template at the target location, and display the buffer." + (org-capture-put :return-to-wconf (current-window-configuration)) + (delete-other-windows) + (org-switch-to-buffer-other-window + (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) + (widen) + (show-all) + (goto-char (org-capture-get :pos)) + (org-set-local 'org-capture-target-marker + (move-marker (make-marker) (point))) + (let* ((template (org-capture-get :template)) + (type (org-capture-get :type))) + (case type + ((nil entry) (org-capture-place-entry)) + (table-line (org-capture-place-table-line)) + (plain (org-capture-place-plain-text)) + (item (org-capture-place-item)) + (checkitem (org-capture-place-item)))) + (org-capture-mode 1) + (org-set-local 'org-capture-current-plist org-capture-plist)) + +(defun org-capture-place-entry () + "Place the template as a new Org entry." + (let* ((txt (org-capture-get :template)) + (reversed (org-capture-get :prepend)) + (target-entry-p (org-capture-get :target-entry-p)) + level beg end file) + + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Insert as top-level entry, either at beginning or at end of file + (setq level 1) + (if reversed + (progn (goto-char (point-min)) + (or (org-at-heading-p) + (outline-next-heading))) + (goto-char (point-max)) + (or (bolp) (insert "\n")))) + (t + ;; Insert as a child of the current entry + (and (looking-at "\\*+") + (setq level (- (match-end 0) (match-beginning 0)))) + (setq level (org-get-valid-level (or level 1) 1)) + (if reversed + (progn + (outline-next-heading) + (or (bolp) (insert "\n"))) + (org-end-of-subtree t t) + (or (bolp) (insert "\n"))))) + (org-capture-empty-lines-before) + (setq beg (point)) + (org-paste-subtree level txt 'for-yank) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (outline-next-heading) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (goto-char beg) + (if (re-search-forward "%\\?" end t) (replace-match "")))) + +(defun org-capture-place-item () + "Place the template as a new plain list item." + (let* ((txt (org-capture-get :template)) + (target-entry-p (org-capture-get :target-entry-p)) + (ind 0) + beg end) + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Insert as top-level entry, either at beginning or at end of file + (setq beg (point-min) end (point-max))) + (t + (setq beg (1+ (point-at-eol)) + end (save-excursion (outline-next-heading) (point))))) + (if (org-capture-get :prepend) + (progn + (goto-char beg) + (if (org-search-forward-unenclosed org-item-beginning-re end t) + (progn + (goto-char (match-beginning 0)) + (setq ind (org-get-indentation))) + (goto-char end) + (setq ind 0))) + (goto-char end) + (if (org-search-backward-unenclosed org-item-beginning-re beg t) + (progn + (setq ind (org-get-indentation)) + (org-end-of-item)) + (setq ind 0))) + ;; Remove common indentation + (setq txt (org-remove-indentation txt)) + ;; Make sure this is indeed an item + (unless (string-match (concat "\\`" (org-item-re)) txt) + (setq txt (concat "- " + (mapconcat 'identity (split-string txt "\n") + "\n ")))) + ;; Set the correct indentation, depending on context + (setq ind (make-string ind ?\ )) + (setq txt (concat ind + (mapconcat 'identity (split-string txt "\n") + (concat "\n" ind)) + "\n")) + ;; Insert, with surrounding empty lines + (org-capture-empty-lines-before) + (setq beg (point)) + (insert txt) + (or (bolp) (insert "\n")) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (forward-char 1) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (re-search-forward "%\\?" end t) (replace-match "")))) + +(defun org-capture-place-table-line () + "Place the template as a table line." + (require 'org-table) + (let* ((txt (org-capture-get :template)) + (target-entry-p (org-capture-get :target-entry-p)) + (table-line-pos (org-capture-get :table-line-pos)) + ind beg end) + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Table is not necessarily under a heading + (setq beg (point-min) end (point-max))) + (t + ;; WE are at a heading, limit search to the body + (setq beg (1+ (point-at-eol)) + end (save-excursion (outline-next-heading) (point))))) + (if (re-search-forward org-table-dataline-regexp end t) + (let ((b (org-table-begin)) (e (org-table-end))) + (goto-char e) + (if (looking-at "[ \t]*#\\+TBLFM:") + (forward-line 1)) + (narrow-to-region b (point))) + (goto-char end) + (insert "\n| |\n|----|\n| |\n") + (narrow-to-region (1+ end) (point))) + ;; We are narrowed to the table, or to an empty line if there was no table + + ;; Check if the template is good + (if (not (string-match org-table-dataline-regexp txt)) + (setq txt "| %?Bad template |\n")) + (cond + ((and table-line-pos + (string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos)) + ;; we have a complex line specification + (goto-char (point-min)) + (let ((nh (- (match-end 1) (match-beginning 1))) + (delta (string-to-number (match-string 2 table-line-pos))) + ll) + ;; The user wants a special position in the table + (org-table-get-specials) + (setq ll (ignore-errors (aref org-table-hlines nh))) + (unless ll (error "Invalid table line specification \"%s\"" + table-line-pos)) + (setq ll (+ ll delta (if (< delta 0) 0 -1))) + (org-goto-line ll) + (org-table-insert-row 'below) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (setq beg (point)) + (insert txt) + (setq end (point)))) + ((org-capture-get :prepend) + (goto-char (point-min)) + (re-search-forward org-table-hline-regexp nil t) + (beginning-of-line 1) + (re-search-forward org-table-dataline-regexp nil t) + (beginning-of-line 1) + (setq beg (point)) + (org-table-insert-row) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (insert txt) + (setq end (point))) + (t + (goto-char (point-max)) + (re-search-backward org-table-dataline-regexp nil t) + (beginning-of-line 1) + (org-table-insert-row 'below) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (setq beg (point)) + (insert txt) + (setq end (point)))) + (goto-char beg) + (org-capture-position-for-last-stored 'table-line) + (if (re-search-forward "%\\?" end t) (replace-match "")) + (org-table-align))) + +(defun org-capture-place-plain-text () + "Place the template plainly." + (let* ((txt (org-capture-get :template)) + beg end) + (goto-char (cond + ((org-capture-get :exact-position)) + ((org-capture-get :prepend) (point-min)) + (t (point-max)))) + (or (bolp) (newline)) + (org-capture-empty-lines-before) + (setq beg (point)) + (insert txt) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (re-search-forward "%\\?" end t) (replace-match "")))) + +(defun org-capture-mark-kill-region (beg end) + "Mark the region that will have to be killed when aborting capture." + (let ((m1 (move-marker (make-marker) beg)) + (m2 (move-marker (make-marker) end))) + (org-capture-put :begin-marker m1) + (org-capture-put :end-marker m2))) + +(defun org-capture-position-for-last-stored (where) + "Memorize the position that should later become the position of last capture." + (cond + ((integerp where) + (org-capture-put :position-for-last-stored + (move-marker (make-marker) where + (or (buffer-base-buffer (current-buffer)) + (current-buffer))))) + ((eq where 'table-line) + (org-capture-put :position-for-last-stored + (list 'table-line + (org-table-current-dline)))) + (t (error "This should not happen")))) + +(defun org-capture-bookmark-last-stored-position () + "Bookmark the last-captured position." + (let* ((where (org-capture-get :position-for-last-stored 'local)) + (pos (cond + ((markerp where) + (prog1 (marker-position where) + (move-marker where nil))) + ((and (listp where) (eq (car where) 'table-line)) + (if (org-at-table-p) + (save-excursion + (org-table-goto-line (nth 1 where)) + (point-at-bol)) + (point)))))) + (with-current-buffer (buffer-base-buffer (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (bookmark-set "org-capture-last-stored") + (move-marker org-capture-last-stored-marker (point))))))) + +(defun org-capture-narrow (beg end) + "Narrow, unless configuration says not to narrow." + (unless (org-capture-get :unnarrowed) + (narrow-to-region beg end) + (goto-char beg))) + +(defun org-capture-empty-lines-before (&optional n) + "Arrange for the correct number of empty lines before the insertion point. +Point will be after the empty lines, so insertion can directly be done." + (setq n (or n (org-capture-get :empty-lines) 0)) + (let ((pos (point))) + (org-back-over-empty-lines) + (delete-region (point) pos) + (if (> n 0) (newline n)))) + +(defun org-capture-empty-lines-after (&optional n) + "Arrange for the correct number of empty lines after the inserted string. +Point will remain at the first line after the inserted text." + (setq n (or n (org-capture-get :empty-lines) 0)) + (org-back-over-empty-lines) + (while (looking-at "[ \t]*\n") (replace-match "")) + (let ((pos (point))) + (if (> n 0) (newline n)) + (goto-char pos))) + +(defvar org-clock-marker) ; Defined in org.el +;;;###autoload +(defun org-capture-insert-template-here () + (let* ((template (org-capture-get :template)) + (type (org-capture-get :type)) + beg end pp) + (or (bolp) (newline)) + (setq beg (point)) + (cond + ((and (eq type 'entry) (org-mode-p)) + (org-paste-subtree nil template t)) + ((and (memq type '(item checkitem)) + (org-mode-p) + (save-excursion (skip-chars-backward " \t\n") + (setq pp (point)) + (org-in-item-p))) + (goto-char pp) + (org-insert-item) + (skip-chars-backward " ") + (skip-chars-backward "-+*0123456789).") + (delete-region (point) (point-at-eol)) + (setq beg (point)) + (org-remove-indentation template) + (insert template) + (org-capture-empty-lines-after) + (goto-char beg) + (org-list-repair) + (org-end-of-item) + (setq end (point))) + (t (insert template))) + (setq end (point)) + (goto-char beg) + (if (re-search-forward "%\\?" end t) + (replace-match "")))) + +(defun org-capture-set-plist (entry) + "Initialize the property list from the template definition." + (setq org-capture-plist (copy-sequence (nthcdr 5 entry))) + (org-capture-put :key (car entry) :description (nth 1 entry) + :target (nth 3 entry)) + (let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry))) + (when (or (not txt) (and (stringp txt) (not (string-match "\\S-" txt)))) + ;; The template may be empty or omitted for special types. + ;; Here we insert the default templates for such cases. + (cond + ((eq type 'item) (setq txt "- %?")) + ((eq type 'checkitem) (setq txt "- [ ] %?")) + ((eq type 'table-line) (setq txt "| %? |")) + ((member type '(nil entry)) (setq txt "* %?\n %a")))) + (org-capture-put :template txt :type type))) + +(defun org-capture-goto-target (&optional template-key) + "Go to the target location of a capture template. +The user is queried for the template." + (interactive) + (let* (org-select-template-temp-major-mode + (entry (org-capture-select-template template-key))) + (unless entry + (error "No capture template selected")) + (org-capture-set-plist entry) + (org-capture-set-target-location) + (switch-to-buffer (org-capture-get :buffer)) + (goto-char (org-capture-get :pos)))) + +(defun org-capture-get-indirect-buffer (&optional buffer prefix) + "Make an indirect buffer for a capture process. +Use PREFIX as a prefix for the name of the indirect buffer." + (setq buffer (or buffer (current-buffer))) + (let ((n 1) (base (buffer-name buffer)) bname) + (setq bname (concat prefix "-" base)) + (while (buffer-live-p (get-buffer bname)) + (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base))) + (condition-case nil + (make-indirect-buffer buffer bname 'clone) + (error (make-indirect-buffer buffer bname))))) + + +;;; The template code + +(defun org-capture-select-template (&optional keys) + "Select a capture template. +Lisp programs can force the template by setting KEYS to a string." + (if org-capture-templates + (if keys + (or (assoc keys org-capture-templates) + (error "No capture template referred to by \"%s\" keys" keys)) + (if (= 1 (length org-capture-templates)) + (car org-capture-templates) + (org-mks org-capture-templates + "Select a capture template\n=========================" + "Template key: " + '(("C" "Customize org-capture-templates") + ("q" "Abort"))))) + ;; Use an arbitrary default template + '("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a"))) + +(defun org-capture-fill-template (&optional template initial annotation) + "Fill a template and return the filled template as a string. +The template may still contain \"%?\" for cursor positioning." + (setq template (or template (org-capture-get :template))) + (when (stringp initial) + (setq initial (org-no-properties initial)) + (remove-text-properties 0 (length initial) '(read-only t) initial)) + (let* ((buffer (org-capture-get :buffer)) + (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) + (ct (org-capture-get :default-time)) + (dct (decode-time ct)) + (ct1 + (if (< (nth 2 dct) org-extend-today-until) + (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) + ct)) + (plist-p (if org-store-link-plist t nil)) + (v-c (and (> (length kill-ring) 0) (current-kill 0))) + (v-x (or (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY))) + (v-t (format-time-string (car org-time-stamp-formats) ct)) + (v-T (format-time-string (cdr org-time-stamp-formats) ct)) + (v-u (concat "[" (substring v-t 1 -1) "]")) + (v-U (concat "[" (substring v-T 1 -1) "]")) + ;; `initial' and `annotation' might habe been passed. + ;; But if the property list has them, we prefer those values + (v-i (or (plist-get org-store-link-plist :initial) + initial + (org-capture-get :initial) + "")) + (v-a (or (plist-get org-store-link-plist :annotation) + annotation + (org-capture-get :annotation) + "")) + ;; Is the link empty? Then we do not want it... + (v-a (if (equal v-a "[[]]") "" v-a)) + (clipboards (remove nil (list v-i + (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY) + v-c))) + (v-A (if (and v-a + (string-match + "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a)) + (replace-match "[\\1[%^{Link description}]]" nil nil v-a) + v-a)) + (v-n user-full-name) + (v-k (if (marker-buffer org-clock-marker) + (org-substring-no-properties org-clock-heading))) + (v-K (if (marker-buffer org-clock-marker) + (org-make-link-string + (buffer-file-name (marker-buffer org-clock-marker)) + org-clock-heading))) + v-I + (org-startup-folded nil) + (org-inhibit-startup t) + org-time-was-given org-end-time-was-given x + prompt completions char time pos default histvar) + + (setq org-store-link-plist + (plist-put org-store-link-plist :annotation v-a) + org-store-link-plist + (plist-put org-store-link-plist :initial v-i)) + (setq initial v-i) + + (unless template (setq template "") (message "No template") (ding) + (sit-for 1)) + (save-window-excursion + (delete-other-windows) + (switch-to-buffer (get-buffer-create "*Capture*")) + (erase-buffer) + (insert template) + (goto-char (point-min)) + (org-capture-steal-local-variables buffer) + (setq buffer-file-name nil) + + ;; %[] Insert contents of a file. + (goto-char (point-min)) + (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) + (unless (org-capture-escaped-%) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (filename (expand-file-name (match-string 1)))) + (goto-char start) + (delete-region start end) + (condition-case error + (insert-file-contents filename) + (error (insert (format "%%![Couldn't insert %s: %s]" + filename error))))))) + ;; %() embedded elisp + (goto-char (point-min)) + (while (re-search-forward "%\\((.+)\\)" nil t) + (unless (org-capture-escaped-%) + (goto-char (match-beginning 0)) + (let ((template-start (point))) + (forward-char 1) + (let ((result + (condition-case error + (eval (read (current-buffer))) + (error (format "%%![Error: %s]" error))))) + (delete-region template-start (point)) + (insert result))))) + + ;; Simple %-escapes + (goto-char (point-min)) + (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) + (unless (org-capture-escaped-%) + (when (and initial (equal (match-string 0) "%i")) + (save-match-data + (let* ((lead (buffer-substring + (point-at-bol) (match-beginning 0)))) + (setq v-i (mapconcat 'identity + (org-split-string initial "\n") + (concat "\n" lead)))))) + (replace-match + (or (eval (intern (concat "v-" (match-string 1)))) "") + t t))) + + ;; From the property list + (when plist-p + (goto-char (point-min)) + (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) + (unless (org-capture-escaped-%) + (and (setq x (or (plist-get org-store-link-plist + (intern (match-string 1))) "")) + (replace-match x t t))))) + + ;; Turn on org-mode in temp buffer, set local variables + ;; This is to support completion in interactive prompts + (let ((org-inhibit-startup t)) (org-mode)) + ;; Interactive template entries + (goto-char (point-min)) + (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" + nil t) + (unless (org-capture-escaped-%) + (setq char (if (match-end 3) (match-string 3)) + prompt (if (match-end 2) (match-string 2))) + (goto-char (match-beginning 0)) + (replace-match "") + (setq completions nil default nil) + (when prompt + (setq completions (org-split-string prompt "|") + prompt (pop completions) + default (car completions) + histvar (intern (concat + "org-capture-template-prompt-history::" + (or prompt ""))) + completions (mapcar 'list completions))) + (unless (boundp histvar) (set histvar nil)) + (cond + ((member char '("G" "g")) + (let* ((org-last-tags-completion-table + (org-global-tags-completion-table + (if (equal char "G") + (org-agenda-files) + (and file (list file))))) + (org-add-colon-after-tag-completion t) + (ins (org-icompleting-read + (if prompt (concat prompt ": ") "Tags: ") + 'org-tags-completion-function nil nil nil + 'org-tags-history))) + (setq ins (mapconcat 'identity + (org-split-string + ins (org-re "[^[:alnum:]_@#%]+")) + ":")) + (when (string-match "\\S-" ins) + (or (equal (char-before) ?:) (insert ":")) + (insert ins) + (or (equal (char-after) ?:) (insert ":")) + (and (org-on-heading-p) (org-set-tags nil 'align))))) + ((equal char "C") + (cond ((= (length clipboards) 1) (insert (car clipboards))) + ((> (length clipboards) 1) + (insert (read-string "Clipboard/kill value: " + (car clipboards) '(clipboards . 1) + (car clipboards)))))) + ((equal char "L") + (cond ((= (length clipboards) 1) + (org-insert-link 0 (car clipboards))) + ((> (length clipboards) 1) + (org-insert-link 0 (read-string "Clipboard/kill value: " + (car clipboards) + '(clipboards . 1) + (car clipboards)))))) + ((equal char "p") + (let* + ((prop (org-substring-no-properties prompt)) + (pall (concat prop "_ALL")) + (allowed + (with-current-buffer + (get-buffer (file-name-nondirectory file)) + (or (cdr (assoc pall org-file-properties)) + (cdr (assoc pall org-global-properties)) + (cdr (assoc pall org-global-properties-fixed))))) + (existing (with-current-buffer + (get-buffer (file-name-nondirectory file)) + (mapcar 'list (org-property-values prop)))) + (propprompt (concat "Value for " prop ": ")) + (val (if allowed + (org-completing-read + propprompt + (mapcar 'list (org-split-string allowed + "[ \t]+")) + nil 'req-match) + (org-completing-read-no-i propprompt + existing nil nil + "" nil "")))) + (org-set-property prop val))) + (char + ;; These are the date/time related ones + (setq org-time-was-given (equal (upcase char) char)) + (setq time (org-read-date (equal (upcase char) char) t nil + prompt)) + (if (equal (upcase char) char) (setq org-time-was-given t)) + (org-insert-time-stamp time org-time-was-given + (member char '("u" "U")) + nil nil (list org-end-time-was-given))) + (t + (let (org-completion-use-ido) + (insert (org-completing-read-no-i + (concat (if prompt prompt "Enter string") + (if default (concat " [" default "]")) + ": ") + completions nil nil nil histvar default))))))) + ;; Make sure there are no empty lines before the text, and that + ;; it ends with a newline character + (goto-char (point-min)) + (while (looking-at "[ \t]*\n") (replace-match "")) + (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n")) + ;; Return the expanded tempate and kill the temporary buffer + (untabify (point-min) (point-max)) + (set-buffer-modified-p nil) + (prog1 (buffer-string) (kill-buffer (current-buffer)))))) + +(defun org-capture-escaped-% () + "Check if % was escaped - if yes, unescape it now." + (if (equal (char-before (match-beginning 0)) ?\\) + (progn + (delete-region (1- (match-beginning 0)) (match-beginning 0)) + t) + nil)) + +;;;###autoload +(defun org-capture-import-remember-templates () + "Set org-capture-templates to be similar to `org-remember-templates'." + (interactive) + (when (and (yes-or-no-p + "Import old remember templates into org-capture-templates? ") + (yes-or-no-p + "Note that this will remove any templates currently defined in `org-capture-templates'. Do you still want to go ahead? ")) + (require 'org-remember) + (setq org-capture-templates + (mapcar + (lambda (entry) + (let ((desc (car entry)) + (key (char-to-string (nth 1 entry))) + (template (nth 2 entry)) + (file (or (nth 3 entry) org-default-notes-file)) + (position (or (nth 4 entry) org-remember-default-headline)) + (type 'entry) + (prepend org-reverse-note-order) + immediate target) + (cond + ((member position '(top bottom)) + (setq target (list 'file file) + prepend (eq position 'top))) + ((eq position 'date-tree) + (setq target (list 'file+datetree file) + prepend nil)) + (t (setq target (list 'file+headline file position)))) + + (when (string-match "%!" template) + (setq template (replace-match "" t t template) + immediate t)) + + (append (list key desc type target template) + (if prepend '(:prepend t)) + (if immediate '(:immediate-finish t))))) + + org-remember-templates)))) + +(provide 'org-capture) + +;; arch-tag: 986bf41b-8ada-4e28-bf20-e8388a7205a0 + +;;; org-capture.el ends here diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index c6f5f03ff8d..d2f8317a074 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -29,11 +29,13 @@ ;; This file contains the time clocking code for Org-mode (require 'org) +;;; Code: + (eval-when-compile - (require 'cl) - (require 'calendar)) + (require 'cl)) -(declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) +(declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) +(declare-function notifications-notify "notifications" (&rest params)) (defvar org-time-stamp-formats) (defgroup org-clock nil @@ -63,20 +65,27 @@ which see." (defcustom org-clock-out-when-done t "When non-nil, clock will be stopped when the clocked entry is marked DONE. -A nil value means, clock will keep running until stopped explicitly with -`C-c C-x C-o', or until the clock is started in a different item." +DONE here means any DONE-like state. +A nil value means clock will keep running until stopped explicitly with +`C-c C-x C-o', or until the clock is started in a different item. +Instead of t, this can also be a list of TODO states that should trigger +clocking out." :group 'org-clock - :type 'boolean) + :type '(choice + (const :tag "No" nil) + (const :tag "Yes, when done" t) + (repeat :tag "State list" + (string :tag "TODO keyword")))) (defcustom org-clock-out-remove-zero-time-clocks nil - "Non-nil means, remove the clock line when the resulting time is zero." + "Non-nil means remove the clock line when the resulting time is zero." :group 'org-clock :type 'boolean) (defcustom org-clock-in-switch-to-state nil "Set task to a special todo state while clocking it. The value should be the state to which the entry should be -switched. If the value is a function, it must take one +switched. If the value is a function, it must take one parameter (the current TODO state of the item) and return the state to switch it to." :group 'org-clock @@ -89,7 +98,7 @@ state to switch it to." (defcustom org-clock-out-switch-to-state nil "Set task to a special todo state after clocking out. The value should be the state to which the entry should be -switched. If the value is a function, it must take one +switched. If the value is a function, it must take one parameter (the current TODO state of the item) and return the state to switch it to." :group 'org-clock @@ -105,7 +114,7 @@ state to switch it to." :type 'integer) (defcustom org-clock-goto-may-find-recent-task t - "Non-nil means, `org-clock-goto' can go to recent task if no active clock." + "Non-nil means `org-clock-goto' can go to recent task if no active clock." :group 'org-clock :type 'boolean) @@ -117,7 +126,7 @@ The function is called with point at the beginning of the headline." :type 'function) (defcustom org-clock-string-limit 0 - "Maximum length of clock strings in the modeline. 0 means no limit." + "Maximum length of clock strings in the modeline. 0 means no limit." :group 'org-clock :type 'integer) @@ -129,8 +138,8 @@ the clock can be resumed from that point." :type 'boolean) (defcustom org-clock-persist nil - "When non-nil, save the running clock when emacs is closed. -The clock is resumed when emacs restarts. + "When non-nil, save the running clock when Emacs is closed. +The clock is resumed when Emacs restarts. When this is t, both the running clock, and the entire clock history are saved. When this is the symbol `clock', only the running clock is saved. @@ -193,6 +202,17 @@ auto Automatically, either `all', or `repeat' for repeating tasks" (const :tag "All task time" all) (const :tag "Automatically, `all' or since `repeat'" auto))) +(defcustom org-task-overrun-text nil + "The extra modeline text that should indicate that the clock is overrun. +The can be nil to indicate that instead of adding text, the clock time +should get a different face (`org-mode-line-clock-overrun'). +When this is a string, it is prepended to the clock string as an indication, +also using the face `org-mode-line-clock-overrun'." + :group 'org-clock + :type '(choice + (const :tag "Just mark the time string" nil) + (string :tag "Text to prepend"))) + (defcustom org-show-notification-handler nil "Function or program to send notification with. The function or program will be called with the notification @@ -202,11 +222,48 @@ string as argument." (string :tag "Program") (function :tag "Function"))) -(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file) - "Default properties for new clocktables." +(defgroup org-clocktable nil + "Options concerning the clock table in Org-mode." + :tag "Org Clock Table" + :group 'org-clock) + +(defcustom org-clocktable-defaults + (list + :maxlevel 2 + :scope 'file + :block nil + :tstart nil + :tend nil + :step nil + :stepskip0 nil + :fileskip0 nil + :tags nil + :emphasize nil + :link nil + :narrow '40! + :indent t + :formula nil + :timestamp nil + :level nil + :tcolumns nil + :formatter nil) + "Default properties for clock tables." :group 'org-clock :type 'plist) +(defcustom org-clock-clocktable-formatter 'org-clocktable-write-default + "Function to turn clocking data into a table. +For more information, see `org-clocktable-write-default'." + :group 'org-clocktable + :type 'function) + +(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file) + "Default properties for new clocktables. +These will be inserted into the BEGIN line, to make it easy for users to +play with them." + :group 'org-clocktable + :type 'plist) + (defcustom org-clock-idle-time nil "When non-nil, resolve open clocks if the user is idle more than X minutes." :group 'org-clock @@ -222,6 +279,16 @@ string as argument." (const :tag "Always" t) (const :tag "When no clock is running" when-no-clock-is-running))) +(defcustom org-clock-report-include-clocking-task nil + "When non-nil, include the current clocking task time in clock reports." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-resolve-expert nil + "Non-nil means do not show the splash buffer with the clock resolver." + :group 'org-clock + :type 'boolean) + (defvar org-clock-in-prepare-hook nil "Hook run when preparing the clock. This hook is run before anything happens to the task that @@ -250,11 +317,11 @@ to add an effort property.") (defvar org-clock-heading-for-remember "") (defvar org-clock-start-time "") -(defvar org-clock-left-over-time nil +(defvar org-clock-leftover-time nil "If non-nil, user cancelled a clock; this is when leftover time started.") (defvar org-clock-effort "" - "Effort estimate of the currently clocking task") + "Effort estimate of the currently clocking task.") (defvar org-clock-total-time nil "Holds total time, spent previously on currently clocked item. @@ -287,7 +354,10 @@ of a different task.") (defun org-clock-history-push (&optional pos buffer) "Push a marker to the clock history." (setq org-clock-history-length (max 1 (min 35 org-clock-history-length))) - (let ((m (move-marker (make-marker) (or pos (point)) buffer)) n l) + (let ((m (move-marker (make-marker) + (or pos (point)) (org-base-buffer + (or buffer (current-buffer))))) + n l) (while (setq n (member m org-clock-history)) (move-marker (car n) nil)) (setq org-clock-history @@ -310,6 +380,14 @@ of a different task.") (mapc (lambda (m) (org-check-and-save-marker m beg end)) org-clock-history)) +(defun org-clocking-buffer () + "Return the clocking buffer if we are currently clocking a task or nil." + (marker-buffer org-clock-marker)) + +(defun org-clocking-p () + "Return t when clocking a task." + (not (equal (org-clocking-buffer) nil))) + (defun org-clock-select-task (&optional prompt) "Select a task that recently was associated with clocking." (interactive) @@ -326,7 +404,7 @@ of a different task.") (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold)) (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task)) (push s sel-list)) - (when (marker-buffer org-clock-marker) + (when (org-clocking-p) (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold)) (setq s (org-clock-insert-selection-line ?c org-clock-marker)) (push s sel-list)) @@ -339,6 +417,7 @@ of a different task.") (if (< i 10) (+ i ?0) (+ i (- ?A 10))) m)) + (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) (push s sel-list))) org-clock-history) (org-fit-window-to-buffer) @@ -360,56 +439,82 @@ pointing to it." (save-excursion (save-restriction (widen) - (goto-char marker) - (setq file (buffer-file-name (marker-buffer marker)) - cat (or (org-get-category) - (progn (org-refresh-category-properties) - (org-get-category))) - heading (org-get-heading 'notags) - prefix (save-excursion - (org-back-to-heading t) - (looking-at "\\*+ ") - (match-string 0)) - task (substring - (org-fontify-like-in-org-mode - (concat prefix heading) - org-odd-levels-only) - (length prefix)))))) + (ignore-errors + (goto-char marker) + (setq file (buffer-file-name (marker-buffer marker)) + cat (or (org-get-category) + (progn (org-refresh-category-properties) + (org-get-category))) + heading (org-get-heading 'notags) + prefix (save-excursion + (org-back-to-heading t) + (looking-at "\\*+ ") + (match-string 0)) + task (substring + (org-fontify-like-in-org-mode + (concat prefix heading) + org-odd-levels-only) + (length prefix))))))) (when (and cat task) (insert (format "[%c] %-15s %s\n" i cat task)) (cons i marker))))) +(defvar org-task-overrun nil + "Internal flag indicating if the clock has overrun the planned time.") +(defvar org-clock-update-period 60 + "Number of seconds between mode line clock string updates.") + (defun org-clock-get-clock-string () - "Form a clock-string, that will be show in the mode line. -If an effort estimate was defined for current item, use + "Form a clock-string, that will be shown in the mode line. +If an effort estimate was defined for the current item, use 01:30/01:50 format (clocked/estimated). If not, show simply the clocked time like 01:50." (let* ((clocked-time (org-clock-get-clocked-time)) (h (floor clocked-time 60)) (m (- clocked-time (* 60 h)))) - (if (and org-clock-effort) - (let* ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort)) + (if org-clock-effort + (let* ((effort-in-minutes + (org-hh:mm-string-to-minutes org-clock-effort)) (effort-h (floor effort-in-minutes 60)) - (effort-m (- effort-in-minutes (* effort-h 60)))) - (format (concat "-[" org-time-clocksum-format "/" org-time-clocksum-format " (%s)]") - h m effort-h effort-m org-clock-heading)) - (format (concat "-[" org-time-clocksum-format " (%s)]") - h m org-clock-heading)))) + (effort-m (- effort-in-minutes (* effort-h 60))) + (work-done-str + (org-propertize + (format org-time-clocksum-format h m) + 'face (if (and org-task-overrun (not org-task-overrun-text)) + 'org-mode-line-clock-overrun 'org-mode-line-clock))) + (effort-str (format org-time-clocksum-format effort-h effort-m)) + (clockstr (org-propertize + (concat "[%s/" effort-str + "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") + 'face 'org-mode-line-clock))) + (format clockstr work-done-str)) + (org-propertize (format + (concat "[" org-time-clocksum-format " (%s)]") + h m org-clock-heading) + 'face 'org-mode-line-clock)))) (defun org-clock-update-mode-line () + (if org-clock-effort + (org-clock-notify-once-if-expired) + (setq org-task-overrun nil)) (setq org-mode-line-string (org-propertize (let ((clock-string (org-clock-get-clock-string)) (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task")) (if (and (> org-clock-string-limit 0) (> (length clock-string) org-clock-string-limit)) - (org-propertize (substring clock-string 0 org-clock-string-limit) - 'help-echo (concat help-text ": " org-clock-heading)) + (org-propertize + (substring clock-string 0 org-clock-string-limit) + 'help-echo (concat help-text ": " org-clock-heading)) (org-propertize clock-string 'help-echo help-text))) 'local-map org-clock-mode-line-map 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight) - 'face 'org-mode-line-clock)) - (if org-clock-effort (org-clock-notify-once-if-expired)) + )) + (if (and org-task-overrun org-task-overrun-text) + (setq org-mode-line-string + (concat (org-propertize + org-task-overrun-text + 'face 'org-mode-line-clock-overrun) org-mode-line-string))) (force-mode-line-update)) (defun org-clock-get-clocked-time () @@ -443,7 +548,8 @@ the mode line." ;; A string. See if it is a delta (setq sign (string-to-char value)) (if (member sign '(?- ?+)) - (setq current (org-hh:mm-string-to-minutes (substring current 1))) + (setq current (org-hh:mm-string-to-minutes current) + value (substring value 1)) (setq current 0)) (setq value (org-hh:mm-string-to-minutes value)) (if (equal ?- sign) @@ -461,10 +567,13 @@ the mode line." (defun org-clock-notify-once-if-expired () "Show notification if we spent more time than we estimated before. Notification is shown only once." - (when (marker-buffer org-clock-marker) + (when (org-clocking-p) (let ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort)) (clocked-time (org-clock-get-clocked-time))) - (if (>= clocked-time effort-in-minutes) + (if (setq org-task-overrun + (if (or (null effort-in-minutes) (zerop effort-in-minutes)) + nil + (>= clocked-time effort-in-minutes))) (unless org-clock-notification-was-shown (setq org-clock-notification-was-shown t) (org-notify @@ -486,6 +595,14 @@ use libnotify if available, or fall back on a message." ((stringp org-show-notification-handler) (start-process "emacs-timer-notification" nil org-show-notification-handler notification)) + ((featurep 'notifications) + (require 'notifications) + (notifications-notify + :title "Org-mode message" + :body notification + ;; FIXME how to link to the Org icon? + ;; :app-icon "~/.emacs.d/icons/mail.png" + :urgency 'low)) ((org-program-exists "notify-send") (start-process "emacs-timer-notification" nil "notify-send" notification)) @@ -526,7 +643,7 @@ Use alsa's aplay tool if available." (save-excursion (goto-char (point-min)) (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t) - (push (cons (copy-marker (1- (match-end 1)) t) + (push (cons (copy-marker (match-end 1) t) (org-time-string-to-time (match-string 1))) clocks)))) clocks)) @@ -563,12 +680,12 @@ This macro also protects the current active clock from being altered." (put 'org-with-clock 'lisp-indent-function 1) -(defsubst org-clock-clock-in (clock &optional resume) +(defsubst org-clock-clock-in (clock &optional resume start-time) "Clock in to the clock located by CLOCK. If necessary, clock-out of the currently active clock." (org-with-clock-position clock (let ((org-clock-in-resume (or resume org-clock-in-resume))) - (org-clock-in)))) + (org-clock-in nil start-time)))) (defsubst org-clock-clock-out (clock &optional fail-quietly at-time) "Clock out of the clock located by CLOCK." @@ -594,39 +711,10 @@ If necessary, clock-out of the currently active clock." (defvar org-clock-resolving-clocks nil) (defvar org-clock-resolving-clocks-due-to-idleness nil) -(defun org-clock-resolve-clock (clock resolve-to &optional close-p - restart-p fail-quietly) +(defun org-clock-resolve-clock (clock resolve-to clock-out-time + &optional close-p restart-p fail-quietly) "Resolve `CLOCK' given the time `RESOLVE-TO', and the present. -`CLOCK' is a cons cell of the form (MARKER START-TIME). -This routine can do one of many things: - - if `RESOLVE-TO' is nil - if `CLOSE-P' is non-nil, give an error - if this clock is the active clock, cancel it - else delete the clock line (as if it never happened) - if `RESTART-P' is non-nil, start a new clock - - else if `RESOLVE-TO' is the symbol `now' - if `RESTART-P' is non-nil, give an error - if `CLOSE-P' is non-nil, clock out the entry and - if this clock is the active clock, stop it - else if this clock is the active clock, do nothing - else if there is no active clock, resume this clock - else ask to cancel the active clock, and if so, - resume this clock after cancelling it - - else if `RESOLVE-TO' is some date in the future - give an error about `RESOLVE-TO' being invalid - - else if `RESOLVE-TO' is some date in the past - if `RESTART-P' is non-nil, give an error - if `CLOSE-P' is non-nil, enter a closing time and - if this clock is the active clock, stop it - else if this clock is the active clock, enter a - closing time, stop the current clock, then - start a new clock for the same item - else just enter a closing time for this clock - and then start a new clock for the same item" +`CLOCK' is a cons cell of the form (MARKER START-TIME)." (let ((org-clock-resolving-clocks t)) (cond ((null resolve-to) @@ -648,11 +736,41 @@ This routine can do one of many things: (t (if restart-p (error "RESTART-P is not valid here")) - (org-clock-clock-out clock fail-quietly resolve-to) + (org-clock-clock-out clock fail-quietly (or clock-out-time + resolve-to)) (unless org-clock-clocking-in (if close-p - (setq org-clock-left-over-time resolve-to) - (org-clock-clock-in clock))))))) + (setq org-clock-leftover-time (and (null clock-out-time) + resolve-to)) + (org-clock-clock-in clock nil (and clock-out-time + resolve-to)))))))) + +(defun org-clock-jump-to-current-clock (&optional effective-clock) + (interactive) + (let ((clock (or effective-clock (cons org-clock-marker + org-clock-start-time)))) + (unless (marker-buffer (car clock)) + (error "No clock is currently running")) + (org-with-clock clock (org-clock-goto)) + (with-current-buffer (marker-buffer (car clock)) + (goto-char (car clock)) + (if org-clock-into-drawer + (let ((logbook + (if (stringp org-clock-into-drawer) + (concat ":" org-clock-into-drawer ":") + ":LOGBOOK:"))) + (ignore-errors + (outline-flag-region + (save-excursion + (outline-back-to-heading t) + (search-forward logbook) + (goto-char (match-beginning 0))) + (save-excursion + (outline-back-to-heading t) + (search-forward logbook) + (search-forward ":END:") + (goto-char (match-end 0))) + nil))))))) (defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) "Resolve an open org-mode clock. @@ -678,44 +796,66 @@ was started." (save-window-excursion (save-excursion (unless org-clock-resolving-clocks-due-to-idleness - (org-with-clock clock (org-clock-goto)) - (with-current-buffer (marker-buffer (car clock)) - (goto-char (car clock)) - (if org-clock-into-drawer - (let ((logbook - (if (stringp org-clock-into-drawer) - (concat ":" org-clock-into-drawer ":") - ":LOGBOOK:"))) - (ignore-errors - (outline-flag-region - (save-excursion - (outline-back-to-heading t) - (search-forward logbook) - (goto-char (match-beginning 0))) - (save-excursion - (outline-back-to-heading t) - (search-forward logbook) - (search-forward ":END:") - (goto-char (match-end 0))) - nil)))))) + (org-clock-jump-to-current-clock clock)) + (unless org-clock-resolve-expert + (with-output-to-temp-buffer "*Org Clock*" + (princ "Select a Clock Resolution Command: + +i/q/C-g Ignore this question; the same as keeping all the idle time. + +k/K Keep X minutes of the idle time (default is all). If this + amount is less than the default, you will be clocked out + that many minutes after the time that idling began, and then + clocked back in at the present time. +g/G Indicate that you \"got back\" X minutes ago. This is quite + different from 'k': it clocks you out from the beginning of + the idle period and clock you back in X minutes ago. +s/S Subtract the idle time from the current clock. This is the + same as keeping 0 minutes. +C Cancel the open timer altogether. It will be as though you + never clocked in. +j/J Jump to the current clock, to make manual adjustments. + +For all these options, using uppercase makes your final state +to be CLOCKED OUT."))) + (org-fit-window-to-buffer (get-buffer-window "*Org Clock*")) (let (char-pressed) - (while (null char-pressed) + (when (featurep 'xemacs) + (message (concat (funcall prompt-fn clock) + " [jkKgGsScCiq]? ")) + (setq char-pressed (read-char-exclusive))) + (while (or (null char-pressed) + (and (not (memq char-pressed + '(?k ?K ?g ?G ?s ?S ?C + ?j ?J ?i ?q))) + (or (ding) t))) (setq char-pressed (read-char (concat (funcall prompt-fn clock) - " [(kK)eep (sS)ubtract (C)ancel]? ") + " [jkKgGSscCiq]? ") nil 45))) - char-pressed)))) - (default (floor (/ (org-float-time - (time-subtract (current-time) last-valid)) 60))) - (keep (and (memq ch '(?k ?K)) - (read-number "Keep how many minutes? " default))) + (and (not (memq char-pressed '(?i ?q))) char-pressed))))) + (default + (floor (/ (org-float-time + (time-subtract (current-time) last-valid)) 60))) + (keep + (and (memq ch '(?k ?K)) + (read-number "Keep how many minutes? " default))) + (gotback + (and (memq ch '(?g ?G)) + (read-number "Got back how many minutes ago? " default))) (subtractp (memq ch '(?s ?S))) (barely-started-p (< (- (org-float-time last-valid) (org-float-time (cdr clock))) 45)) (start-over (and subtractp barely-started-p))) - (if (or (null ch) - (not (memq ch '(?k ?K ?s ?S ?C)))) - (message "") + (cond + ((memq ch '(?j ?J)) + (if (eq ch ?J) + (org-clock-resolve-clock clock 'now nil t nil fail-quietly)) + (org-clock-jump-to-current-clock clock)) + ((or (null ch) + (not (memq ch '(?k ?K ?g ?G ?s ?S ?C)))) + (message "")) + (t (org-clock-resolve-clock clock (cond ((or (eq ch ?C) @@ -724,21 +864,29 @@ was started." ;; time... start-over) nil) - (subtractp + ((or subtractp + (and gotback (= gotback 0))) last-valid) - ((= keep default) + ((or (and keep (= keep default)) + (and gotback (= gotback default))) 'now) + (keep + (time-add last-valid (seconds-to-time (* 60 keep)))) + (gotback + (time-subtract (current-time) + (seconds-to-time (* 60 gotback)))) (t - (time-add last-valid (seconds-to-time (* 60 keep))))) - (memq ch '(?K ?S)) + (error "Unexpected, please report this as a bug"))) + (and gotback last-valid) + (memq ch '(?K ?G ?S)) (and start-over - (not (memq ch '(?K ?S ?C)))) - fail-quietly)))) + (not (memq ch '(?K ?G ?S ?C)))) + fail-quietly))))) -(defun org-resolve-clocks (&optional also-non-dangling-p prompt-fn last-valid) +(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid) "Resolve all currently open org-mode clocks. -If `also-non-dangling-p' is non-nil, also ask to resolve -non-dangling (i.e., currently open and valid) clocks." +If `only-dangling-p' is non-nil, only ask to resolve dangling +\(i.e., not currently open and valid) clocks." (interactive "P") (unless org-clock-resolving-clocks (let ((org-clock-resolving-clocks t)) @@ -747,7 +895,7 @@ non-dangling (i.e., currently open and valid) clocks." (dolist (clock clocks) (let ((dangling (or (not (org-clock-is-active)) (/= (car clock) org-clock-marker)))) - (unless (and (not dangling) (not also-non-dangling-p)) + (if (or (not only-dangling-p) dangling) (org-clock-resolve clock (or prompt-fn @@ -769,27 +917,23 @@ non-dangling (i.e., currently open and valid) clocks." 0))) (defun org-mac-idle-seconds () - "Return the current Mac idle time in seconds" + "Return the current Mac idle time in seconds." (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'"))) (defun org-x11-idle-seconds () - "Return the current X11 idle time in seconds" + "Return the current X11 idle time in seconds." (/ (string-to-number (shell-command-to-string "x11idle")) 1000)) (defun org-user-idle-seconds () "Return the number of seconds the user has been idle for. This routine returns a floating point number." - (if (or (eq system-type 'darwin) (eq window-system 'x)) - (let ((emacs-idle (org-emacs-idle-seconds))) - ;; If Emacs has been idle for longer than the user's - ;; `org-clock-idle-time' value, check whether the whole system has - ;; really been idle for that long. - (if (> emacs-idle (* 60 org-clock-idle-time)) - (min emacs-idle (if (eq system-type 'darwin) - (org-mac-idle-seconds) - (org-x11-idle-seconds))) - emacs-idle)) - (org-emacs-idle-seconds))) + (cond + ((eq system-type 'darwin) + (org-mac-idle-seconds)) + ((eq window-system 'x) + (org-x11-idle-seconds)) + (t + (org-emacs-idle-seconds)))) (defvar org-clock-user-idle-seconds) @@ -800,11 +944,11 @@ if the user really wants to stay clocked in after being idle for so long." (when (and org-clock-idle-time (not org-clock-resolving-clocks) org-clock-marker) - (let ((org-clock-user-idle-seconds (org-user-idle-seconds)) - (org-clock-user-idle-start - (time-subtract (current-time) - (seconds-to-time org-clock-user-idle-seconds))) - (org-clock-resolving-clocks-due-to-idleness t)) + (let* ((org-clock-user-idle-seconds (org-user-idle-seconds)) + (org-clock-user-idle-start + (time-subtract (current-time) + (seconds-to-time org-clock-user-idle-seconds))) + (org-clock-resolving-clocks-due-to-idleness t)) (if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time)) (org-clock-resolve (cons org-clock-marker @@ -818,27 +962,29 @@ so long." 60.0)))) org-clock-user-idle-start))))) -(defun org-clock-in (&optional select) +(defun org-clock-in (&optional select start-time) "Start the clock on the current item. If necessary, clock-out of the currently active clock. -With prefix arg SELECT, offer a list of recently clocked tasks to -clock into. When SELECT is `C-u C-u', clock into the current task and mark +With a prefix argument SELECT (\\[universal-argument]), offer a list of \ +recently clocked tasks to +clock into. When SELECT is \\[universal-argument] \\[universal-argument], \ +clock into the current task and mark is as the default task, a special task that will always be offered in the clocking selection, associated with the letter `d'." (interactive "P") (setq org-clock-notification-was-shown nil) (catch 'abort (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) - (marker-buffer org-clock-marker))) + (org-clocking-p))) ts selected-task target-pos (msg-extra "") - (left-over (and (not org-clock-resolving-clocks) - org-clock-left-over-time))) + (leftover (and (not org-clock-resolving-clocks) + org-clock-leftover-time))) (when (and org-clock-auto-clock-resolution (or (not interrupting) (eq t org-clock-auto-clock-resolution)) (not org-clock-clocking-in) (not org-clock-resolving-clocks)) - (setq org-clock-left-over-time nil) + (setq org-clock-leftover-time nil) (let ((org-clock-clocking-in t)) (org-resolve-clocks))) ; check if any clocks are dangling (when (equal select '(4)) @@ -849,15 +995,30 @@ the clocking selection, associated with the letter `d'." (when interrupting ;; We are interrupting the clocking of a different task. ;; Save a marker to this task, so that we can go back. + ;; First check if we are trying to clock into the same task! + (when (save-excursion + (unless selected-task + (org-back-to-heading t)) + (and (equal (marker-buffer org-clock-hd-marker) + (if selected-task + (marker-buffer selected-task) + (current-buffer))) + (= (marker-position org-clock-hd-marker) + (if selected-task + (marker-position selected-task) + (point))))) + (message "Clock continues in \"%s\"" org-clock-heading) + (throw 'abort nil)) (move-marker org-clock-interrupted-task (marker-position org-clock-marker) (marker-buffer org-clock-marker)) - (org-clock-out t)) - + (let ((org-clock-clocking-in t)) + (org-clock-out t))) + (when (equal select '(16)) ;; Mark as default clocking task (org-clock-mark-default-task)) - + ;; Clock in at which position? (setq target-pos (if (and (eobp) (not (org-on-heading-p))) @@ -878,6 +1039,7 @@ the clocking selection, associated with the letter `d'." (org-back-to-heading t) (or interrupting (move-marker org-clock-interrupted-task nil)) (org-clock-history-push) + (org-clock-set-current) (cond ((functionp org-clock-in-switch-to-state) (looking-at org-complex-heading-regexp) (let ((newstate (funcall org-clock-in-switch-to-state @@ -898,7 +1060,9 @@ the clocking selection, associated with the letter `d'." (functionp org-clock-heading-function)) (funcall org-clock-heading-function)) ((looking-at org-complex-heading-regexp) - (match-string 4)) + (replace-regexp-in-string + "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" + (match-string 4))) (t "???"))) (setq org-clock-heading (org-propertize org-clock-heading 'face nil)) @@ -939,13 +1103,14 @@ the clocking selection, associated with the letter `d'." (setq org-clock-total-time (org-clock-sum-current-item (org-clock-get-sum-start))) (setq org-clock-start-time - (or (and left-over + (or (and leftover (y-or-n-p (format "You stopped another clock %d mins ago; start this one from then? " (/ (- (org-float-time (current-time)) - (org-float-time left-over)) 60))) - left-over) + (org-float-time leftover)) 60))) + leftover) + start-time (current-time))) (setq ts (org-insert-time-stamp org-clock-start-time 'with-hm 'inactive)))) @@ -963,7 +1128,9 @@ the clocking selection, associated with the letter `d'." (cancel-timer org-clock-mode-line-timer) (setq org-clock-mode-line-timer nil)) (setq org-clock-mode-line-timer - (run-with-timer 60 60 'org-clock-update-mode-line)) + (run-with-timer org-clock-update-period + org-clock-update-period + 'org-clock-update-mode-line)) (when org-clock-idle-timer (cancel-timer org-clock-idle-timer) (setq org-clock-idle-timer nil)) @@ -972,6 +1139,16 @@ the clocking selection, associated with the letter `d'." (message "Clock starts at %s - %s" ts msg-extra) (run-hooks 'org-clock-in-hook))))))) +(defvar org-clock-current-task nil + "Task currently clocked in.") +(defun org-clock-set-current () + "Set `org-clock-current-task' to the task currently clocked in." + (setq org-clock-current-task (nth 4 (org-heading-components)))) + +(defun org-clock-delete-current () + "Reset `org-clock-current-task' to nil." + (setq org-clock-current-task nil)) + (defun org-clock-mark-default-task () "Mark current task as default task." (interactive) @@ -1104,11 +1281,14 @@ line and position cursor in that line." If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (interactive) (catch 'exit - (if (not (marker-buffer org-clock-marker)) - (if fail-quietly (throw 'exit t) (error "No active clock"))) + (when (not (org-clocking-p)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (force-mode-line-update) + (if fail-quietly (throw 'exit t) (error "No active clock"))) (let (ts te s h m remove) - (save-excursion - (set-buffer (marker-buffer org-clock-marker)) + (save-excursion ; Do not replace this with `with-current-buffer'. + (with-no-warnings (set-buffer (org-clocking-buffer))) (save-restriction (widen) (goto-char org-clock-marker) @@ -1151,7 +1331,8 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (when org-clock-out-switch-to-state (save-excursion (org-back-to-heading t) - (let ((org-inhibit-logging t)) + (let ((org-inhibit-logging t) + (org-clock-out-when-done nil)) (cond ((functionp org-clock-out-switch-to-state) (looking-at org-complex-heading-regexp) @@ -1166,15 +1347,19 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (force-mode-line-update) (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m (if remove " => LINE REMOVED" "")) - (run-hooks 'org-clock-out-hook)))))) + (run-hooks 'org-clock-out-hook) + (org-clock-delete-current)))))) (defun org-clock-cancel () - "Cancel the running clock be removing the start timestamp." + "Cancel the running clock by removing the start timestamp." (interactive) - (if (not (marker-buffer org-clock-marker)) - (error "No active clock")) - (save-excursion - (set-buffer (marker-buffer org-clock-marker)) + (when (not (org-clocking-p)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (force-mode-line-update) + (error "No active clock")) + (save-excursion ; Do not replace this with `with-current-buffer'. + (with-no-warnings (set-buffer (org-clocking-buffer))) (goto-char org-clock-marker) (delete-region (1- (point-at-bol)) (point-at-eol)) ;; Just in case, remove any empty LOGBOOK left over @@ -1196,7 +1381,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (select (or (org-clock-select-task "Select task to go to: ") (error "No task selected"))) - ((marker-buffer org-clock-marker) org-clock-marker) + ((org-clocking-p) org-clock-marker) ((and org-clock-goto-may-find-recent-task (car org-clock-history) (marker-buffer (car org-clock-history))) @@ -1210,6 +1395,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (org-back-to-heading t) (org-cycle-hide-drawers 'children) (recenter) + (org-reveal) (if recent (message "No running clock, this is the most recently clocked task")) (run-hooks 'org-clock-goto-hook))) @@ -1218,10 +1404,13 @@ With prefix arg SELECT, offer recently clocked tasks for selection." "Holds the file total time in minutes, after a call to `org-clock-sum'.") (make-variable-buffer-local 'org-clock-file-total-minutes) -(defun org-clock-sum (&optional tstart tend) +(defun org-clock-sum (&optional tstart tend headline-filter) "Sum the times for each subtree. Puts the resulting times in minutes as a text property on each headline. -TSTART and TEND can mark a time range to be considered." +TSTART and TEND can mark a time range to be considered. HEADLINE-FILTER is a +zero-arg function that, if specified, is called for each headline in the time +range with point at the headline. Headlines for which HEADLINE-FILTER returns +nil are excluded from the clock summation." (interactive) (let* ((bmp (buffer-modified-p)) (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" @@ -1237,7 +1426,9 @@ TSTART and TEND can mark a time range to be considered." (if (stringp tend) (setq tend (org-time-string-to-seconds tend))) (if (consp tstart) (setq tstart (org-float-time tstart))) (if (consp tend) (setq tend (org-float-time tend))) - (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) + (remove-text-properties (point-min) (point-max) + '(:org-clock-minutes t + :org-clock-force-headline-inclusion t)) (save-excursion (goto-char (point-max)) (while (re-search-backward re nil t) @@ -1259,20 +1450,50 @@ TSTART and TEND can mark a time range to be considered." (setq t1 (+ t1 (string-to-number (match-string 5)) (* 60 (string-to-number (match-string 4)))))) (t ;; A headline - (setq level (- (match-end 1) (match-beginning 1))) - (when (or (> t1 0) (> (aref ltimes level) 0)) - (loop for l from 0 to level do - (aset ltimes l (+ (aref ltimes l) t1))) - (setq t1 0 time (aref ltimes level)) - (loop for l from level to (1- lmax) do - (aset ltimes l 0)) - (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) :org-clock-minutes time))))) + ;; Add the currently clocking item time to the total + (when (and org-clock-report-include-clocking-task + (equal (org-clocking-buffer) (current-buffer)) + (equal (marker-position org-clock-hd-marker) (point)) + tstart + tend + (>= (org-float-time org-clock-start-time) tstart) + (<= (org-float-time org-clock-start-time) tend)) + (let ((time (floor (- (org-float-time) + (org-float-time org-clock-start-time)) 60))) + (setq t1 (+ t1 time)))) + (let* ((headline-forced + (get-text-property (point) + :org-clock-force-headline-inclusion)) + (headline-included + (or (null headline-filter) + (save-excursion + (save-match-data (funcall headline-filter)))))) + (setq level (- (match-end 1) (match-beginning 1))) + (when (or (> t1 0) (> (aref ltimes level) 0)) + (when (or headline-included headline-forced) + (if headline-included + (loop for l from 0 to level do + (aset ltimes l (+ (aref ltimes l) t1)))) + (setq time (aref ltimes level)) + (goto-char (match-beginning 0)) + (put-text-property (point) (point-at-eol) :org-clock-minutes time) + (if headline-filter + (save-excursion + (save-match-data + (while + (> (funcall outline-level) 1) + (outline-up-heading 1 t) + (put-text-property + (point) (point-at-eol) + :org-clock-force-headline-inclusion t)))))) + (setq t1 0) + (loop for l from level to (1- lmax) do + (aset ltimes l 0))))))) (setq org-clock-file-total-minutes (aref ltimes 0))) (set-buffer-modified-p bmp))) (defun org-clock-sum-current-item (&optional tstart) - "Returns time, clocked on current item in total" + "Return time, clocked on current item in total." (save-excursion (save-restriction (org-narrow-to-subtree) @@ -1328,7 +1549,7 @@ will be easy to remove." (org-move-to-column c) (unless (eolp) (skip-chars-backward "^ \t")) (skip-chars-backward " \t") - (setq ov (org-make-overlay (1- (point)) (point-at-eol)) + (setq ov (make-overlay (1- (point)) (point-at-eol)) tx (concat (buffer-substring (1- (point)) (point)) (make-string (+ off (max 0 (- c (current-column)))) ?.) (org-add-props (if org-time-clocksum-use-fractional @@ -1342,9 +1563,9 @@ will be easy to remove." (list 'face 'org-clock-overlay)) "")) (if (not (featurep 'xemacs)) - (org-overlay-put ov 'display tx) - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'end-glyph (make-glyph tx))) + (overlay-put ov 'display tx) + (overlay-put ov 'invisible t) + (overlay-put ov 'end-glyph (make-glyph tx))) (push ov org-clock-overlays))) (defun org-clock-remove-overlays (&optional beg end noremove) @@ -1353,7 +1574,7 @@ BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) (unless org-inhibit-highlight-removal - (mapc 'org-delete-overlay org-clock-overlays) + (mapc 'delete-overlay org-clock-overlays) (setq org-clock-overlays nil) (unless noremove (remove-hook 'before-change-functions @@ -1365,16 +1586,20 @@ from the `before-change-functions' in the current buffer." This is used to stop the clock after a TODO entry is marked DONE, and is only done if the variable `org-clock-out-when-done' is not nil." (when (and org-clock-out-when-done - (member state org-done-keywords) - (equal (or (buffer-base-buffer (marker-buffer org-clock-marker)) - (marker-buffer org-clock-marker)) + (or (and (eq t org-clock-out-when-done) + (member state org-done-keywords)) + (and (listp org-clock-out-when-done) + (member state org-clock-out-when-done))) + (equal (or (buffer-base-buffer (org-clocking-buffer)) + (org-clocking-buffer)) (or (buffer-base-buffer (current-buffer)) (current-buffer))) (< (point) org-clock-marker) (> (save-excursion (outline-next-heading) (point)) org-clock-marker)) ;; Clock out, but don't accept a logging message for this. - (let ((org-log-note-clock-out nil)) + (let ((org-log-note-clock-out nil) + (org-clock-out-switch-to-state nil)) (org-clock-out)))) (add-hook 'org-after-todo-state-change-hook @@ -1398,7 +1623,7 @@ fontified, and then returned." (font-lock-fontify-buffer) (forward-line 2) (buffer-substring (point) (progn - (re-search-forward "^#\\+END" nil t) + (re-search-forward "^[ \t]*#\\+END" nil t) (point-at-bol))))) (defun org-clock-report (&optional arg) @@ -1423,12 +1648,68 @@ buffer and update it." (let ((pos (point)) start) (save-excursion (end-of-line 1) - (and (re-search-backward "^#\\+BEGIN:[ \t]+clocktable" nil t) + (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t) (setq start (match-beginning 0)) - (re-search-forward "^#\\+END:.*" nil t) + (re-search-forward "^[ \t]*#\\+END:.*" nil t) (>= (match-end 0) pos) start)))) +(defun org-day-of-week (day month year) + "Returns the day of the week as an integer." + (nth 6 + (decode-time + (date-to-time + (format "%d-%02d-%02dT00:00:00" year month day))))) + +(defun org-quarter-to-date (quarter year) + "Get the date (week day year) of the first day of a given quarter." + (let (startday) + (cond + ((= quarter 1) + (setq startday (org-day-of-week 1 1 year)) + (cond + ((= startday 0) + (list 52 7 (- year 1))) + ((= startday 6) + (list 52 6 (- year 1))) + ((<= startday 4) + (list 1 startday year)) + ((> startday 4) + (list 53 startday (- year 1))) + ) + ) + ((= quarter 2) + (setq startday (org-day-of-week 1 4 year)) + (cond + ((= startday 0) + (list 13 startday year)) + ((< startday 4) + (list 14 startday year)) + ((>= startday 4) + (list 13 startday year)) + ) + ) + ((= quarter 3) + (setq startday (org-day-of-week 1 7 year)) + (cond + ((= startday 0) + (list 26 startday year)) + ((< startday 4) + (list 27 startday year)) + ((>= startday 4) + (list 26 startday year)) + ) + ) + ((= quarter 4) + (setq startday (org-day-of-week 1 10 year)) + (cond + ((= startday 0) + (list 39 startday year)) + ((<= startday 4) + (list 40 startday year)) + ((> startday 4) + (list 39 startday year))))))) + (defun org-clock-special-range (key &optional time as-strings) "Return two times bordering a special time range. Key is a symbol specifying the range and can be one of `today', `yesterday', @@ -1445,7 +1726,12 @@ the returned times will be formatted strings." (dow (nth 6 tm)) (skey (symbol-name key)) (shift 0) - s1 m1 h1 d1 month1 y1 diff ts te fm txt w date) + (q (cond ((>= (nth 4 tm) 10) 4) + ((>= (nth 4 tm) 7) 3) + ((>= (nth 4 tm) 4) 2) + ((>= (nth 4 tm) 1) 1))) + s1 m1 h1 d1 month1 y1 diff ts te fm txt w date + interval tmp shiftedy shiftedm shiftedq) (cond ((string-match "^[0-9]+$" skey) (setq y (string-to-number skey) m 1 d 1 key 'year)) @@ -1462,6 +1748,15 @@ the returned times will be formatted strings." (setq d (nth 1 date) month (car date) y (nth 2 date) dow 1 key 'week)) + ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey) + (require 'cal-iso) + (setq y (string-to-number (match-string 1 skey))) + (setq q (string-to-number (match-string 2 skey))) + (setq date (calendar-gregorian-from-absolute + (calendar-absolute-from-iso (org-quarter-to-date q y)))) + (setq d (nth 1 date) month (car date) y (nth 2 date) + dow 1 + key 'quarter)) ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey) (setq y (string-to-number (match-string 1 skey)) month (string-to-number (match-string 2 skey)) @@ -1469,12 +1764,17 @@ the returned times will be formatted strings." key 'day)) ((string-match "\\([-+][0-9]+\\)$" skey) (setq shift (string-to-number (match-string 1 skey)) - key (intern (substring skey 0 (match-beginning 1)))))) + key (intern (substring skey 0 (match-beginning 1)))) + (if(and (memq key '(quarter thisq)) (> shift 0)) + (error "Looking forward with quarters isn't implemented.") + ()))) + (when (= shift 0) - (cond ((eq key 'yesterday) (setq key 'today shift -1)) - ((eq key 'lastweek) (setq key 'week shift -1)) - ((eq key 'lastmonth) (setq key 'month shift -1)) - ((eq key 'lastyear) (setq key 'year shift -1)))) + (cond ((eq key 'yesterday) (setq key 'today shift -1)) + ((eq key 'lastweek) (setq key 'week shift -1)) + ((eq key 'lastmonth) (setq key 'month shift -1)) + ((eq key 'lastyear) (setq key 'year shift -1)) + ((eq key 'lastq) (setq key 'quarter shift -1)))) (cond ((memq key '(day today)) (setq d (+ d shift) h 0 m 0 h1 24 m1 0)) @@ -1483,6 +1783,28 @@ the returned times will be formatted strings." m 0 h 0 d (- d diff) d1 (+ 7 d))) ((memq key '(month thismonth)) (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0)) + ((memq key '(quarter thisq)) + ; compute if this shift remains in this year + ; if not, compute how many years and quarters we have to shift (via floor*) + ; and compute the shifted years, months and quarters + (cond + ((< (+ (- q 1) shift) 0) ; shift not in this year + (setq interval (* -1 (+ (- q 1) shift))) + ; set tmp to ((years to shift) (quarters to shift)) + (setq tmp (org-floor* interval 4)) + ; due to the use of floor, 0 quarters actually means 4 + (if (= 0 (nth 1 tmp)) + (setq shiftedy (- y (nth 0 tmp)) + shiftedm 1 + shiftedq 1) + (setq shiftedy (- y (+ 1 (nth 0 tmp))) + shiftedm (- 13 (* 3 (nth 1 tmp))) + shiftedq (- 5 (nth 1 tmp)))) + (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy)) + ((> (+ q shift) 0) ; shift is whitin this year + (setq shiftedq (+ q shift)) + (setq shiftedy y) + (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0)))) ((memq key '(year thisyear)) (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) (t (error "No such time block %s" key))) @@ -1498,11 +1820,21 @@ the returned times will be formatted strings." ((memq key '(month thismonth)) (setq txt (format-time-string "%B %Y" ts))) ((memq key '(year thisyear)) - (setq txt (format-time-string "the year %Y" ts)))) + (setq txt (format-time-string "the year %Y" ts))) + ((memq key '(quarter thisq)) + (setq txt (concatenate 'string (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))) + ) (if as-strings (list (format-time-string fm ts) (format-time-string fm te) txt) (list ts te txt)))) +(defun org-count-quarter (n) + (cond + ((= n 1) "1st") + ((= n 2) "2nd") + ((= n 3) "3rd") + ((= n 4) "4th"))) + (defun org-clocktable-shift (dir n) "Try to shift the :block date of the clocktable at point. Point must be in the #+BEGIN: line of a clocktable, or this function @@ -1516,7 +1848,7 @@ the currently selected interval size." (and (memq dir '(left down)) (setq n (- n))) (save-excursion (goto-char (point-at-bol)) - (if (not (looking-at "#\\+BEGIN: clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) + (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) (error "Line needs a :block definition before this command works") (let* ((b (match-beginning 1)) (e (match-end 1)) (s (match-string 1)) @@ -1525,88 +1857,95 @@ the currently selected interval size." ((equal s "yesterday") (setq s "today-1")) ((equal s "lastweek") (setq s "thisweek-1")) ((equal s "lastmonth") (setq s "thismonth-1")) - ((equal s "lastyear") (setq s "thisyear-1"))) - (cond - ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\)\\([-+][0-9]+\\)?$" s) - (setq block (match-string 1 s) - shift (if (match-end 2) - (string-to-number (match-string 2 s)) - 0)) - (setq shift (+ shift n)) - (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) - ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) - ;; 1 1 2 3 3 4 4 5 6 6 5 2 - (setq y (string-to-number (match-string 1 s)) - wp (and (match-end 3) (match-string 3 s)) - mw (and (match-end 4) (string-to-number (match-string 4 s))) - d (and (match-end 6) (string-to-number (match-string 6 s)))) - (cond - (d (setq ins (format-time-string - "%Y-%m-%d" - (encode-time 0 0 0 (+ d n) m y)))) - ((and wp mw (> (length wp) 0)) - (require 'cal-iso) - (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y)))) - (setq ins (format-time-string - "%G-W%V" - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) - (mw - (setq ins (format-time-string - "%Y-%m" - (encode-time 0 0 0 1 (+ mw n) y)))) - (y - (setq ins (number-to-string (+ y n)))))) - (t (error "Cannot shift clocktable block"))) - (when ins - (goto-char b) - (insert ins) - (delete-region (point) (+ (point) (- e b))) - (beginning-of-line 1) - (org-update-dblock) - t))))) + ((equal s "lastyear") (setq s "thisyear-1")) + ((equal s "lastq") (setq s "thisq-1"))) + + (cond + ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s) + (setq block (match-string 1 s) + shift (if (match-end 2) + (string-to-number (match-string 2 s)) + 0)) + (setq shift (+ shift n)) + (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) + ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) + ;; 1 1 2 3 3 4 4 5 6 6 5 2 + (setq y (string-to-number (match-string 1 s)) + wp (and (match-end 3) (match-string 3 s)) + mw (and (match-end 4) (string-to-number (match-string 4 s))) + d (and (match-end 6) (string-to-number (match-string 6 s)))) + (cond + (d (setq ins (format-time-string + "%Y-%m-%d" + (encode-time 0 0 0 (+ d n) m y)))) + ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) + (require 'cal-iso) + (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y)))) + (setq ins (format-time-string + "%G-W%V" + (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) + ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0)) + (require 'cal-iso) + ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year + (if (> (+ mw n) 4) + (setq mw 0 + y (+ 1 y)) + ()) + ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year + (if (= (+ mw n) 0) + (setq mw 5 + y (- y 1)) + ()) + (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y)))) + (setq ins (format-time-string + (concatenate 'string (number-to-string y) "-Q" (number-to-string (+ mw n))) + (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) + (mw + (setq ins (format-time-string + "%Y-%m" + (encode-time 0 0 0 1 (+ mw n) y)))) + (y + (setq ins (number-to-string (+ y n)))))) + (t (error "Cannot shift clocktable block"))) + (when ins + (goto-char b) + (insert ins) + (delete-region (point) (+ (point) (- e b))) + (beginning-of-line 1) + (org-update-dblock) + t))))) (defun org-dblock-write:clocktable (params) "Write the standard clocktable." + (setq params (org-combine-plists org-clocktable-defaults params)) (catch 'exit - (let* ((hlchars '((1 . "*") (2 . "/"))) - (ins (make-marker)) - (total-time nil) - (scope (plist-get params :scope)) - (tostring (plist-get params :tostring)) - (multifile (plist-get params :multifile)) - (header (plist-get params :header)) - (maxlevel (or (plist-get params :maxlevel) 3)) - (step (plist-get params :step)) - (emph (plist-get params :emphasize)) - (timestamp (plist-get params :timestamp)) + (let* ((scope (plist-get params :scope)) + (block (plist-get params :block)) (ts (plist-get params :tstart)) (te (plist-get params :tend)) - (block (plist-get params :block)) (link (plist-get params :link)) - ipos time p level hlc hdl tsp props content recalc formula pcol - cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list st) - (setq org-clock-file-total-minutes nil) + (maxlevel (or (plist-get params :maxlevel) 3)) + (step (plist-get params :step)) + (timestamp (plist-get params :timestamp)) + (formatter (or (plist-get params :formatter) + org-clock-clocktable-formatter + 'org-clocktable-write-default)) + cc range-text ipos pos one-file-with-archives + scope-is-list tbls level) + + ;; Check if we need to do steps + (when block + ;; Get the range text for the header + (setq cc (org-clock-special-range block nil t) + ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) (when step + ;; Write many tables, in steps (unless (or block (and ts te)) (error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'")) (org-clocktable-steps params) (throw 'exit nil)) - (when block - (setq cc (org-clock-special-range block nil t) - ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) - (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts))) - (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) - (when (and ts (listp ts)) - (setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts)))) - (when (and te (listp te)) - (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) - ;; Now the times are strings we can parse. - (if ts (setq ts (org-float-time - (apply 'encode-time (org-parse-time-string ts))))) - (if te (setq te (org-float-time - (apply 'encode-time (org-parse-time-string te))))) - (move-marker ins (point)) - (setq ipos (point)) + + (setq ipos (point)) ; remember the insertion position ;; Get the right scope (setq pos (point)) @@ -1620,171 +1959,298 @@ the currently selected interval size." (setq scope (org-add-archive-files scope))) ((eq scope 'file-with-archives) (setq scope (org-add-archive-files (list (buffer-file-name))) - rm-file-column t))) + one-file-with-archives t))) (setq scope-is-list (and scope (listp scope))) - (save-restriction - (cond - ((not scope)) - ((eq scope 'file) (widen)) - ((eq scope 'subtree) (org-narrow-to-subtree)) - ((eq scope 'tree) - (while (org-up-heading-safe)) - (org-narrow-to-subtree)) - ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$" - (symbol-name scope))) - (setq level (string-to-number (match-string 1 (symbol-name scope)))) - (catch 'exit - (while (org-up-heading-safe) - (looking-at outline-regexp) - (if (<= (org-reduced-level (funcall outline-level)) level) - (throw 'exit nil)))) - (org-narrow-to-subtree)) - (scope-is-list + (if scope-is-list + ;; we collect from several files (let* ((files scope) - (scope 'agenda) - (p1 (copy-sequence params)) file) - (setq p1 (plist-put p1 :tostring t)) - (setq p1 (plist-put p1 :multifile t)) - (setq p1 (plist-put p1 :scope 'file)) (org-prepare-agenda-buffers files) (while (setq file (pop files)) (with-current-buffer (find-buffer-visiting file) - (setq tbl1 (org-dblock-write:clocktable p1)) - (when tbl1 - (push (org-clocktable-add-file - file - (concat "| |*File time*|*" - (org-minutes-to-hh:mm-string - org-clock-file-total-minutes) - "*|\n" - tbl1)) tbl) - (setq total-time (+ (or total-time 0) - org-clock-file-total-minutes)))))))) - (goto-char pos) - - (unless scope-is-list - (org-clock-sum ts te) - (goto-char (point-min)) - (setq st t) - (while (or (and (bobp) (prog1 st (setq st nil)) - (get-text-property (point) :org-clock-minutes) - (setq p (point-min))) - (setq p (next-single-property-change (point) :org-clock-minutes))) - (goto-char p) - (when (setq time (get-text-property p :org-clock-minutes)) - (save-excursion - (beginning-of-line 1) - (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@:]+:\\)?[ \t]*$")) - (setq level (org-reduced-level - (- (match-end 1) (match-beginning 1)))) - (<= level maxlevel)) - (setq hlc (if emph (or (cdr (assoc level hlchars)) "") "") - hdl (if (not link) - (match-string 2) - (org-make-link-string - (format "file:%s::%s" - (buffer-file-name) - (save-match-data - (org-make-org-heading-search-string - (match-string 2)))) - (match-string 2))) - tsp (when timestamp - (setq props (org-entry-properties (point))) - (or (cdr (assoc "SCHEDULED" props)) - (cdr (assoc "TIMESTAMP" props)) - (cdr (assoc "DEADLINE" props)) - (cdr (assoc "TIMESTAMP_IA" props))))) - (if (and (not multifile) (= level 1)) (push "|-" tbl)) - (push (concat - "| " (int-to-string level) "|" - (if timestamp (concat tsp "|") "") - hlc hdl hlc " |" - (make-string (1- level) ?|) - hlc (org-minutes-to-hh:mm-string time) hlc - " |") tbl)))))) - (setq tbl (nreverse tbl)) - (if tostring - (if tbl (mapconcat 'identity tbl "\n") nil) - (goto-char ins) - (insert-before-markers - (or header - (concat - "Clock summary at [" - (substring - (format-time-string (cdr org-time-stamp-formats)) - 1 -1) - "]" - (if block (concat ", for " range-text ".") "") - "\n\n")) - (if scope-is-list "|File" "") - "|L|" (if timestamp "Timestamp|" "") "Headline|Time|\n") - (setq total-time (or total-time org-clock-file-total-minutes)) - (insert-before-markers - "|-\n|" - (if scope-is-list "|" "") - (if timestamp "|Timestamp|" "|") - "*Total time*| *" - (org-minutes-to-hh:mm-string (or total-time 0)) - "*|\n|-\n") - (setq tbl (delq nil tbl)) - (if (and (stringp (car tbl)) (> (length (car tbl)) 1) - (equal (substring (car tbl) 0 2) "|-")) - (pop tbl)) - (insert-before-markers (mapconcat - 'identity (delq nil tbl) - (if scope-is-list "\n|-\n" "\n"))) - (backward-delete-char 1) - (if (setq formula (plist-get params :formula)) - (cond - ((eq formula '%) - (setq pcol (+ (if scope-is-list 1 0) maxlevel 3)) - (insert - (format - "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" - pcol - 2 - (+ 3 (if scope-is-list 1 0)) - (+ (if scope-is-list 1 0) 3) - (1- pcol))) - (setq recalc t)) - ((stringp formula) - (insert "\n#+TBLFM: " formula) - (setq recalc t)) - (t (error "invalid formula in clocktable"))) - ;; Should we rescue an old formula? - (when (stringp (setq content (plist-get params :content))) - (when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content) - (setq recalc t) - (insert "\n" (match-string 1 (plist-get params :content))) - (beginning-of-line 0)))) - (goto-char ipos) - (skip-chars-forward "^|") - (org-table-align) - (when recalc - (if (eq formula '%) - (save-excursion (org-table-goto-column pcol nil 'force) - (insert "%"))) - (org-table-recalculate 'all)) - (when rm-file-column - (forward-char 1) - (org-table-delete-column))))))) + (save-excursion + (save-restriction + (push (org-clock-get-table-data file params) tbls)))))) + ;; Just from the current file + (save-restriction + ;; get the right range into the restriction + (org-prepare-agenda-buffers (list (buffer-file-name))) + (cond + ((not scope)) ; use the restriction as it is now + ((eq scope 'file) (widen)) + ((eq scope 'subtree) (org-narrow-to-subtree)) + ((eq scope 'tree) + (while (org-up-heading-safe)) + (org-narrow-to-subtree)) + ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$" + (symbol-name scope))) + (setq level (string-to-number (match-string 1 (symbol-name scope)))) + (catch 'exit + (while (org-up-heading-safe) + (looking-at outline-regexp) + (if (<= (org-reduced-level (funcall outline-level)) level) + (throw 'exit nil)))) + (org-narrow-to-subtree))) + ;; do the table, with no file name. + (push (org-clock-get-table-data nil params) tbls))) + + ;; OK, at this point we tbls as a list of tables, one per file + (setq tbls (nreverse tbls)) + + (setq params (plist-put params :multifile scope-is-list)) + (setq params (plist-put params :one-file-with-archives + one-file-with-archives)) + + (funcall formatter ipos tbls params)))) + +(defun org-clocktable-write-default (ipos tables params) + "Write out a clock table at position IPOS in the current buffer. +TABLES is a list of tables with clocking data as produced by +`org-clock-get-table-data'. PARAMS is the parameter property list obtained +from the dynamic block defintion." + ;; This function looks quite complicated, mainly because there are a lot + ;; of options which can add or remove columns. I have massively commented + ;; function, to I hope it is understandable. If someone want to write + ;; there own special formatter, this maybe much easier because there can + ;; be a fixed format with a well-defined number of columns... + (let* ((hlchars '((1 . "*") (2 . "/"))) + (multifile (plist-get params :multifile)) + (block (plist-get params :block)) + (ts (plist-get params :tstart)) + (te (plist-get params :tend)) + (header (plist-get params :header)) + (narrow (plist-get params :narrow)) + (link (plist-get params :link)) + (maxlevel (or (plist-get params :maxlevel) 3)) + (emph (plist-get params :emphasize)) + (level-p (plist-get params :level)) + (timestamp (plist-get params :timestamp)) + (ntcol (max 1 (or (plist-get params :tcolumns) 100))) + (rm-file-column (plist-get params :one-file-with-archives)) + (indent (plist-get params :indent)) + range-text total-time tbl level hlc formula pcol + file-time entries entry headline + recalc content narrow-cut-p tcol) + + ;; Implement abbreviations + (when (plist-get params :compact) + (setq level nil indent t narrow (or narrow '40!) ntcol 1)) + + ;; Some consistency test for parameters + (unless (integerp ntcol) + (setq params (plist-put params :tcolumns (setq ntcol 100)))) + + (when (and narrow (integerp narrow) link) + ;; We cannot have both integer narrow and link + (message + "Using hard narrowing in clocktable to allow for links") + (setq narrow (intern (format "%d!" narrow)))) + + (when narrow + (cond + ((integerp narrow)) + ((and (symbolp narrow) + (string-match "\\`[0-9]+!\\'" (symbol-name narrow))) + (setq narrow-cut-p t + narrow (string-to-number (substring (symbol-name narrow) + 0 -1)))) + (t + (error "Invalid value %s of :narrow property in clock table" + narrow)))) + + (when block + ;; Get the range text for the header + (setq range-text (nth 2 (org-clock-special-range block nil t)))) + + ;; Compute the total time + (setq total-time (apply '+ (mapcar 'cadr tables))) + + ;; Now we need to output this tsuff + (goto-char ipos) + + ;; Insert the text *before* the actual table + (insert-before-markers + (or header + ;; Format the standard header + (concat + "Clock summary at [" + (substring + (format-time-string (cdr org-time-stamp-formats)) + 1 -1) + "]" + (if block (concat ", for " range-text ".") "") + "\n\n"))) + + ;; Insert the narrowing line + (when (and narrow (integerp narrow) (not narrow-cut-p)) + (insert-before-markers + "|" ; table line starter + (if multifile "|" "") ; file column, maybe + (if level-p "|" "") ; level column, maybe + (if timestamp "|" "") ; timestamp column, maybe + (format "<%d>| |\n" narrow))) ; headline and time columns + + ;; Insert the table header line + (insert-before-markers + "|" ; table line starter + (if multifile "File|" "") ; file column, maybe + (if level-p "L|" "") ; level column, maybe + (if timestamp "Timestamp|" "") ; timestamp column, maybe + "Headline|Time|\n") ; headline and time columns + + ;; Insert the total time in the table + (insert-before-markers + "|-\n" ; a hline + "|" ; table line starter + (if multifile "| ALL " "") ; file column, maybe + (if level-p "|" "") ; level column, maybe + (if timestamp "|" "") ; timestamp column, maybe + "*Total time*| " ; instead of a headline + "*" + (org-minutes-to-hh:mm-string (or total-time 0)) ; the time + "*|\n") ; close line + + ;; Now iterate over the tables and insert the data + ;; but only if any time has been collected + (when (and total-time (> total-time 0)) + + (while (setq tbl (pop tables)) + ;; now tbl is the table resulting from one file. + (setq file-time (nth 1 tbl)) + (when (or (and file-time (> file-time 0)) + (not (plist-get params :fileskip0))) + (insert-before-markers "|-\n") ; a hline because a new file starts + ;; First the file time, if we have multiple files + (when multifile + ;; Summarize the time colleted from this file + (insert-before-markers + (format "| %s %s | %s*File time* | *%s*|\n" + (file-name-nondirectory (car tbl)) + (if level-p "| " "") ; level column, maybe + (if timestamp "| " "") ; timestamp column, maybe + (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time + + ;; Get the list of node entries and iterate over it + (setq entries (nth 2 tbl)) + (while (setq entry (pop entries)) + (setq level (car entry) + headline (nth 1 entry) + hlc (if emph (or (cdr (assoc level hlchars)) "") "")) + (when narrow-cut-p + (if (and (string-match (concat "\\`" org-bracket-link-regexp + "\\'") + headline) + (match-end 3)) + (setq headline + (format "[[%s][%s]]" + (match-string 1 headline) + (org-shorten-string (match-string 3 headline) + narrow))) + (setq headline (org-shorten-string headline narrow)))) + (insert-before-markers + "|" ; start the table line + (if multifile "|" "") ; free space for file name column? + (if level-p (format "%d|" (car entry)) "") ; level, maybe + (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe + (if indent (org-clocktable-indent-string level) "") ; indentation + hlc headline hlc "|" ; headline + (make-string (min (1- ntcol) (or (- level 1))) ?|) + ; empty fields for higher levels + hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time + "|\n" ; close line + ))))) + (backward-delete-char 1) + (if (setq formula (plist-get params :formula)) + (cond + ((eq formula '%) + ;; compute the column where the % numbers need to go + (setq pcol (+ 2 + (if multifile 1 0) + (if level-p 1 0) + (if timestamp 1 0) + (min maxlevel (or ntcol 100)))) + ;; compute the column where the total time is + (setq tcol (+ 2 + (if multifile 1 0) + (if level-p 1 0) + (if timestamp 1 0))) + (insert + (format + "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" + pcol ; the column where the % numbers should go + (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time + tcol ; column of the total time + tcol (1- pcol) ; range of columns where times can be found + )) + (setq recalc t)) + ((stringp formula) + (insert "\n#+TBLFM: " formula) + (setq recalc t)) + (t (error "invalid formula in clocktable"))) + ;; Should we rescue an old formula? + (when (stringp (setq content (plist-get params :content))) + (when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content) + (setq recalc t) + (insert "\n" (match-string 1 (plist-get params :content))) + (beginning-of-line 0)))) + ;; Back to beginning, align the table, recalculate if necessary + (goto-char ipos) + (skip-chars-forward "^|") + (org-table-align) + (when org-hide-emphasis-markers + ;; we need to align a second time + (org-table-align)) + (when recalc + (if (eq formula '%) + (save-excursion + (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) + (org-table-goto-column pcol nil 'force) + (insert "%"))) + (org-table-recalculate 'all)) + (when rm-file-column + ;; The file column is actually not wanted + (forward-char 1) + (org-table-delete-column)) + total-time)) + +(defun org-clocktable-indent-string (level) + (if (= level 1) + "" + (let ((str "\\__")) + (while (> level 2) + (setq level (1- level) + str (concat str "___"))) + (concat str " ")))) (defun org-clocktable-steps (params) + "Step through the range to make a number of clock tables." (let* ((p1 (copy-sequence params)) (ts (plist-get p1 :tstart)) (te (plist-get p1 :tend)) (step0 (plist-get p1 :step)) (step (cdr (assoc step0 '((day . 86400) (week . 604800))))) + (stepskip0 (plist-get p1 :stepskip0)) (block (plist-get p1 :block)) - cc range-text) + cc range-text step-time) (when block (setq cc (org-clock-special-range block nil t) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) - (if ts (setq ts (org-float-time - (apply 'encode-time (org-parse-time-string ts))))) - (if te (setq te (org-float-time - (apply 'encode-time (org-parse-time-string te))))) + (cond + ((numberp ts) + ;; If ts is a number, it's an absolute day number from org-agenda. + (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts) + (setq ts (org-float-time (encode-time 0 0 0 day month year))))) + (ts + (setq ts (org-float-time + (apply 'encode-time (org-parse-time-string ts)))))) + (cond + ((numberp te) + ;; Likewise for te. + (destructuring-bind (month day year) (calendar-gregorian-from-absolute te) + (setq te (org-float-time (encode-time 0 0 0 day month year))))) + (te + (setq te (org-float-time + (apply 'encode-time (org-parse-time-string te)))))) (setq p1 (plist-put p1 :header "")) (setq p1 (plist-put p1 :step nil)) (setq p1 (plist-put p1 :block nil)) @@ -1796,23 +2262,107 @@ the currently selected interval size." (setq p1 (plist-put p1 :tend (format-time-string (org-time-stamp-format nil t) (seconds-to-time (setq ts (+ ts step)))))) - (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ") + (insert "\n" (if (eq step0 'day) "Daily report: " + "Weekly report starting on: ") (plist-get p1 :tstart) "\n") - (org-dblock-write:clocktable p1) - (re-search-forward "#\\+END:") + (setq step-time (org-dblock-write:clocktable p1)) + (re-search-forward "^[ \t]*#\\+END:") + (when (and (equal step-time 0) stepskip0) + ;; Remove the empty table + (delete-region (point-at-bol) + (save-excursion + (re-search-backward "^\\(Daily\\|Weekly\\) report" + nil t) + (point)))) (end-of-line 0)))) -(defun org-clocktable-add-file (file table) - (if table - (let ((lines (org-split-string table "\n")) - (ff (file-name-nondirectory file))) - (mapconcat 'identity - (mapcar (lambda (x) - (if (string-match org-table-dataline-regexp x) - (concat "|" ff x) - x)) - lines) - "\n")))) +(defun org-clock-get-table-data (file params) + "Get the clocktable data for file FILE, with parameters PARAMS. +FILE is only for identification - this function assumes that +the correct buffer is current, and that the wanted restriction is +in place. +The return value will be a list with the file name and the total +file time (in minutes) as 1st and 2nd elements. The third element +of this list will be a list of headline entries. Each entry has the +following structure: + + (LEVEL HEADLINE TIMESTAMP TIME) + +LEVEL: The level of the headline, as an integer. This will be + the reduced leve, so 1,2,3,... even if only odd levels + are being used. +HEADLINE: The text of the headline. Depending on PARAMS, this may + already be formatted like a link. +TIMESTAMP: If PARAMS require it, this will be a time stamp found in the + entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive, + in this sequence. +TIME: The sum of all time spend in this tree, in minutes. This time + will of cause be restricted to the time block and tags match + specified in PARAMS." + (let* ((maxlevel (or (plist-get params :maxlevel) 3)) + (timestamp (plist-get params :timestamp)) + (ts (plist-get params :tstart)) + (te (plist-get params :tend)) + (block (plist-get params :block)) + (link (plist-get params :link)) + (tags (plist-get params :tags)) + (matcher (if tags (cdr (org-make-tags-matcher tags)))) + cc range-text st p time level hdl props tsp tbl) + + (setq org-clock-file-total-minutes nil) + (when block + (setq cc (org-clock-special-range block nil t) + ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) + (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts))) + (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) + (when (and ts (listp ts)) + (setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts)))) + (when (and te (listp te)) + (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) + ;; Now the times are strings we can parse. + (if ts (setq ts (org-float-time + (apply 'encode-time (org-parse-time-string ts))))) + (if te (setq te (org-float-time + (apply 'encode-time (org-parse-time-string te))))) + (save-excursion + (org-clock-sum ts te + (unless (null matcher) + (lambda () + (let ((tags-list (org-get-tags-at))) + (eval matcher))))) + (goto-char (point-min)) + (setq st t) + (while (or (and (bobp) (prog1 st (setq st nil)) + (get-text-property (point) :org-clock-minutes) + (setq p (point-min))) + (setq p (next-single-property-change + (point) :org-clock-minutes))) + (goto-char p) + (when (setq time (get-text-property p :org-clock-minutes)) + (save-excursion + (beginning-of-line 1) + (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) + (setq level (org-reduced-level + (- (match-end 1) (match-beginning 1)))) + (<= level maxlevel)) + (setq hdl (if (not link) + (match-string 2) + (org-make-link-string + (format "file:%s::%s" + (buffer-file-name) + (save-match-data + (org-make-org-heading-search-string + (match-string 2)))) + (match-string 2))) + tsp (when timestamp + (setq props (org-entry-properties (point))) + (or (cdr (assoc "SCHEDULED" props)) + (cdr (assoc "DEADLINE" props)) + (cdr (assoc "TIMESTAMP" props)) + (cdr (assoc "TIMESTAMP_IA" props))))) + (when (> time 0) (push (list level hdl tsp time) tbl)))))) + (setq tbl (nreverse tbl)) + (list file org-clock-file-total-minutes tbl)))) (defun org-clock-time% (total &rest strings) "Compute a time fraction in percent. @@ -1833,7 +2383,8 @@ This function is made for clock tables." (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s) (throw 'exit (/ (* 100.0 (+ (string-to-number (match-string 2 s)) - (* 60 (string-to-number (match-string 1 s))))) + (* 60 (string-to-number + (match-string 1 s))))) tot)))) 0)))) @@ -1857,16 +2408,17 @@ The details of what will be saved are regulated by the variable system-name (format-time-string (cdr org-time-stamp-formats)))) (if (and (memq org-clock-persist '(t clock)) - (setq b (marker-buffer org-clock-marker)) + (setq b (org-clocking-buffer)) (setq b (or (buffer-base-buffer b) b)) (buffer-live-p b) (buffer-file-name b) (or (not org-clock-persist-query-save) (y-or-n-p (concat "Save current clock (" - (substring-no-properties org-clock-heading) + (substring-no-properties + org-clock-heading) ") ")))) (insert "(setq resume-clock '(\"" - (buffer-file-name (marker-buffer org-clock-marker)) + (buffer-file-name (org-clocking-buffer)) "\" . " (int-to-string (marker-position org-clock-marker)) "))\n")) ;; Store clocked task history. Tasks are stored reversed to make @@ -1932,7 +2484,7 @@ The details of what will be saved are regulated by the variable ;;;###autoload (defun org-clock-persistence-insinuate () - "Set up hooks for clock persistence" + "Set up hooks for clock persistence." (add-hook 'org-mode-hook 'org-clock-load) (add-hook 'kill-emacs-hook 'org-clock-save)) @@ -1944,3 +2496,4 @@ The details of what will be saved are regulated by the variable ;; arch-tag: 7b42c5d4-9b36-48be-97c0-66a869daed4c ;;; org-clock.el ends here + diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index 683b845c3ef..955dd7cd456 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -36,6 +36,9 @@ (declare-function org-agenda-redo "org-agenda" ()) (declare-function org-agenda-do-context-action "org-agenda" ()) +(when (featurep 'xemacs) + (error "Do not load this file into XEmacs, use 'org-colview-xemacs.el'.")) + ;;; Column View (defvar org-columns-overlays nil @@ -146,8 +149,8 @@ This is the compiled version of the format.") (defun org-columns-new-overlay (beg end &optional string face) "Create a new column overlay and add it to the list." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face (or face 'secondary-selection)) + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face (or face 'secondary-selection)) (org-overlay-display ov string face) (push ov org-columns-overlays) ov)) @@ -220,12 +223,14 @@ This is the compiled version of the format.") (org-unmodified (setq ov (org-columns-new-overlay beg (setq beg (1+ beg)) string (if dateline face1 face))) - (org-overlay-put ov 'keymap org-columns-map) - (org-overlay-put ov 'org-columns-key property) - (org-overlay-put ov 'org-columns-value (cdr ass)) - (org-overlay-put ov 'org-columns-value-modified modval) - (org-overlay-put ov 'org-columns-pom pom) - (org-overlay-put ov 'org-columns-format f)) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'org-columns-key property) + (overlay-put ov 'org-columns-value (cdr ass)) + (overlay-put ov 'org-columns-value-modified modval) + (overlay-put ov 'org-columns-pom pom) + (overlay-put ov 'org-columns-format f) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "")) (if (or (not (char-after beg)) (equal (char-after beg) ?\n)) (let ((inhibit-read-only t)) @@ -235,12 +240,14 @@ This is the compiled version of the format.") ;; Make the rest of the line disappear. (org-unmodified (setq ov (org-columns-new-overlay beg (point-at-eol))) - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'keymap org-columns-map) - (org-overlay-put ov 'intangible t) + (overlay-put ov 'invisible t) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'intangible t) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "") (push ov org-columns-overlays) - (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) - (org-overlay-put ov 'keymap org-columns-map) + (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) + (overlay-put ov 'keymap org-columns-map) (push ov org-columns-overlays) (let ((inhibit-read-only t)) (put-text-property (max (point-min) (1- (point-at-bol))) @@ -298,7 +305,7 @@ for the duration of the command.") (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))) (defun org-columns-hscoll-title () - "Set the header-line-format so that it scrolls along with the table." + "Set the `header-line-format' so that it scrolls along with the table." (sit-for .0001) ; need to force a redisplay to update window-hscroll (when (not (= (window-hscroll) org-columns-previous-hscroll)) (setq header-line-format @@ -323,7 +330,7 @@ for the duration of the command.") (move-marker org-columns-begin-marker nil) (move-marker org-columns-top-level-marker nil) (org-unmodified - (mapc 'org-delete-overlay org-columns-overlays) + (mapc 'delete-overlay org-columns-overlays) (setq org-columns-overlays nil) (let ((inhibit-read-only t)) (remove-text-properties (point-min) (point-max) '(read-only t)))) @@ -459,10 +466,16 @@ Where possible, use the standard interface for changing this line." ((equal key "SCHEDULED") (setq eval '(org-with-point-at pom (call-interactively 'org-schedule)))) + ((equal key "BEAMER_env") + (setq eval '(org-with-point-at pom + (call-interactively 'org-beamer-select-environment)))) (t (setq allowed (org-property-get-allowed-values pom key 'table)) (if allowed - (setq nval (org-icompleting-read "Value: " allowed nil t)) + (setq nval (org-icompleting-read + "Value: " allowed nil + (not (get-text-property 0 'org-unrestricted + (caar allowed))))) (setq nval (read-string "Edit: " value))) (setq nval (org-trim nval)) (when (not (equal nval value)) @@ -489,7 +502,7 @@ Where possible, use the standard interface for changing this line." (progn (setq org-columns-overlays (org-delete-all line-overlays org-columns-overlays)) - (mapc 'org-delete-overlay line-overlays) + (mapc 'delete-overlay line-overlays) (org-columns-eval eval)) (org-columns-display-here))) (org-move-to-column col) @@ -506,7 +519,7 @@ Where possible, use the standard interface for changing this line." (txt (match-string 3)) (post "") txt2) - (if (string-match (org-re "[ \t]+:[[:alnum:]:_@]+:[ \t]*$") txt) + (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt) (setq post (match-string 0 txt) txt (substring txt 0 (match-beginning 0)))) (setq txt2 (read-string "Edit: " txt)) @@ -618,7 +631,7 @@ an integer, select that value." (progn (setq org-columns-overlays (org-delete-all line-overlays org-columns-overlays)) - (mapc 'org-delete-overlay line-overlays) + (mapc 'delete-overlay line-overlays) (org-columns-eval '(org-entry-put pom key nval))) (org-columns-display-here))) (org-move-to-column col) @@ -737,20 +750,21 @@ around it." ("@max" max_age max (lambda (x) (- org-columns-time x))) ("@mean" mean_age (lambda (&rest x) (/ (apply '+ x) (float (length x)))) - (lambda (x) (- org-columns-time x)))) + (lambda (x) (- org-columns-time x))) + ("est+" estimate org-estimate-combine)) "Operator <-> format,function,calc map. Used to compile/uncompile columns format and completing read in -interactive function org-columns-new. +interactive function `org-columns-new'. operator string used in #+COLUMNS definition describing the summary type format symbol describing summary type selected interactively in - org-columns-new and internally in - org-columns-number-to-string and - org-columns-string-to-number + `org-columns-new' and internally in + `org-columns-number-to-string' and + `org-columns-string-to-number' function called with a list of values as argument to calculate the summary value -calc function called on every element before summarizing. This is +calc function called on every element before summarizing. This is optional and should only be specified if needed") (defun org-columns-new (&optional prop title width op fmt fun &rest rest) @@ -912,15 +926,15 @@ Don't set this, this is meant for dynamic scoping.") (let (fmt val pos) (save-excursion (mapc (lambda (ov) - (when (equal (org-overlay-get ov 'org-columns-key) property) - (setq pos (org-overlay-start ov)) + (when (equal (overlay-get ov 'org-columns-key) property) + (setq pos (overlay-start ov)) (goto-char pos) (when (setq val (cdr (assoc property (get-text-property (point-at-bol) 'org-summaries)))) - (setq fmt (org-overlay-get ov 'org-columns-format)) - (org-overlay-put ov 'org-columns-value val) - (org-overlay-put ov 'display (format fmt val))))) + (setq fmt (overlay-get ov 'org-columns-format)) + (overlay-put ov 'org-columns-value val) + (overlay-put ov 'display (format fmt val))))) org-columns-overlays)))) (defun org-columns-compute (property) @@ -1022,6 +1036,7 @@ Don't set this, this is meant for dynamic scoping.") (defun org-columns-number-to-string (n fmt &optional printf) "Convert a computed column number to a string value, according to FMT." (cond + ((memq fmt '(estimate)) (org-estimate-print n printf)) ((not (numberp n)) "") ((memq fmt '(add_times max_times min_times mean_times)) (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h)))))) @@ -1045,28 +1060,30 @@ Don't set this, this is meant for dynamic scoping.") (format "[%d/%d]" n m) (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m))))))) + (defun org-columns-string-to-number (s fmt) "Convert a column value to a number that can be used for column computing." (if s (cond ((memq fmt '(min_age max_age mean_age)) - (cond ((string= s "") org-columns-time) - ((string-match - "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" - s) - (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) - (string-to-number (match-string 2 s)))) - (string-to-number (match-string 3 s)))) - (string-to-number (match-string 4 s)))) - (t (time-to-number-of-days (apply 'encode-time - (org-parse-time-string s t)))))) + (cond ((string= s "") org-columns-time) + ((string-match + "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" + s) + (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) + (string-to-number (match-string 2 s)))) + (string-to-number (match-string 3 s)))) + (string-to-number (match-string 4 s)))) + (t (time-to-number-of-days (apply 'encode-time + (org-parse-time-string s t)))))) ((string-match ":" s) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum)) + (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) + (while l + (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) + sum)) ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) - (if (equal s "[X]") 1. 0.000001)) + (if (equal s "[X]") 1. 0.000001)) + ((memq fmt '(estimate)) (org-string-to-estimate s)) (t (string-to-number s))))) (defun org-columns-uncompile-format (cfmt) @@ -1103,8 +1120,7 @@ operator the operator if any format the output format for computed results, derived from operator printf a printf format for computed values fun the lisp function to compute summary values, derived from operator -calc function to get values from base elements -" +calc function to get values from base elements" (let ((start 0) width prop title op op-match f printf fun calc) (setq org-columns-current-fmt-compiled nil) (while (string-match @@ -1377,10 +1393,11 @@ and tailing newline characters." This will add overlays to the date lines, to show the summary for each day." (let* ((fmt (mapcar (lambda (x) (if (equal (car x) "CLOCKSUM") - (list "CLOCKSUM" (nth 2 x) nil 'add_times nil '+ 'identity) - (cdr x))) + (list "CLOCKSUM" (nth 1 x) (nth 2 x) ":" 'add_times + nil '+ nil) + x)) org-columns-current-fmt-compiled)) - line c c1 stype calc sumfunc props lsum entries prop v) + line c c1 stype calc sumfunc props lsum entries prop v title) (catch 'exit (when (delq nil (mapcar 'cadr fmt)) ;; OK, at least one summation column, it makes sense to try this @@ -1404,9 +1421,10 @@ This will add overlays to the date lines, to show the summary for each day." (mapcar (lambda (f) (setq prop (car f) - stype (nth 3 f) - sumfunc (nth 5 f) - calc (or (nth 6 f) 'identity)) + title (nth 1 f) + stype (nth 4 f) + sumfunc (nth 6 f) + calc (or (nth 7 f) 'identity)) (cond ((equal prop "ITEM") (cons prop (buffer-substring (point-at-bol) @@ -1471,7 +1489,7 @@ This will add overlays to the date lines, to show the summary for each day." (org-columns-compute (car fm))))))))))) (defun org-format-time-period (interval) - "Convert time in fractional days to days/hours/minutes/seconds" + "Convert time in fractional days to days/hours/minutes/seconds." (if (numberp interval) (let* ((days (floor interval)) (frac-hours (* 24 (- interval days))) @@ -1481,6 +1499,41 @@ This will add overlays to the date lines, to show the summary for each day." (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) "")) +(defun org-estimate-mean-and-var (v) + "Return the mean and variance of an estimate." + (let* ((low (float (car v))) + (high (float (cadr v))) + (mean (/ (+ low high) 2.0)) + (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0))) + (list mean var))) + +(defun org-estimate-combine (&rest el) + "Combine a list of estimates, using mean and variance. +The mean and variance of the result will be the sum of the means +and variances (respectively) of the individual estimates." + (let ((mean 0) + (var 0)) + (mapc (lambda (e) + (let ((stats (org-estimate-mean-and-var e))) + (setq mean (+ mean (car stats))) + (setq var (+ var (cadr stats))))) + el) + (let ((stdev (sqrt var))) + (list (- mean stdev) (+ mean stdev))))) + +(defun org-estimate-print (e &optional fmt) + "Prepare a string representation of an estimate. +This formats these numbers as two numbers with a \"-\" between them." + (if (null fmt) (set 'fmt "%.0f")) + (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-"))) + +(defun org-string-to-estimate (s) + "Convert a string to an estimate. +The string should be two numbers joined with a \"-\"." + (if (string-match "\\(.*\\)-\\(.*\\)" s) + (list (string-to-number (match-string 1 s)) + (string-to-number(match-string 2 s))) + (list (string-to-number s) (string-to-number s)))) (provide 'org-colview) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index f0d0904b735..b739d6d1b1e 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -39,7 +39,10 @@ (declare-function find-library-name "find-func" (library)) (declare-function w32-focus-frame "term/w32-win" (frame)) -(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself +;; The following constant is for backward compatibility. We do not use +;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) +;; at compilation time and can therefore optimize code better. +(defconst org-xemacs-p (featurep 'xemacs)) (defconst org-format-transports-properties-p (let ((x "a")) (add-text-properties 0 1 '(test t) x) @@ -86,25 +89,44 @@ any other entries, and any resulting duplicates will be removed entirely." (t specs))) (put 'org-compatible-face 'lisp-indent-function 1) +(defun org-version-check (version feature level) + (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) + (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) + (rmaj (or (nth 0 v1) 99)) + (rmin (or (nth 1 v1) 99)) + (rbld (or (nth 2 v1) 99)) + (maj (or (nth 0 v2) 0)) + (min (or (nth 1 v2) 0)) + (bld (or (nth 2 v2) 0))) + (if (or (< maj rmaj) + (and (= maj rmaj) + (< min rmin)) + (and (= maj rmaj) + (= min rmin) + (< bld rbld))) + (if (eq level :predicate) + ;; just return if we have the version + nil + (let ((msg (format "Emacs %s or greater is recommended for %s" + version feature))) + (display-warning 'org msg level) + t)) + t))) + ;;;; Emacs/XEmacs compatibility +;; Keys +(defconst org-xemacs-key-equivalents + '(([mouse-1] . [button1]) + ([mouse-2] . [button2]) + ([mouse-3] . [button3]) + ([C-mouse-4] . [(control mouse-4)]) + ([C-mouse-5] . [(control mouse-5)])) + "Translation alist for a couple of keys.") + ;; Overlay compatibility functions -(defun org-make-overlay (beg end &optional buffer) - (if (featurep 'xemacs) - (make-extent beg end buffer) - (make-overlay beg end buffer))) -(defun org-delete-overlay (ovl) - (if (featurep 'xemacs) (progn (delete-extent ovl) nil) (delete-overlay ovl))) (defun org-detach-overlay (ovl) (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) -(defun org-move-overlay (ovl beg end &optional buffer) - (if (featurep 'xemacs) - (set-extent-endpoints ovl beg end (or buffer (current-buffer))) - (move-overlay ovl beg end buffer))) -(defun org-overlay-put (ovl prop value) - (if (featurep 'xemacs) - (set-extent-property ovl prop value) - (overlay-put ovl prop value))) (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." (if (featurep 'xemacs) @@ -124,32 +146,33 @@ any other entries, and any resulting duplicates will be removed entirely." (if face (org-add-props text nil 'face face)) (overlay-put ovl 'before-string text) (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-get (ovl prop) - (if (featurep 'xemacs) - (extent-property ovl prop) - (overlay-get ovl prop))) -(defun org-overlays-at (pos) - (if (featurep 'xemacs) (extents-at pos) (overlays-at pos))) -(defun org-overlays-in (&optional start end) - (if (featurep 'xemacs) - (extent-list nil start end) - (overlays-in start end))) -(defun org-overlay-start (o) - (if (featurep 'xemacs) (extent-start-position o) (overlay-start o))) -(defun org-overlay-end (o) - (if (featurep 'xemacs) (extent-end-position o) (overlay-end o))) -(defun org-overlay-buffer (o) - (if (featurep 'xemacs) (extent-buffer o) (overlay-buffer o))) (defun org-find-overlays (prop &optional pos delete) "Find all overlays specifying PROP at POS or point. If DELETE is non-nil, delete all those overlays." - (let ((overlays (org-overlays-at (or pos (point)))) + (let ((overlays (overlays-at (or pos (point)))) ov found) (while (setq ov (pop overlays)) - (if (org-overlay-get ov prop) - (if delete (org-delete-overlay ov) (push ov found)))) + (if (overlay-get ov prop) + (if delete (delete-overlay ov) (push ov found)))) found)) +(defun org-get-x-clipboard (value) + "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21." + (if (eq window-system 'x) + (let ((x (org-get-x-clipboard-compat value))) + (if x (org-no-properties x))))) + +(defsubst org-decompose-region (beg end) + "Decompose from BEG to END." + (if (featurep 'xemacs) + (let ((modified-p (buffer-modified-p)) + (buffer-read-only nil)) + (remove-text-properties beg end '(composition nil)) + (set-buffer-modified-p modified-p)) + (decompose-region beg end))) + +;; Miscellaneous functions + (defun org-add-hook (hook function &optional append local) "Add-hook, compatible with both Emacsen." (if (and local (featurep 'xemacs)) @@ -170,7 +193,7 @@ that will be added to PLIST. Returns the string that was modified." "Fit WINDOW to the buffer, but only if it is not a side-by-side window. WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call -`shrink-window-if-larger-than-buffer' instead, the hight limit are +`shrink-window-if-larger-than-buffer' instead, the height limit is ignored in this case." (cond ((if (fboundp 'window-full-width-p) (not (window-full-width-p window)) @@ -183,6 +206,26 @@ ignored in this case." (shrink-window-if-larger-than-buffer window))) (or window (selected-window))) +(defun org-number-sequence (from &optional to inc) + "Call `number-sequence or emulate it." + (if (fboundp 'number-sequence) + (number-sequence from to inc) + (if (or (not to) (= from to)) + (list from) + (or inc (setq inc 1)) + (when (zerop inc) (error "The increment can not be zero")) + (let (seq (n 0) (next from)) + (if (> inc 0) + (while (<= next to) + (setq seq (cons next seq) + n (1+ n) + next (+ from (* n inc)))) + (while (>= next to) + (setq seq (cons next seq) + n (1+ n) + next (+ from (* n inc))))) + (nreverse seq))))) + ;; Region compatibility (defvar org-ignore-region nil @@ -206,19 +249,6 @@ Works on both Emacs and XEmacs." ;; Invisibility compatibility -(defun org-add-to-invisibility-spec (arg) - "Add elements to `buffer-invisibility-spec'. -See documentation for `buffer-invisibility-spec' for the kind of elements -that can be added." - (cond - ((fboundp 'add-to-invisibility-spec) - (add-to-invisibility-spec arg)) - ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) - (setq buffer-invisibility-spec (list arg))) - (t - (setq buffer-invisibility-spec - (cons arg buffer-invisibility-spec))))) - (defun org-remove-from-invisibility-spec (arg) "Remove elements from `buffer-invisibility-spec'." (if (fboundp 'remove-from-invisibility-spec) @@ -233,62 +263,42 @@ that can be added." (member arg buffer-invisibility-spec) nil)) +(defmacro org-xemacs-without-invisibility (&rest body) + "Turn off exents with invisibility while executing BODY." + `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol) + 'all-extents-closed-open 'invisible)) + ext-inv-specs) + (dolist (ext ext-inv) + (when (extent-property ext 'invisible) + (add-to-list 'ext-inv-specs (list ext (extent-property + ext 'invisible))) + (set-extent-property ext 'invisible nil))) + ,@body + (dolist (ext-inv-spec ext-inv-specs) + (set-extent-property (car ext-inv-spec) 'invisible + (cadr ext-inv-spec))))) + (defun org-indent-to-column (column &optional minimum buffer) "Work around a bug with extents with invisibility in XEmacs." (if (featurep 'xemacs) - (let ((ext-inv (extent-list - nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property - ext 'invisible))) - (set-extent-property ext 'invisible nil))) - (indent-to-column column minimum buffer) - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec)))) + (org-xemacs-without-invisibility (indent-to-column column minimum buffer)) (indent-to-column column minimum))) (defun org-indent-line-to (column) "Work around a bug with extents with invisibility in XEmacs." (if (featurep 'xemacs) - (let ((ext-inv (extent-list - nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property - ext 'invisible))) - (set-extent-property ext 'invisible nil))) - (indent-line-to column) - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec)))) + (org-xemacs-without-invisibility (indent-line-to column)) (indent-line-to column))) (defun org-move-to-column (column &optional force buffer) (if (featurep 'xemacs) - (let ((ext-inv (extent-list - nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property ext - 'invisible))) - (set-extent-property ext 'invisible nil))) - (move-to-column column force buffer) - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec)))) + (org-xemacs-without-invisibility (move-to-column column force buffer)) (move-to-column column force))) (defun org-get-x-clipboard-compat (value) - "Get the clipboard value on XEmacs or Emacs 21" - (cond (org-xemacs-p (org-no-warnings (get-selection-no-error value))) + "Get the clipboard value on XEmacs or Emacs 21." + (cond ((featurep 'xemacs) + (org-no-warnings (get-selection-no-error value))) ((fboundp 'x-get-selection) (condition-case nil (or (x-get-selection value 'UTF8_STRING) @@ -362,6 +372,58 @@ TIME defaults to the current time." (time-to-seconds (or time (current-time))) (float-time time))) +(if (fboundp 'string-match-p) + (defalias 'org-string-match-p 'string-match-p) + (defun org-string-match-p (regexp string &optional start) + (save-match-data + (funcall 'string-match regexp string start)))) + +(if (fboundp 'looking-at-p) + (defalias 'org-looking-at-p 'looking-at-p) + (defun org-looking-at-p (&rest args) + (save-match-data + (apply 'looking-at args)))) + +; XEmacs does not have `looking-back'. +(if (fboundp 'looking-back) + (defalias 'org-looking-back 'looking-back) + (defun org-looking-back (regexp &optional limit greedy) + "Return non-nil if text before point matches regular expression REGEXP. +Like `looking-at' except matches before point, and is slower. +LIMIT if non-nil speeds up the search by specifying a minimum +starting position, to avoid checking matches that would start +before LIMIT. + +If GREEDY is non-nil, extend the match backwards as far as +possible, stopping when a single additional previous character +cannot be part of a match for REGEXP. When the match is +extended, its starting position is allowed to occur before +LIMIT." + (let ((start (point)) + (pos + (save-excursion + (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t) + (point))))) + (if (and greedy pos) + (save-restriction + (narrow-to-region (point-min) start) + (while (and (> pos (point-min)) + (save-excursion + (goto-char pos) + (backward-char 1) + (looking-at (concat "\\(?:" regexp "\\)\\'")))) + (setq pos (1- pos))) + (save-excursion + (goto-char pos) + (looking-at (concat "\\(?:" regexp "\\)\\'"))))) + (not (null pos))))) + +(defun org-floor* (x &optional y) + "Return a list of the floor of X and the fractional part of X. +With two arguments, return floor and remainder of their quotient." + (let ((q (floor x y))) + (list q (- x (if y (* y q) q))))) + (provide 'org-compat) ;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe diff --git a/lisp/org/org-complete.el b/lisp/org/org-complete.el new file mode 100644 index 00000000000..2eb1f4c3ff5 --- /dev/null +++ b/lisp/org/org-complete.el @@ -0,0 +1,279 @@ +;;; org-complete.el --- In-buffer completion code + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; John Wiegley <johnw at gnu dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 7.4 +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +;;;; Require other packages + +(eval-when-compile + (require 'cl)) + +(require 'org-macs) +(require 'pcomplete) + +(declare-function org-split-string "org" (string &optional separators)) +(declare-function org-get-current-options "org-exp" ()) +(declare-function org-make-org-heading-search-string "org" + (&optional string heading)) +(declare-function org-get-buffer-tags "org" ()) +(declare-function org-get-tags "org" ()) +(declare-function org-buffer-property-keys "org" + (&optional include-specials include-defaults include-columns)) +(declare-function org-entry-properties "org" (&optional pom which specific)) + +;;;; Customization variables + +(defgroup org-complete nil + "Outline-based notes management and organizer." + :tag "Org" + :group 'org) + +(defun org-thing-at-point () + "Examine the thing at point and let the caller know what it is. +The return value is a string naming the thing at point." + (let ((beg1 (save-excursion + (skip-chars-backward (org-re "[:alnum:]_@")) + (point))) + (beg (save-excursion + (skip-chars-backward "a-zA-Z0-9_:$") + (point))) + (line-to-here (buffer-substring (point-at-bol) (point)))) + (cond + ((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here) + (cons "block-option" "clocktable")) + ((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here) + (cons "block-option" "src")) + ((save-excursion + (re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*" + (line-beginning-position) t)) + (cons "file-option" (match-string-no-properties 1))) + ((string-match "\\`[ \t]*#\\+[a-zA-Z]*\\'" line-to-here) + (cons "file-option" nil)) + ((equal (char-before beg) ?\[) + (cons "link" nil)) + ((equal (char-before beg) ?\\) + (cons "tex" nil)) + ((string-match "\\`\\*+[ \t]+\\'" + (buffer-substring (point-at-bol) beg)) + (cons "todo" nil)) + ((equal (char-before beg) ?*) + (cons "searchhead" nil)) + ((and (equal (char-before beg1) ?:) + (equal (char-after (point-at-bol)) ?*)) + (cons "tag" nil)) + ((and (equal (char-before beg1) ?:) + (not (equal (char-after (point-at-bol)) ?*))) + (cons "prop" nil)) + (t nil)))) + +(defun org-command-at-point () + "Return the qualified name of the Org completion entity at point. +When completing for #+STARTUP, for example, this function returns +\"file-option/startup\"." + (let ((thing (org-thing-at-point))) + (cond + ((string= "file-option" (car thing)) + (concat (car thing) "/" (downcase (cdr thing)))) + ((string= "block-option" (car thing)) + (concat (car thing) "/" (downcase (cdr thing)))) + (t + (car thing))))) + +(defun org-parse-arguments () + "Parse whitespace separated arguments in the current region." + (let ((begin (line-beginning-position)) + (end (line-end-position)) + begins args) + (save-restriction + (narrow-to-region begin end) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n[") + (setq begins (cons (point) begins)) + (skip-chars-forward "^ \t\n[") + (setq args (cons (buffer-substring-no-properties + (car begins) (point)) + args))) + (cons (reverse args) (reverse begins)))))) + + +(defun org-complete-initial () + "Calls the right completion function for first argument completions." + (ignore + (funcall (or (pcomplete-find-completion-function + (car (org-thing-at-point))) + pcomplete-default-completion-function)))) + +(defvar org-additional-option-like-keywords) +(defun pcomplete/org-mode/file-option () + "Complete against all valid file options." + (require 'org-exp) + (pcomplete-here + (org-complete-case-double + (mapcar (lambda (x) + (if (= ?: (aref x (1- (length x)))) + (concat x " ") + x)) + (delq nil + (pcomplete-uniqify-list + (append + (mapcar (lambda (x) + (if (string-match "^#\\+\\([A-Z_]+:?\\)" x) + (match-string 1 x))) + (org-split-string (org-get-current-options) "\n")) + org-additional-option-like-keywords))))) + (substring pcomplete-stub 2))) + +(defvar org-startup-options) +(defun pcomplete/org-mode/file-option/startup () + "Complete arguments for the #+STARTUP file option." + (while (pcomplete-here + (let ((opts (pcomplete-uniqify-list + (mapcar 'car org-startup-options)))) + ;; Some options are mutually exclusive, and shouldn't be completed + ;; against if certain other options have already been seen. + (dolist (arg pcomplete-args) + (cond + ((string= arg "hidestars") + (setq opts (delete "showstars" opts))))) + opts)))) + +(defun pcomplete/org-mode/file-option/bind () + "Complete arguments for the #+BIND file option, which are variable names" + (let (vars) + (mapatoms + (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars))))) + (pcomplete-here vars))) + +(defvar org-link-abbrev-alist-local) +(defvar org-link-abbrev-alist) +(defun pcomplete/org-mode/link () + "Complete against defined #+LINK patterns." + (pcomplete-here + (pcomplete-uniqify-list (append (mapcar 'car org-link-abbrev-alist-local) + (mapcar 'car org-link-abbrev-alist))))) + +(defvar org-entities) +(defun pcomplete/org-mode/tex () + "Complete against TeX-style HTML entity names." + (require 'org-entities) + (while (pcomplete-here + (pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-entities))) + (substring pcomplete-stub 1)))) + +(defvar org-todo-keywords-1) +(defun pcomplete/org-mode/todo () + "Complete against known TODO keywords." + (pcomplete-here (pcomplete-uniqify-list org-todo-keywords-1))) + +(defvar org-todo-line-regexp) +(defun pcomplete/org-mode/searchhead () + "Complete against all headings. +This needs more work, to handle headings with lots of spaces in them." + (while + (pcomplete-here + (save-excursion + (goto-char (point-min)) + (let (tbl) + (while (re-search-forward org-todo-line-regexp nil t) + (push (org-make-org-heading-search-string + (match-string-no-properties 3) t) + tbl)) + (pcomplete-uniqify-list tbl))) + (substring pcomplete-stub 1)))) + +(defvar org-tag-alist) +(defun pcomplete/org-mode/tag () + "Complete a tag name. Omit tags already set." + (while (pcomplete-here + (mapcar (lambda (x) + (concat x ":")) + (let ((lst (pcomplete-uniqify-list + (or (remove + nil + (mapcar (lambda (x) + (and (stringp (car x)) (car x))) + org-tag-alist)) + (mapcar 'car (org-get-buffer-tags)))))) + (dolist (tag (org-get-tags)) + (setq lst (delete tag lst))) + lst)) + (and (string-match ".*:" pcomplete-stub) + (substring pcomplete-stub (match-end 0)))))) + +(defun pcomplete/org-mode/prop () + "Complete a property name. Omit properties already set." + (pcomplete-here + (mapcar (lambda (x) + (concat x ": ")) + (let ((lst (pcomplete-uniqify-list + (org-buffer-property-keys nil t t)))) + (dolist (prop (org-entry-properties)) + (setq lst (delete (car prop) lst))) + lst)) + (substring pcomplete-stub 1))) + +(defun pcomplete/org-mode/block-option/src () + "Complete the arguments of a begin_src block. +Complete a language in the first field, the header arguments and switches." + (pcomplete-here + (mapcar + (lambda(x) (symbol-name (nth 3 x))) + (cdr (car (cdr (memq :key-type (plist-get + (symbol-plist + 'org-babel-load-languages) + 'custom-type))))))) + (while (pcomplete-here + '("-n" "-r" "-l" + ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports" + ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames" + ":session" ":shebang" ":tangle" ":var")))) + +(defun pcomplete/org-mode/block-option/clocktable () + "Complete keywords in a clocktable line" + (while (pcomplete-here '(":maxlevel" ":scope" + ":tstart" ":tend" ":block" ":step" + ":stepskip0" ":fileskip0" + ":emphasize" ":link" ":narrow" ":indent" + ":tcolumns" ":level" ":compact" ":timestamp" + ":formula" ":formatter")))) + +(defun org-complete-case-double (list) + "Return list with both upcase and downcase version of all strings in LIST." + (let (e res) + (while (setq e (pop list)) + (setq res (cons (downcase e) (cons (upcase e) res)))) + (nreverse res))) + +;;;; Finish up + +(provide 'org-complete) + +;; arch-tag: + +;;; org-complete.el ends here diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index aee5f43007d..4d35cdcf71c 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -4,7 +4,7 @@ ;; Emacs Lisp Archive Entry ;; Filename: org-crypt.el -;; Version: 6.33x +;; Version: 7.4 ;; Keywords: org-mode ;; Author: John Wiegley <johnw@gnu.org> ;; Maintainer: Peter Jones <pjones@pmade.com> @@ -45,6 +45,7 @@ ;; decrypt it. This makes it possible to leave secure notes that ;; only the intended recipient can read in a shared-org-mode-files ;; scenario. +;; If the key is not set, org-crypt will default to symmetric encryption. ;; ;; 3. To later decrypt an entry, use `org-decrypt-entries' or ;; `org-decrypt-entry'. It might be useful to bind this to a key, @@ -66,6 +67,8 @@ (require 'org) +;;; Code: + (declare-function epg-decrypt-string "epg" (context cipher)) (declare-function epg-list-keys "epg" (context &optional name mode)) (declare-function epg-make-context "epg" @@ -80,24 +83,25 @@ :tag "Org Crypt" :group 'org) (defcustom org-crypt-tag-matcher "crypt" - "The tag matcher used to find headings whose contents should be -encrypted. See the \"Match syntax\" section of the org manual -for more details." + "The tag matcher used to find headings whose contents should be encrypted. + +See the \"Match syntax\" section of the org manual for more details." :type 'string :group 'org-crypt) (defcustom org-crypt-key nil - "The default key to use when encrypting the contents of a -heading. This can also be overridden in the CRYPTKEY property." + "The default key to use when encrypting the contents of a heading. + +This setting can also be overridden in the CRYPTKEY property." :type 'string :group 'org-crypt) (defun org-crypt-key-for-heading () - "Returns the encryption key for the current heading." + "Return the encryption key for the current heading." (save-excursion (org-back-to-heading t) - (or (org-entry-get nil "CRYPTKEY" 'selective) + (or (org-entry-get nil "CRYPTKEY" 'selective) org-crypt-key (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to) - (error "No crypt key set")))) + (message "No crypt key set, using symmetric encryption.")))) (defun org-encrypt-entry () "Encrypt the content of the current headline." @@ -105,71 +109,77 @@ heading. This can also be overridden in the CRYPTKEY property." (require 'epg) (save-excursion (org-back-to-heading t) - (forward-line) - (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) - (let ((folded (org-invisible-p)) - (epg-context (epg-make-context nil t t)) - (crypt-key (org-crypt-key-for-heading)) - (beg (point)) - end encrypted-text) - (org-end-of-subtree t t) - (org-back-over-empty-lines) - (setq end (point) - encrypted-text - (epg-encrypt-string - epg-context - (buffer-substring-no-properties beg end) - (epg-list-keys epg-context crypt-key))) - (delete-region beg end) - (insert encrypted-text) - (when folded - (save-excursion - (org-back-to-heading t) - (hide-subtree))) - nil)))) + (let ((start-heading (point))) + (forward-line) + (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) + (let ((folded (org-invisible-p)) + (epg-context (epg-make-context nil t t)) + (crypt-key (org-crypt-key-for-heading)) + (beg (point)) + end encrypted-text) + (goto-char start-heading) + (org-end-of-subtree t t) + (org-back-over-empty-lines) + (setq end (point) + encrypted-text + (epg-encrypt-string + epg-context + (buffer-substring-no-properties beg end) + (epg-list-keys epg-context crypt-key))) + (delete-region beg end) + (insert encrypted-text) + (when folded + (goto-char start-heading) + (hide-subtree)) + nil))))) (defun org-decrypt-entry () + "Decrypt the content of the current headline." (interactive) (require 'epg) - (save-excursion - (org-back-to-heading t) - (forward-line) - (when (looking-at "-----BEGIN PGP MESSAGE-----") - (let* ((beg (point)) - (end (save-excursion - (search-forward "-----END PGP MESSAGE-----") - (forward-line) - (point))) - (epg-context (epg-make-context nil t t)) - (decrypted-text - (decode-coding-string - (epg-decrypt-string - epg-context - (buffer-substring-no-properties beg end)) - 'utf-8))) - (delete-region beg end) - (insert decrypted-text) - nil)))) + (unless (org-before-first-heading-p) + (save-excursion + (org-back-to-heading t) + (forward-line) + (when (looking-at "-----BEGIN PGP MESSAGE-----") + (let* ((beg (point)) + (end (save-excursion + (search-forward "-----END PGP MESSAGE-----") + (forward-line) + (point))) + (epg-context (epg-make-context nil t t)) + (decrypted-text + (decode-coding-string + (epg-decrypt-string + epg-context + (buffer-substring-no-properties beg end)) + 'utf-8))) + (delete-region beg end) + (insert decrypted-text) + nil))))) (defun org-encrypt-entries () + "Encrypt all top-level entries in the current buffer." (interactive) (org-scan-tags 'org-encrypt-entry (cdr (org-make-tags-matcher org-crypt-tag-matcher)))) (defun org-decrypt-entries () + "Decrypt all entries in the current buffer." (interactive) - (org-scan-tags + (org-scan-tags 'org-decrypt-entry (cdr (org-make-tags-matcher org-crypt-tag-matcher)))) (defun org-crypt-use-before-save-magic () - "Adds a hook that will automatically encrypt entries before a -file is saved to disk." - (add-hook - 'org-mode-hook + "Add a hook to automatically encrypt entries before a file is saved to disk." + (add-hook + 'org-mode-hook (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t)))) - + +(add-hook 'org-reveal-start-hook 'org-decrypt-entry) + (provide 'org-crypt) ;; arch-tag: 8202ed2c-221e-4001-9e4b-54674a7e846e diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el new file mode 100644 index 00000000000..f2c631afe24 --- /dev/null +++ b/lisp/org/org-ctags.el @@ -0,0 +1,541 @@ +;;; org-ctags.el - Integrate Emacs "tags" facility with org mode. +;; +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +;; Author: Paul Sexton <eeeickythump@gmail.com> +;; Version: 7.4 + +;; Keywords: org, wp +;; Version: 7.4 +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;; +;; Synopsis +;; ======== +;; +;; Allows org-mode to make use of the Emacs `etags' system. Defines tag +;; destinations in org-mode files as any text between <<double angled +;; brackets>>. This allows the tags-generation program `exuberant ctags' to +;; parse these files and create tag tables that record where these +;; destinations are found. Plain [[links]] in org mode files which do not have +;; <<matching destinations>> within the same file will then be interpreted as +;; links to these 'tagged' destinations, allowing seamless navigation between +;; multiple org-mode files. Topics can be created in any org mode file and +;; will always be found by plain links from other files. Other file types +;; recognised by ctags (source code files, latex files, etc) will also be +;; available as destinations for plain links, and similarly, org-mode links +;; will be available as tags from source files. Finally, the function +;; `org-ctags-find-tag-interactive' lets you choose any known tag, using +;; autocompletion, and quickly jump to it. +;; +;; Installation +;; ============ +;; +;; Install org mode +;; Ensure org-ctags.el is somewhere in your emacs load path. +;; Download and install Exuberant ctags -- "http://ctags.sourceforge.net/" +;; Edit your .emacs file (see next section) and load emacs. + +;; To put in your init file (.emacs): +;; ================================== +;; +;; Assuming you already have org mode installed and set up: +;; +;; (setq org-ctags-path-to-ctags "/path/to/ctags/executable") +;; (add-hook 'org-mode-hook +;; (lambda () +;; (define-key org-mode-map "\C-co" 'org-ctags-find-tag-interactive))) +;; +;; By default, with org-ctags loaded, org will first try and visit the tag +;; with the same name as the link; then, if unsuccessful, ask the user if +;; he/she wants to rebuild the 'TAGS' database and try again; then ask if +;; the user wishes to append 'tag' as a new toplevel heading at the end of +;; the buffer; and finally, defer to org's default behaviour which is to +;; search the entire text of the current buffer for 'tag'. +;; +;; This behaviour can be modified by changing the value of +;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example I have the following in my +;; .emacs, which describes the same behaviour as the above paragraph with +;; one difference: +;; +;; (setq org-ctags-open-link-functions +;; '(org-ctags-find-tag +;; org-ctags-ask-rebuild-tags-file-then-find-tag +;; org-ctags-ask-append-topic +;; org-ctags-fail-silently)) ; <-- prevents org default behaviour +;; +;; +;; Usage +;; ===== +;; +;; When you click on a link "[[foo]]" and org cannot find a matching "<<foo>>" +;; in the current buffer, the tags facility will take over. The file TAGS in +;; the active directory is examined to see if the tags facility knows about +;; "<<foo>>" in any other files. If it does, the matching file will be opened +;; and the cursor will jump to the position of "<<foo>>" in that file. +;; +;; User-visible functions: +;; - `org-ctags-find-tag-interactive': type a tag (plain link) name and visit +;; it. With autocompletion. Bound to ctrl-O in the above setup. +;; - All the etags functions should work. These include: +;; +;; M-. `find-tag' -- finds the tag at point +;; +;; C-M-. find-tag based on regular expression +;; +;; M-x tags-search RET -- like C-M-. but searches through ENTIRE TEXT +;; of ALL the files referenced in the TAGS file. A quick way to +;; search through an entire 'project'. +;; +;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'. +;; You may need to bind this key yourself with (eg) +;; (global-set-key (kbd "<M-kp-multiply>") 'pop-tag-mark) +;; +;; (see etags chapter in Emacs manual for more) +;; +;; +;; Keeping the TAGS file up to date +;; ================================ +;; +;; Tags mode has no way of knowing that you have created new tags by typing in +;; your org-mode buffer. New tags make it into the TAGS file in 3 ways: +;; +;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file. +;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in +;; your `org-open-link-functions' list, as is done in the setup +;; above. This will cause the TAGS file to be rebuilt whenever a link +;; cannot be found. This may be slow with large file collections however. +;; 3. You run the following from the command line (all 1 line): +;; +;; ctags --langdef=orgmode --langmap=orgmode:.org +;; --regex-orgmode="/<<([^>]+)>>/\1/d,definition/" +;; -f /your/path/TAGS -e -R /your/path/*.org +;; +;; If you are paranoid, you might want to run (org-ctags-create-tags +;; "/path/to/org/files") at startup, by including the following toplevel form +;; in .emacs. However this can cause a pause of several seconds if ctags has +;; to scan lots of files. +;; +;; (progn +;; (message "-- rebuilding tags tables...") +;; (mapc 'org-create-tags tags-table-list)) + +;;; Code: + +(eval-when-compile (require 'cl)) + +(require 'org) + +(defgroup org-ctags nil + "Options concerning use of ctags within org mode." + :tag "Org-Ctags" + :group 'org-link) + +(defvar org-ctags-enabled-p t + "Activate ctags support in org mode?") + +(defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/" + "Regexp expression used by ctags external program. +The regexp matches tag destinations in org-mode files. +Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/ +See the ctags documentation for more information.") + +(defcustom org-ctags-path-to-ctags + (case system-type + (windows-nt "ctags.exe") + (darwin "ctags-exuberant") + (t "ctags-exuberant")) + "Full path to the ctags executable file." + :group 'org-ctags + :type 'file) + +(defcustom org-ctags-open-link-functions + '(org-ctags-find-tag + org-ctags-ask-rebuild-tags-file-then-find-tag + org-ctags-ask-append-topic) + "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when ORG-CTAGS is active." + :group 'org-ctags + :type 'hook + :options '(org-ctags-find-tag + org-ctags-ask-rebuild-tags-file-then-find-tag + org-ctags-rebuild-tags-file-then-find-tag + org-ctags-ask-append-topic + org-ctags-append-topic + org-ctags-ask-visit-buffer-or-file + org-ctags-visit-buffer-or-file + org-ctags-fail-silently)) + + +(defvar org-ctags-tag-list nil + "List of all tags in the active TAGS file. +Created as a local variable in each buffer.") + +(defcustom org-ctags-new-topic-template + "* <<%t>>\n\n\n\n\n\n" + "Text to insert when creating a new org file via opening a hyperlink. +The following patterns are replaced in the string: + `%t' - replaced with the capitalized title of the hyperlink" + :group 'org-ctags + :type 'string) + + +(add-hook 'org-mode-hook + (lambda () + (when (and org-ctags-enabled-p + (buffer-file-name)) + ;; Make sure this file's directory is added to default + ;; directories in which to search for tags. + (let ((tags-filename + (expand-file-name + (concat (file-name-directory (buffer-file-name)) + "/TAGS")))) + (when (file-exists-p tags-filename) + (visit-tags-table tags-filename)))))) + + +(defadvice visit-tags-table (after org-ctags-load-tag-list activate compile) + (when (and org-ctags-enabled-p tags-file-name) + (set (make-local-variable 'org-ctags-tag-list) + (org-ctags-all-tags-in-current-tags-table)))) + + +(defun org-ctags-enable () + (put 'org-mode 'find-tag-default-function 'org-ctags-find-tag-at-point) + (setq org-ctags-enabled-p t) + (dolist (fn org-ctags-open-link-functions) + (add-hook 'org-open-link-functions fn t))) + + +;;; General utility functions. =============================================== +;; These work outside org-ctags mode. + +(defun org-ctags-get-filename-for-tag (tag) + "TAG is a string. Search the active TAGS file for a matching tag. +If the tag is found, return a list containing the filename, line number, and +buffer position where the tag is found." + (interactive "sTag: ") + (unless tags-file-name + (call-interactively (visit-tags-table))) + (save-excursion + (visit-tags-table-buffer 'same) + (when tags-file-name + (with-current-buffer (get-file-buffer tags-file-name) + (goto-char (point-min)) + (cond + ((re-search-forward (format "^.*%s\\([0-9]+\\),\\([0-9]+\\)$" + (regexp-quote tag)) nil t) + (let ((line (string-to-number (match-string 1))) + (pos (string-to-number (match-string 2)))) + (cond + ((re-search-backward " \n\\(.*\\),[0-9]+\n") + (list (match-string 1) line pos)) + (t ; can't find a file name preceding the matched + ; tag?? + (error "Malformed TAGS file: %s" (buffer-name)))))) + (t ; tag not found + nil)))))) + + +(defun org-ctags-all-tags-in-current-tags-table () + "Read all tags defined in the active TAGS file, into a list of strings. +Return the list." + (interactive) + (let ((taglist nil)) + (unless tags-file-name + (call-interactively (visit-tags-table))) + (save-excursion + (visit-tags-table-buffer 'same) + (with-current-buffer (get-file-buffer tags-file-name) + (goto-char (point-min)) + (while (re-search-forward "^.*\\(.*\\)\\([0-9]+\\),\\([0-9]+\\)$" + nil t) + (push (substring-no-properties (match-string 1)) taglist))) + taglist))) + + +(defun org-ctags-string-search-and-replace (search replace string) + "Replace all instances of SEARCH with REPLACE in STRING." + (replace-regexp-in-string (regexp-quote search) replace string t t)) + + +(defun y-or-n-minibuffer (prompt) + (let ((use-dialog-box nil)) + (y-or-n-p prompt))) + + +;;; Internal functions ======================================================= + + +(defun org-ctags-open-file (name &optional title) + "Visit or create a file called `NAME.org', and insert a new topic. +The new topic will be titled NAME (or TITLE if supplied)." + (interactive "sFile name: ") + (let ((filename (substitute-in-file-name (expand-file-name name)))) + (condition-case v + (progn + (org-open-file name t) + (message "Opened file OK") + (goto-char (point-max)) + (insert (org-ctags-string-search-and-replace + "%t" (capitalize (or title name)) + org-ctags-new-topic-template)) + (message "Inserted new file text OK") + (org-mode-restart)) + (error (error "Error %S in org-ctags-open-file" v))))) + + +;;;; Misc interoperability with etags system ================================= + + +(defadvice find-tag (before org-ctags-set-org-mark-before-finding-tag + activate compile) + "Before trying to find a tag, save our current position on org mark ring." + (save-excursion + (if (and (org-mode-p) org-ctags-enabled-p) + (org-mark-ring-push)))) + + + +(defun org-ctags-find-tag-at-point () + "Determine default tag to search for, based on text at point. +If there is no plausible default, return nil." + (let (from to bound) + (when (or (ignore-errors + ;; Look for hyperlink around `point'. + (save-excursion + (search-backward "[[") (setq from (+ 2 (point)))) + (save-excursion + (goto-char from) + (search-forward "]") (setq to (- (point) 1))) + (and (> to from) (>= (point) from) (<= (point) to))) + (progn + ;; Look at text around `point'. + (save-excursion + (skip-syntax-backward "w_") (setq from (point))) + (save-excursion + (skip-syntax-forward "w_") (setq to (point))) + (> to from)) + ;; Look between `line-beginning-position' and `point'. + (save-excursion + (and (setq bound (line-beginning-position)) + (skip-syntax-backward "^w_" bound) + (> (setq to (point)) bound) + (skip-syntax-backward "w_") + (setq from (point)))) + ;; Look between `point' and `line-end-position'. + (save-excursion + (and (setq bound (line-end-position)) + (skip-syntax-forward "^w_" bound) + (< (setq from (point)) bound) + (skip-syntax-forward "w_") + (setq to (point))))) + (buffer-substring-no-properties from to)))) + + +;;; Functions for use with 'org-open-link-functions' hook ================= + + +(defun org-ctags-find-tag (name) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Look for a tag called `NAME' in the current TAGS table. If it is found, +visit the file and location where the tag is found." + (interactive "sTag: ") + (let ((old-buf (current-buffer)) + (old-pnt (point-marker)) + (old-mark (copy-marker (mark-marker)))) + (condition-case nil + (progn (find-tag name) + t) + (error + ;; only restore old location if find-tag raises error + (set-buffer old-buf) + (goto-char old-pnt) + (set-marker (mark-marker) old-mark) + nil)))) + + +(defun org-ctags-visit-buffer-or-file (name &optional create) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Visit buffer named `NAME.org'. If there is no such buffer, visit the file +with the same name if it exists. If the file does not exist, then behavior +depends on the value of CREATE. + +If CREATE is nil (default), then return nil. Do not create a new file. +If CREATE is t, create the new file and visit it. +If CREATE is the symbol `ask', then ask the user if they wish to create +the new file." + (interactive) + (let ((filename (concat (substitute-in-file-name + (expand-file-name name)) + ".org"))) + (cond + ((get-buffer (concat name ".org")) + ;; Buffer is already open + (switch-to-buffer (get-buffer (concat name ".org")))) + ((file-exists-p filename) + ;; File exists but is not open --> open it + (message "Opening existing org file `%S'..." + filename) + (org-open-file filename t)) + ((or (eql create t) + (and (eql create 'ask) + (y-or-n-p (format "File `%s.org' not found; create?" name)))) + (org-ctags-open-file filename name)) + (t ;; File does not exist, and we don't want to create it. + nil)))) + + +(defun org-ctags-ask-visit-buffer-or-file (name) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Wrapper for org-ctags-visit-buffer-or-file, which ensures the user is +asked before creating a new file." + (org-ctags-visit-buffer-or-file name 'ask)) + + +(defun org-ctags-append-topic (name &optional narrowp) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Append a new toplevel heading to the end of the current buffer. The +heading contains NAME surrounded by <<angular brackets>>, thus making +the heading a destination for the tag `NAME'." + (interactive "sTopic: ") + (widen) + (goto-char (point-max)) + (newline 2) + (message "Adding topic in buffer %s" (buffer-name)) + (insert (org-ctags-string-search-and-replace + "%t" (capitalize name) org-ctags-new-topic-template)) + (backward-char 4) + (org-update-radio-target-regexp) + (end-of-line) + (forward-line 2) + (when narrowp + ;;(org-tree-to-indirect-buffer 1) ;; opens new frame + (org-narrow-to-subtree)) + t) + + +(defun org-ctags-ask-append-topic (name &optional narrowp) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Wrapper for org-ctags-append-topic, which first asks the user if they want +to append a new topic." + (if (y-or-n-p (format "Topic `%s' not found; append to end of buffer?" + name)) + (org-ctags-append-topic name narrowp) + nil)) + + +(defun org-ctags-rebuild-tags-file-then-find-tag (name) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Like ORG-CTAGS-FIND-TAG, but calls the external ctags program first, +to rebuild (update) the TAGS file." + (unless tags-file-name + (call-interactively (visit-tags-table))) + (when (buffer-file-name) + (org-ctags-create-tags)) + (org-ctags-find-tag name)) + + +(defun org-ctags-ask-rebuild-tags-file-then-find-tag (name) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Wrapper for org-ctags-rebuild-tags-file-then-find-tag." + (if (and (buffer-file-name) + (y-or-n-p + (format + "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?" + name + (file-name-directory (buffer-file-name))))) + (org-ctags-rebuild-tags-file-then-find-tag name) + nil)) + + +(defun org-ctags-fail-silently (name) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Put as the last function in the list if you want to prevent org's default +behavior of free text search." + t) + + +;;; User-visible functions =================================================== + + +(defun org-ctags-create-tags (&optional directory-name) + "(Re)create tags file in the directory of the active buffer. +The file will contain tag definitions for all the files in the +directory and its subdirectories which are recognized by ctags. +This will include files ending in `.org' as well as most other +source files (.C, .H, .EL, .LISP, etc). All the resulting tags +end up in one file, called TAGS, located in the directory. This +function may take several seconds to finish if the directory or +its subdirectories contain large numbers of taggable files." + (interactive) + (assert (buffer-file-name)) + (let ((dir-name (or directory-name + (file-name-directory (buffer-file-name)))) + (exitcode nil)) + (save-excursion + (setq exitcode + (shell-command + (format (concat "%s --langdef=orgmode --langmap=orgmode:.org " + "--regex-orgmode=\"%s\" -f \"%s\" -e -R \"%s\"") + org-ctags-path-to-ctags + org-ctags-tag-regexp + (expand-file-name (concat dir-name "/TAGS")) + (expand-file-name (concat dir-name "/*"))))) + (cond + ((eql 0 exitcode) + (set (make-local-variable 'org-ctags-tag-list) + (org-ctags-all-tags-in-current-tags-table))) + (t + ;; This seems to behave differently on Linux, so just ignore + ;; error codes for now + ;;(error "Calling ctags executable resulted in error code: %s" + ;; exitcode) + nil))))) + + +(defvar org-ctags-find-tag-history nil + "History of tags visited by org-ctags-find-tag-interactive.") + +(defun org-ctags-find-tag-interactive () + "Prompt for the name of a tag, with autocompletion, then visit the named tag. +Uses `ido-mode' if available. +If the user enters a string that does not match an existing tag, create +a new topic." + (interactive) + (let* ((completing-read-fn (if (fboundp 'ido-completing-read) + 'ido-completing-read + 'completing-read)) + (tag (funcall completing-read-fn "Topic: " org-ctags-tag-list + nil 'confirm nil 'org-ctags-find-tag-history))) + (when tag + (cond + ((member tag org-ctags-tag-list) + ;; Existing tag + (push tag org-ctags-find-tag-history) + (find-tag tag)) + (t + ;; New tag + (run-hook-with-args-until-success + 'org-open-link-functions tag)))))) + + +(org-ctags-enable) + +(provide 'org-ctags) + +;; arch-tag: 4b1ddd5a-8529-4b17-bcde-96a922d26343 +;;; org-ctags.el ends here diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index 1a80519e4d5..7746109d452 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -36,13 +36,14 @@ (defvar org-datetree-base-level 1 "The level at which years should be placed in the date tree. This is normally one, but if the buffer has an entry with a DATE_TREE -property, the date tree will become a subtree under that entry, so the -base level will be properly adjusted.") +property (any value), the date tree will become a subtree under that entry, +so the base level will be properly adjusted.") +;;;###autoload (defun org-datetree-find-date-create (date &optional keep-restriction) "Find or create an entry for DATE. If KEEP-RESTRICTION is non-nil, do not widen the buffer. -When it is nit, the buffer will be widened to make sure an existing date +When it is nil, the buffer will be widened to make sure an existing date tree can be found." (let ((year (nth 2 date)) (month (car date)) diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el index 22081ab4f32..ca82d8ffcb6 100644 --- a/lisp/org/org-docbook.el +++ b/lisp/org/org-docbook.el @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-docbook.el -;; Version: 6.33x +;; Version: 7.4 ;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Keywords: org, wp, docbook @@ -26,7 +26,7 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -;; Commentary: +;;; Commentary: ;; ;; This library implements a DocBook exporter for org-mode. The basic ;; idea and design is very similar to what `org-export-as-html' has. @@ -76,6 +76,7 @@ (require 'org) (require 'org-exp) (require 'org-html) +(require 'format-spec) ;;; Variables: @@ -141,8 +142,8 @@ people work on the same document." :type 'string) (defcustom org-export-docbook-footnote-id-prefix "fn-" - "The prefix of footnote IDs used during exporting. Like -`org-export-docbook-section-id-prefix', this variable can help + "The prefix of footnote IDs used during exporting. +Like `org-export-docbook-section-id-prefix', this variable can help avoid same set of footnote IDs being used multiple times." :group 'org-export-docbook :type 'string) @@ -154,7 +155,7 @@ avoid same set of footnote IDs being used multiple times." ("=" "<code>" "</code>") ("~" "<literal>" "</literal>") ("+" "<emphasis role=\"strikethrough\">" "</emphasis>")) - "Alist of DocBook expressions to convert emphasis fontifiers. + "A list of DocBook expressions to convert emphasis fontifiers. Each element of the list is a list of three elements. The first element is the character used as a marker for fontification. The second element is a formatting string to wrap fontified text with. @@ -183,32 +184,39 @@ default, but users can override them using `#+ATTR_DocBook:'." :group 'org-export-docbook :type 'coding-system) +(defcustom org-export-docbook-xslt-stylesheet nil + "File name of the XSLT stylesheet used by DocBook exporter. +This XSLT stylesheet is used by +`org-export-docbook-xslt-proc-command' to generate the Formatting +Object (FO) files. You can use either `fo/docbook.xsl' that +comes with DocBook, or any customization layer you may have." + :group 'org-export-docbook + :type 'string) + (defcustom org-export-docbook-xslt-proc-command nil - "XSLT processor command used by DocBook exporter. -This is the command used to process a DocBook XML file to -generate the formatting object (FO) file. + "Format of XSLT processor command used by DocBook exporter. +This command is used to process a DocBook XML file to generate +the Formatting Object (FO) file. The value of this variable should be a format control string that -includes two `%s' arguments: the first one is for the output FO -file name, and the second one is for the input DocBook XML file -name. +includes three arguments: `%i', `%o', and `%s'. During exporting +time, `%i' is replaced by the input DocBook XML file name, `%o' +is replaced by the output FO file name, and `%s' is replaced by +`org-export-docbook-xslt-stylesheet' (or the #+XSLT option if it +is specified in the Org file). For example, if you use Saxon as the XSLT processor, you may want to set the variable to - \"java com.icl.saxon.StyleSheet -o %s %s /path/to/docbook.xsl\" + \"java com.icl.saxon.StyleSheet -o %o %i %s\" If you use Xalan, you can set it to - \"java org.apache.xalan.xslt.Process -out %s -in %s -xsl /path/to/docbook.xsl\" + \"java org.apache.xalan.xslt.Process -out %o -in %i -xsl %s\" For xsltproc, the following string should work: - \"xsltproc --output %s /path/to/docbook.xsl %s\" - -You need to replace \"/path/to/docbook.xsl\" with the actual path -to the DocBook stylesheet file on your machine. You can also -replace it with your own customization layer if you have one. + \"xsltproc --output %o %s %i\" You can include additional stylesheet parameters in this command. Just make sure that they meet the syntax requirement of each @@ -217,18 +225,19 @@ processor." :type 'string) (defcustom org-export-docbook-xsl-fo-proc-command nil - "XSL-FO processor command used by DocBook exporter. -This is the command used to process a formatting object (FO) file -to generate the PDF file. + "Format of XSL-FO processor command used by DocBook exporter. +This command is used to process a Formatting Object (FO) file to +generate the PDF file. The value of this variable should be a format control string that -includes two `%s' arguments: the first one is for the input FO -file name, and the second one is for the output PDF file name. +includes two arguments: `%i' and `%o'. During exporting time, +`%i' is replaced by the input FO file name, and `%o' is replaced +by the output PDF file name. For example, if you use FOP as the XSL-FO processor, you can set the variable to - \"fop %s %s\"" + \"fop %i %o\"" :group 'org-export-docbook :type 'string) @@ -333,13 +342,18 @@ in a window. A non-interactive call will only return the buffer." "Export as DocBook XML file, and generate PDF file." (interactive "P") (if (or (not org-export-docbook-xslt-proc-command) - (not (string-match "%s.+%s" org-export-docbook-xslt-proc-command))) + (not (string-match "%[ios].+%[ios].+%[ios]" org-export-docbook-xslt-proc-command))) (error "XSLT processor command is not set correctly")) (if (or (not org-export-docbook-xsl-fo-proc-command) - (not (string-match "%s.+%s" org-export-docbook-xsl-fo-proc-command))) + (not (string-match "%[io].+%[io]" org-export-docbook-xsl-fo-proc-command))) (error "XSL-FO processor command is not set correctly")) (message "Exporting to PDF...") (let* ((wconfig (current-window-configuration)) + (opt-plist + (org-export-process-option-filters + (org-combine-plists (org-default-export-plist) + ext-plist + (org-infile-export-plist)))) (docbook-buf (org-export-as-docbook hidden ext-plist to-buffer body-only pub-dir)) (filename (buffer-file-name docbook-buf)) @@ -348,10 +362,17 @@ in a window. A non-interactive call will only return the buffer." (pdffile (concat base ".pdf"))) (and (file-exists-p pdffile) (delete-file pdffile)) (message "Processing DocBook XML file...") - (shell-command (format org-export-docbook-xslt-proc-command - fofile (shell-quote-argument filename))) - (shell-command (format org-export-docbook-xsl-fo-proc-command - fofile pdffile)) + (shell-command (format-spec org-export-docbook-xslt-proc-command + (format-spec-make + ?i (shell-quote-argument filename) + ?o (shell-quote-argument fofile) + ?s (shell-quote-argument + (or (plist-get opt-plist :xslt) + org-export-docbook-xslt-stylesheet))))) + (shell-command (format-spec org-export-docbook-xsl-fo-proc-command + (format-spec-make + ?i (shell-quote-argument fofile) + ?o (shell-quote-argument pdffile)))) (message "Processing DocBook file...done") (if (not (file-exists-p pdffile)) (error "PDF file was not produced") @@ -384,6 +405,8 @@ header and footer, simply return the content of the document (all top-level sections). When PUB-DIR is set, use this as the publishing directory." (interactive "P") + (run-hooks 'org-export-first-hook) + ;; Make sure we have a file name when we need it. (when (and (not (or to-buffer body-only)) (not buffer-file-name)) @@ -529,9 +552,9 @@ publishing directory." (nth 2 (assoc "=" org-export-docbook-emphasis-alist))) table-open type table-buffer table-orig-buffer - ind item-type starter didclose + ind item-type starter rpl path attr caption label desc descp desc1 desc2 link - fnc item-tag + fnc item-tag item-number footref-seen footnote-list id-file ) @@ -609,7 +632,9 @@ publishing directory." </info>\n" (org-docbook-expand title) firstname othername surname - (if email (concat "<email>" email "</email>") "") + (if (and org-export-email-info + email (string-match "\\S-" email)) + (concat "<email>" email "</email>") "") ))) (org-init-section-numbers) @@ -622,7 +647,7 @@ publishing directory." ;; End of quote section? (when (and inquote (string-match "^\\*+ " line)) - (insert "]]>\n</programlisting>\n") + (insert "]]></programlisting>\n") (org-export-docbook-open-para) (setq inquote nil)) ;; Inside a quote section? @@ -642,11 +667,25 @@ publishing directory." (not (string-match "^[ \t]*\\(:.*\\)" (car lines)))) (setq infixed nil) - (insert "]]>\n</programlisting>\n") + (insert "]]></programlisting>\n") (org-export-docbook-open-para)) (throw 'nextline nil)) - (org-export-docbook-close-lists-maybe line) + ;; List ender: close every open list. + (when (equal "ORG-LIST-END" line) + (while local-list-type + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "</orderedlist>\n") + ((equal listtype "u") "</itemizedlist>\n") + ((equal listtype "d") "</variablelist>\n")))) + (pop local-list-type)) + ;; We did close a list, normal text follows: need <para> + (org-export-docbook-open-para) + (setq local-list-indent nil + in-local-list nil) + (throw 'nextline nil)) ;; Protected HTML (when (get-text-property 0 'org-protected line) @@ -910,7 +949,8 @@ publishing directory." (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start) (if (get-text-property (match-beginning 2) 'org-protected line) (setq start (match-end 2)) - (let ((num (match-string 2 line))) + (let* ((num (match-string 2 line)) + (footnote-def (assoc num footnote-list))) (if (assoc num footref-seen) (setq line (replace-match (format "%s<footnoteref linkend=\"%s%s\"/>" @@ -922,9 +962,10 @@ publishing directory." (match-string 1 line) org-export-docbook-footnote-id-prefix num - (save-match-data - (org-docbook-expand - (cdr (assoc num footnote-list))))) + (if footnote-def + (save-match-data + (org-docbook-expand (cdr footnote-def))) + (format "FOOTNOTE DEFINITION NOT FOUND: %s" num))) t t line)) (push (cons num 1) footref-seen)))))) @@ -936,18 +977,6 @@ publishing directory." txt (match-string 2 line)) (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt))) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) (org-export-docbook-level-start level txt) ;; QUOTES (when (string-match quote-re line) @@ -976,7 +1005,9 @@ publishing directory." table-orig-buffer (nreverse table-orig-buffer)) (org-export-docbook-close-para-maybe) (insert (org-export-docbook-finalize-table - (org-format-table-html table-buffer table-orig-buffer))))) + (org-format-table-html table-buffer table-orig-buffer + 'no-css))))) + (t ;; Normal lines (when (string-match @@ -992,31 +1023,15 @@ publishing directory." starter (if (match-beginning 2) (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5)) - item-tag nil) + item-tag nil + item-number nil) + (if (string-match "\\[@\\(?:start:\\)?\\([0-9]+\\)\\][ \t]?" line) + (setq item-number (match-string 1 line) + line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) (setq item-type "d" item-tag (match-string 1 line) line (substring line (match-end 0)))) - (when (and (not (equal item-type "d")) - (not (string-match "[^ \t]" line))) - ;; Empty line. Pretend indentation is large. - (setq ind (if org-empty-line-terminates-plain-lists - 0 - (1+ (or (car local-list-indent) 1))))) - (setq didclose nil) - (while (and in-local-list - (or (and (= ind (car local-list-indent)) - (not starter)) - (< ind (car local-list-indent)))) - (setq didclose t) - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) (cond ((and starter (or (not in-local-list) @@ -1025,6 +1040,15 @@ publishing directory." (org-export-docbook-close-para-maybe) (insert (cond ((equal item-type "u") "<itemizedlist>\n<listitem>\n") + ((and (equal item-type "o") item-number) + ;; Check for a specific start number. If it + ;; is specified, we use the ``override'' + ;; attribute of element <listitem> to pass the + ;; info to DocBook. We could also use the + ;; ``startingnumber'' attribute of element + ;; <orderedlist>, but the former works on both + ;; DocBook 5.0 and prior versions. + (format "<orderedlist>\n<listitem override=\"%s\">\n" item-number)) ((equal item-type "o") "<orderedlist>\n<listitem>\n") ((equal item-type "d") (format "<variablelist>\n<varlistentry><term>%s</term><listitem>\n" item-tag)))) @@ -1034,11 +1058,27 @@ publishing directory." (push item-type local-list-type) (push ind local-list-indent) (setq in-local-list t)) - (starter ;; Continue current list + (starter + ;; terminate any previous sublist but first ensure + ;; list is not ill-formed + (let ((min-ind (apply 'min local-list-indent))) + (when (< ind min-ind) (setq ind min-ind))) + (while (< ind (car local-list-indent)) + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "</orderedlist>\n") + ((equal listtype "u") "</itemizedlist>\n") + ((equal listtype "d") "</variablelist>\n")))) + (pop local-list-type) (pop local-list-indent) + (setq in-local-list local-list-indent)) + ;; insert new item (let ((listtype (car local-list-type))) (org-export-docbook-close-li listtype) (insert (cond + ((and (equal listtype "o") item-number) + (format "<listitem override=\"%s\">" item-number)) ((equal listtype "o") "<listitem>") ((equal listtype "u") "<listitem>") ((equal listtype "d") (format @@ -1047,9 +1087,6 @@ publishing directory." "???")))))) ;; For DocBook, we need to open a para right after tag ;; <listitem>. - (org-export-docbook-open-para)) - (didclose - ;; We did close a list, normal text follows: need <para> (org-export-docbook-open-para))) ;; Checkboxes. (if (string-match "^[ \t]*\\(\\[[X -]\\]\\)" line) @@ -1090,20 +1127,9 @@ publishing directory." ;; Properly close all local lists and other lists (when inquote - (insert "]]>\n</programlisting>\n") + (insert "]]></programlisting>\n") (org-export-docbook-open-para)) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) + ;; Close all open sections. (org-export-docbook-level-start 1 nil) @@ -1119,6 +1145,13 @@ publishing directory." "[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t) (when (not (get-text-property (match-beginning 1) 'org-protected)) (replace-match "\n") + ;; Avoid empty <listitem></listitem> caused by inline tasks. + ;; We should add an empty para to make everything valid. + (when (and (looking-at "</listitem>") + (save-excursion + (backward-char (length "<listitem>\n")) + (looking-at "<listitem>"))) + (insert "<para></para>")) (backward-char 1))) ;; Fill empty sections with <para></para>. This is to make sure ;; that the DocBook document generated is valid and well-formed. @@ -1163,24 +1196,6 @@ publishing directory." (defvar in-local-list) (defvar local-list-indent) (defvar local-list-type) -(defun org-export-docbook-close-lists-maybe (line) - (let ((ind (or (get-text-property 0 'original-indentation line))) -; (and (string-match "\\S-" line) -; (org-get-indentation line)))) - didclose) - (when ind - (while (and in-local-list - (<= ind (car local-list-indent))) - (setq didclose t) - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) - (and didclose (org-export-docbook-open-para))))) (defun org-export-docbook-level-start (level title) "Insert a new level in DocBook export. @@ -1200,7 +1215,7 @@ When TITLE is nil, just close all open levels." ;; all levels, so the rest is done only if title is given. ;; ;; Format tags: put them into a superscript like format. - (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) (setq title (replace-match (if org-export-with-tags @@ -1215,7 +1230,8 @@ When TITLE is nil, just close all open levels." (setq section-number (org-section-number level)) (insert (format "\n<section xml:id=\"%s%s\">\n<title>%s</title>" org-export-docbook-section-id-prefix - section-number title)) + (replace-regexp-in-string "\\." "_" section-number) + title)) (org-export-docbook-open-para)))) (defun org-docbook-expand (string) @@ -1223,7 +1239,7 @@ When TITLE is nil, just close all open levels." Applies all active conversions. If there are links in the string, don't modify these." (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) + (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) m s l res) (while (setq m (string-match re string)) (setq s (substring string 0 m) @@ -1246,16 +1262,14 @@ string, don't modify these." (if org-export-with-sub-superscripts (setq s (org-export-docbook-convert-sub-super s))) (if org-export-with-TeX-macros - (let ((start 0) wd ass) + (let ((start 0) wd rep) (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?" s start)) (if (get-text-property (match-beginning 0) 'org-protected s) (setq start (match-end 0)) (setq wd (match-string 1 s)) - (if (setq ass (assoc wd org-html-entities)) - (setq s (replace-match (or (cdr ass) - (concat "&" (car ass) ";")) - t t s)) + (if (setq rep (org-entity-get-representation wd 'html)) + (setq s (replace-match rep t t s)) (setq start (+ start (length wd)))))))) s) @@ -1312,6 +1326,7 @@ string, don't modify these." (label (org-find-text-property-in-string 'org-label src)) (default-attr org-export-docbook-default-image-attributes) tmp) + (setq caption (and caption (org-html-do-expand caption))) (while (setq tmp (pop default-attr)) (if (not (string-match (concat (car tmp) "=") attr)) (setq attr (concat attr " " (car tmp) "=" (cdr tmp))))) @@ -1337,18 +1352,33 @@ string, don't modify these." (replace-match "")))) (defun org-export-docbook-finalize-table (table) - "Change TABLE to informaltable if caption does not exist. + "Clean up TABLE and turn it into DocBook format. +This function adds a label to the table if it is available, and +also changes TABLE to informaltable if caption does not exist. TABLE is a string containing the HTML code generated by `org-format-table-html' for a table in Org-mode buffer." - (if (string-match - "^<table \\(\\(.\\|\n\\)+\\)<caption></caption>\n\\(\\(.\\|\n\\)+\\)</table>" - table) - (replace-match (concat "<informaltable " - (match-string 1 table) - (match-string 3 table) - "</informaltable>") - nil nil table) - table)) + (let (table-with-label) + ;; Get the label if it exists, and move it into the <table> element. + (setq table-with-label + (if (string-match + "^<table \\(\\(.\\|\n\\)+\\)<a name=\"\\(.+\\)\" id=\".+\"></a>\n\\(\\(.\\|\n\\)+\\)</table>" + table) + (replace-match (concat "<table xml:id=\"" (match-string 3 table) "\" " + (match-string 1 table) + (match-string 4 table) + "</table>") + nil nil table) + table)) + ;; Change <table> into <informaltable> if caption does not exist. + (if (string-match + "^<table \\(\\(.\\|\n\\)+\\)<caption></caption>\n\\(\\(.\\|\n\\)+\\)</table>" + table-with-label) + (replace-match (concat "<informaltable " + (match-string 1 table-with-label) + (match-string 3 table-with-label) + "</informaltable>") + nil nil table-with-label) + table-with-label))) ;; Note: This function is very similar to ;; org-export-html-convert-sub-super. They can be merged in the future. diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el new file mode 100644 index 00000000000..cb0f24139a2 --- /dev/null +++ b/lisp/org/org-docview.el @@ -0,0 +1,93 @@ +;;; org-docview.el --- support for links to doc-view-mode buffers + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Jan Böcker <jan.boecker at jboecker dot de> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 7.4 +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file implements links to open files in doc-view-mode. +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. + +;; The links take the form +;; +;; docview:<file path>::<page number> +;; +;; for example: [[docview:~/.elisp/org/doc/org.pdf::1][Org-Mode Manual]] +;; +;; Autocompletion for inserting links is supported; you will be +;; prompted for a file and a page number. +;; +;; If you use org-store-link in a doc-view mode buffer, the stored +;; link will point to the current page. + +;;; Code: + + +(require 'org) + +(declare-function doc-view-goto-page "ext:doc-view" (page)) +(declare-function image-mode-window-get "ext:image-mode" + (prop &optional winprops)) + +(autoload 'doc-view-goto-page "doc-view") + +(org-add-link-type "docview" 'org-docview-open) +(add-hook 'org-store-link-functions 'org-docview-store-link) + +(defun org-docview-open (link) + (when (string-match "\\(.*\\)::\\([0-9]+\\)$" link) + (let* ((path (match-string 1 link)) + (page (string-to-number (match-string 2 link)))) + (org-open-file path 1) ;; let org-mode open the file (in-emacs = 1) + ;; to ensure org-link-frame-setup is respected + (doc-view-goto-page page) + ))) + +(defun org-docview-store-link () + "Store a link to a docview buffer." + (when (eq major-mode 'doc-view-mode) + ;; This buffer is in doc-view-mode + (let* ((path buffer-file-name) + (page (image-mode-window-get 'page)) + (link (concat "docview:" path "::" (number-to-string page))) + (description "")) + (org-store-link-props + :type "docview" + :link link + :description path)))) + +(defun org-docview-complete-link () + "Use the existing file name completion for file. +Links to get the file name, then ask the user for the page number +and append it." + (concat (replace-regexp-in-string "^file:" "docview:" (org-file-complete-link)) + "::" + (read-from-minibuffer "Page:" "1"))) + + +(provide 'org-docview) + +;; arch-tag: dd147a78-cce1-481b-b40a-15869417debe + +;;; org-docview.el ends here diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el new file mode 100644 index 00000000000..1c99b9eb5a5 --- /dev/null +++ b/lisp/org/org-entities.el @@ -0,0 +1,573 @@ +;;; org-entities.el --- Support for special entities in Org-mode + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org>, +;; Ulf Stegemann <ulf at zeitform dot de> +;; Keywords: outlines, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 7.4 +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;;; Code: + +(require 'org-macs) + +(declare-function org-table-align "org-table" ()) + +(eval-when-compile + (require 'cl)) + +(defgroup org-entities nil + "Options concerning entities in Org-mode." + :tag "Org Entities" + :group 'org) + +(defcustom org-entities-ascii-explanatory nil + "Non-nil means replace special entities in ASCII. +For example, this will replace \"\\nsup\" with \"[not a superset of]\" +in backends where the corresponding character is not available." + :group 'org-entities + :type 'boolean) + +(defcustom org-entities-user nil + "User-defined entities used in Org-mode to produce special characters. +Each entry in this list is a list of strings. It associates the name +of the entity that can be inserted into an Org file as \\name with the +appropriate replacements for the different export backends. The order +of the fields is the following + +name As a string, without the leading backslash +LaTeX replacement In ready LaTeX, no further processing will take place +LaTeX mathp A Boolean, either t or nil. t if this entity needs + to be in math mode. +HTML replacement In ready HTML, no further processing will take place. + Usually this will be an &...; entity. +ASCII replacement Plain ASCII, no extensions. Symbols that cannot be + represented will be left as they are, but see the. + variable `org-entities-ascii-explanatory'. +Latin1 replacement Use the special characters available in latin1. +utf-8 replacement Use the special characters available in utf-8. + +If you define new entities here that require specific LaTeX packages to be +loaded, add these packages to `org-export-latex-packages-alist'." + :group 'org-entities + :type '(repeat + (list + (string :tag "name ") + (string :tag "LaTeX ") + (boolean :tag "Require LaTeX math?") + (string :tag "HTML ") + (string :tag "ASCII ") + (string :tag "Latin1") + (string :tag "utf-8 ")))) + +(defconst org-entities + '( + "* Letters" + "** Latin" + ("Agrave" "\\`{A}" nil "À" "A" "À" "À") + ("agrave" "\\`{a}" nil "à" "a" "à" "à") + ("Aacute" "\\'{A}" nil "Á" "A" "Á" "Á") + ("aacute" "\\'{a}" nil "á" "a" "á" "á") + ("Acirc" "\\^{A}" nil "Â" "A" "Â" "Â") + ("acirc" "\\^{a}" nil "â" "a" "â" "â") + ("Atilde" "\\~{A}" nil "Ã" "A" "Ã" "Ã") + ("atilde" "\\~{a}" nil "ã" "a" "ã" "ã") + ("Auml" "\\\"{A}" nil "Ä" "Ae" "Ä" "Ä") + ("auml" "\\\"{a}" nil "ä" "ae" "ä" "ä") + ("Aring" "\\AA{}" nil "Å" "A" "Å" "Å") + ("AA" "\\AA{}" nil "Å" "A" "Å" "Å") + ("aring" "\\aa{}" nil "å" "a" "å" "å") + ("AElig" "\\AE{}" nil "Æ" "AE" "Æ" "Æ") + ("aelig" "\\ae{}" nil "æ" "ae" "æ" "æ") + ("Ccedil" "\\c{C}" nil "Ç" "C" "Ç" "Ç") + ("ccedil" "\\c{c}" nil "ç" "c" "ç" "ç") + ("Egrave" "\\`{E}" nil "È" "E" "È" "È") + ("egrave" "\\`{e}" nil "è" "e" "è" "è") + ("Eacute" "\\'{E}" nil "É" "E" "É" "É") + ("eacute" "\\'{e}" nil "é" "e" "é" "é") + ("Ecirc" "\\^{E}" nil "Ê" "E" "Ê" "Ê") + ("ecirc" "\\^{e}" nil "ê" "e" "ê" "ê") + ("Euml" "\\\"{E}" nil "Ë" "E" "Ë" "Ë") + ("euml" "\\\"{e}" nil "ë" "e" "ë" "ë") + ("Igrave" "\\`{I}" nil "Ì" "I" "Ì" "Ì") + ("igrave" "\\`{i}" nil "ì" "i" "ì" "ì") + ("Iacute" "\\'{I}" nil "Í" "I" "Í" "Í") + ("iacute" "\\'{i}" nil "í" "i" "í" "í") + ("Icirc" "\\^{I}" nil "Î" "I" "Î" "Î") + ("icirc" "\\^{i}" nil "î" "i" "î" "î") + ("Iuml" "\\\"{I}" nil "Ï" "I" "Ï" "Ï") + ("iuml" "\\\"{i}" nil "ï" "i" "ï" "ï") + ("Ntilde" "\\~{N}" nil "Ñ" "N" "Ñ" "Ñ") + ("ntilde" "\\~{n}" nil "ñ" "n" "ñ" "ñ") + ("Ograve" "\\`{O}" nil "Ò" "O" "Ò" "Ò") + ("ograve" "\\`{o}" nil "ò" "o" "ò" "ò") + ("Oacute" "\\'{O}" nil "Ó" "O" "Ó" "Ó") + ("oacute" "\\'{o}" nil "ó" "o" "ó" "ó") + ("Ocirc" "\\^{O}" nil "Ô" "O" "Ô" "Ô") + ("ocirc" "\\^{o}" nil "ô" "o" "ô" "ô") + ("Otilde" "\\~{O}" nil "Õ" "O" "Õ" "Õ") + ("otilde" "\\~{o}" nil "õ" "o" "õ" "õ") + ("Ouml" "\\\"{O}" nil "Ö" "Oe" "Ö" "Ö") + ("ouml" "\\\"{o}" nil "ö" "oe" "ö" "ö") + ("Oslash" "\\O" nil "Ø" "O" "Ø" "Ø") + ("oslash" "\\o{}" nil "ø" "o" "ø" "ø") + ("OElig" "\\OE{}" nil "Œ" "OE" "OE" "Œ") + ("oelig" "\\oe{}" nil "œ" "oe" "oe" "œ") + ("Scaron" "\\v{S}" nil "Š" "S" "S" "Š") + ("scaron" "\\v{s}" nil "š" "s" "s" "š") + ("szlig" "\\ss{}" nil "ß" "ss" "ß" "ß") + ("Ugrave" "\\`{U}" nil "Ù" "U" "Ù" "Ù") + ("ugrave" "\\`{u}" nil "ù" "u" "ù" "ù") + ("Uacute" "\\'{U}" nil "Ú" "U" "Ú" "Ú") + ("uacute" "\\'{u}" nil "ú" "u" "ú" "ú") + ("Ucirc" "\\^{U}" nil "Û" "U" "Û" "Û") + ("ucirc" "\\^{u}" nil "û" "u" "û" "û") + ("Uuml" "\\\"{U}" nil "Ü" "Ue" "Ü" "Ü") + ("uuml" "\\\"{u}" nil "ü" "ue" "ü" "ü") + ("Yacute" "\\'{Y}" nil "Ý" "Y" "Ý" "Ý") + ("yacute" "\\'{y}" nil "ý" "y" "ý" "ý") + ("Yuml" "\\\"{Y}" nil "Ÿ" "Y" "Y" "Ÿ") + ("yuml" "\\\"{y}" nil "ÿ" "y" "ÿ" "ÿ") + + "** Latin (special face)" + ("fnof" "\\textit{f}" nil "ƒ" "f" "f" "ƒ") + ("real" "\\Re" t "ℜ" "R" "R" "ℜ") + ("image" "\\Im" t "ℑ" "I" "I" "ℑ") + ("weierp" "\\wp" t "℘" "P" "P" "℘") + + "** Greek" + ("Alpha" "A" nil "Α" "Alpha" "Alpha" "Α") + ("alpha" "\\alpha" t "α" "alpha" "alpha" "α") + ("Beta" "B" nil "Β" "Beta" "Beta" "Β") + ("beta" "\\beta" t "β" "beta" "beta" "β") + ("Gamma" "\\Gamma" t "Γ" "Gamma" "Gamma" "Γ") + ("gamma" "\\gamma" t "γ" "gamma" "gamma" "γ") + ("Delta" "\\Delta" t "Δ" "Delta" "Gamma" "Δ") + ("delta" "\\delta" t "δ" "delta" "delta" "δ") + ("Epsilon" "E" nil "Ε" "Epsilon" "Epsilon" "Ε") + ("epsilon" "\\epsilon" t "ε" "epsilon" "epsilon" "ε") + ("varepsilon" "\\varepsilon" t "ε" "varepsilon" "varepsilon" "ε") + ("Zeta" "Z" nil "Ζ" "Zeta" "Zeta" "Ζ") + ("zeta" "\\zeta" t "ζ" "zeta" "zeta" "ζ") + ("Eta" "H" nil "Η" "Eta" "Eta" "Η") + ("eta" "\\eta" t "η" "eta" "eta" "η") + ("Theta" "\\Theta" t "Θ" "Theta" "Theta" "Θ") + ("theta" "\\theta" t "θ" "theta" "theta" "θ") + ("thetasym" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") + ("vartheta" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") + ("Iota" "I" nil "Ι" "Iota" "Iota" "Ι") + ("iota" "\\iota" t "ι" "iota" "iota" "ι") + ("Kappa" "K" nil "Κ" "Kappa" "Kappa" "Κ") + ("kappa" "\\kappa" t "κ" "kappa" "kappa" "κ") + ("Lambda" "\\Lambda" t "Λ" "Lambda" "Lambda" "Λ") + ("lambda" "\\lambda" t "λ" "lambda" "lambda" "λ") + ("Mu" "M" nil "Μ" "Mu" "Mu" "Μ") + ("mu" "\\mu" t "μ" "mu" "mu" "μ") + ("nu" "\\nu" t "ν" "nu" "nu" "ν") + ("Nu" "N" nil "Ν" "Nu" "Nu" "Ν") + ("Xi" "\\Xi" t "Ξ" "Xi" "Xi" "Ξ") + ("xi" "\\xi" t "ξ" "xi" "xi" "ξ") + ("Omicron" "O" nil "Ο" "Omicron" "Omicron" "Ο") + ("omicron" "\\textit{o}" nil "ο" "omicron" "omicron" "ο") + ("Pi" "\\Pi" t "Π" "Pi" "Pi" "Π") + ("pi" "\\pi" t "π" "pi" "pi" "π") + ("Rho" "P" nil "Ρ" "Rho" "Rho" "Ρ") + ("rho" "\\rho" t "ρ" "rho" "rho" "ρ") + ("Sigma" "\\Sigma" t "Σ" "Sigma" "Sigma" "Σ") + ("sigma" "\\sigma" t "σ" "sigma" "sigma" "σ") + ("sigmaf" "\\varsigma" t "ς" "sigmaf" "sigmaf" "ς") + ("varsigma" "\\varsigma" t "ς" "varsigma" "varsigma" "ς") + ("Tau" "T" nil "Τ" "Tau" "Tau" "Τ") + ("Upsilon" "\\Upsilon" t "Υ" "Upsilon" "Upsilon" "Υ") + ("upsih" "\\Upsilon" t "ϒ" "upsilon" "upsilon" "ϒ") + ("upsilon" "\\upsilon" t "υ" "upsilon" "upsilon" "υ") + ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") + ("phi" "\\phi" t "φ" "phi" "phi" "φ") + ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") + ("chi" "\\chi" t "χ" "chi" "chi" "χ") + ("acutex" "\\acute x" t "´x" "'x" "'x" "𝑥́") + ("Psi" "\\Psi" t "Ψ" "Psi" "Psi" "Ψ") + ("psi" "\\psi" t "ψ" "psi" "psi" "ψ") + ("tau" "\\tau" t "τ" "tau" "tau" "τ") + ("Omega" "\\Omega" t "Ω" "Omega" "Omega" "Ω") + ("omega" "\\omega" t "ω" "omega" "omega" "ω") + ("piv" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") + ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "∂") + + "** Hebrew" + ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + + "** Dead languages" + ("ETH" "\\DH{}" nil "Ð" "D" "Ð" "Ð") + ("eth" "\\dh{}" nil "ð" "dh" "ð" "ð") + ("THORN" "\\TH{}" nil "Þ" "TH" "Þ" "Þ") + ("thorn" "\\th{}" nil "þ" "th" "þ" "þ") + + "* Punctuation" + "** Dots and Marks" + ("dots" "\\dots{}" nil "…" "..." "..." "…") + ("hellip" "\\dots{}" nil "…" "..." "..." "…") + ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") + ("iexcl" "!`" nil "¡" "!" "¡" "¡") + ("iquest" "?`" nil "¿" "?" "¿" "¿") + + "** Dash-like" + ("shy" "\\-" nil "­" "" "" "") + ("ndash" "--" nil "–" "-" "-" "–") + ("mdash" "---" nil "—" "--" "--" "—") + + "** Quotations" + ("quot" "\\textquotedbl{}" nil """ "\"" "\"" "\"") + ("acute" "\\textasciiacute{}" nil "´" "'" "´" "´") + ("ldquo" "\\textquotedblleft{}" nil "“" "\"" "\"" "“") + ("rdquo" "\\textquotedblright{}" nil "”" "\"" "\"" "”") + ("bdquo" "\\quotedblbase{}" nil "„" "\"" "\"" "„") + ("lsquo" "\\textquoteleft{}" nil "‘" "`" "`" "‘") + ("rsquo" "\\textquoteright{}" nil "’" "'" "'" "’") + ("sbquo" "\\quotesinglbase{}" nil "‚" "," "," "‚") + ("laquo" "\\guillemotleft{}" nil "«" "<<" "«" "«") + ("raquo" "\\guillemotright{}" nil "»" ">>" "»" "»") + ("lsaquo" "\\guilsinglleft{}" nil "‹" "<" "<" "‹") + ("rsaquo" "\\guilsinglright{}" nil "›" ">" ">" "›") + + "* Other" + "** Misc. (often used)" + ("circ" "\\circ" t "ˆ" "^" "^" "ˆ") + ("vert" "\\vert{}" t "|" "|" "|" "|") + ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") + ("sect" "\\S" nil "§" "paragraph" "§" "§") + ("amp" "\\&" nil "&" "&" "&" "&") + ("lt" "\\textless{}" nil "<" "<" "<" "<") + ("gt" "\\textgreater{}" nil ">" ">" ">" ">") + ("tilde" "\\~{}" nil "˜" "~" "~" "~") + ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") + ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") + + "** Whitespace" + ("nbsp" "~" nil " " " " " " " ") + ("ensp" "\\hspace*{.5em}" nil " " " " " " " ") + ("emsp" "\\hspace*{1em}" nil " " " " " " " ") + ("thinsp" "\\hspace*{.2em}" nil " " " " " " " ") + + "** Currency" + ("curren" "\\textcurrency{}" nil "¤" "curr." "¤" "¤") + ("cent" "\\textcent{}" nil "¢" "cent" "¢" "¢") + ("pound" "\\pounds{}" nil "£" "pound" "£" "£") + ("yen" "\\textyen{}" nil "¥" "yen" "¥" "¥") + ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") + ("EUR" "\\EUR{}" nil "€" "EUR" "EUR" "€") + ("EURdig" "\\EURdig{}" nil "€" "EUR" "EUR" "€") + ("EURhv" "\\EURhv{}" nil "€" "EUR" "EUR" "€") + ("EURcr" "\\EURcr{}" nil "€" "EUR" "EUR" "€") + ("EURtm" "\\EURtm{}" nil "€" "EUR" "EUR" "€") + + "** Property Marks" + ("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©") + ("reg" "\\textregistered{}" nil "®" "(r)" "®" "®") + ("trade" "\\texttrademark{}" nil "™" "TM" "TM" "™") + + "** Science et al." + ("minus" "\\minus" t "−" "-" "-" "−") + ("pm" "\\textpm{}" nil "±" "+-" "±" "±") + ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") + ("times" "\\texttimes{}" nil "×" "*" "×" "×") + ("frasl" "/" nil "⁄" "/" "/" "⁄") + ("div" "\\textdiv{}" nil "÷" "/" "÷" "÷") + ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") + ("frac14" "\\textonequarter{}" nil "¼" "1/4" "¼" "¼") + ("frac34" "\\textthreequarters{}" nil "¾" "3/4" "¾" "¾") + ("permil" "\\textperthousand{}" nil "‰" "per thousand" "per thousand" "‰") + ("sup1" "\\textonesuperior{}" nil "¹" "^1" "¹" "¹") + ("sup2" "\\texttwosuperior{}" nil "²" "^2" "²" "²") + ("sup3" "\\textthreesuperior{}" nil "³" "^3" "³" "³") + ("radic" "\\sqrt{\\,}" t "√" "[square root]" "[square root]" "√") + ("sum" "\\sum" t "∑" "[sum]" "[sum]" "∑") + ("prod" "\\prod" t "∏" "[product]" "[n-ary product]" "∏") + ("micro" "\\textmu{}" nil "µ" "micro" "µ" "µ") + ("macr" "\\textasciimacron{}" nil "¯" "[macron]" "¯" "¯") + ("deg" "\\textdegree{}" nil "deg" "degree" "°" "°") + ("prime" "\\prime" t "′" "'" "'" "′") + ("Prime" "\\prime{}\\prime" t "″" "''" "''" "″") + ("infin" "\\propto" t "∞" "[infinity]" "[infinity]" "∞") + ("infty" "\\infty" t "∞" "[infinity]" "[infinity]" "∞") + ("prop" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") + ("proptp" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") + ("not" "\\textlnot{}" nil "¬" "[angled dash]" "¬" "¬") + ("land" "\\land" t "∧" "[logical and]" "[logical and]" "∧") + ("wedge" "\\wedge" t "∧" "[logical and]" "[logical and]" "∧") + ("lor" "\\lor" t "∨" "[logical or]" "[logical or]" "∨") + ("vee" "\\vee" t "∨" "[logical or]" "[logical or]" "∨") + ("cap" "\\cap" t "∩" "[intersection]" "[intersection]" "∩") + ("cup" "\\cup" t "∪" "[union]" "[union]" "∪") + ("int" "\\int" t "∫" "[integral]" "[integral]" "∫") + ("there4" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") + ("sim" "\\sim" t "∼" "~" "~" "∼") + ("cong" "\\cong" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") + ("simeq" "\\simeq" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") + ("asymp" "\\asymp" t "≈" "[almost equal to]" "[almost equal to]" "≈") + ("approx" "\\approx" t "≈" "[almost equal to]" "[almost equal to]" "≈") + ("ne" "\\ne" t "≠" "[not equal to]" "[not equal to]" "≠") + ("neq" "\\neq" t "≠" "[not equal to]" "[not equal to]" "≠") + ("equiv" "\\equiv" t "≡" "[identical to]" "[identical to]" "≡") + ("le" "\\le" t "≤" "<=" "<=" "≤") + ("ge" "\\ge" t "≥" ">=" ">=" "≥") + ("sub" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") + ("subset" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") + ("sup" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") + ("supset" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") + ("nsub" "\\not\\subset" t "⊄" "[not a subset of]" "[not a subset of" "⊄") + ("sube" "\\subseteq" t "⊆" "[subset of or equal to]" "[subset of or equal to]" "⊆") + ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") + ("supe" "\\supseteq" t "⊇" "[superset of or equal to]" "[superset of or equal to]" "⊇") + ("forall" "\\forall" t "∀" "[for all]" "[for all]" "∀") + ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") + ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") + ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "∅") + ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "∅") + ("isin" "\\in" t "∈" "[element of]" "[element of]" "∈") + ("in" "\\in" t "∈" "[element of]" "[element of]" "∈") + ("notin" "\\notin" t "∉" "[not an element of]" "[not an element of]" "∉") + ("ni" "\\ni" t "∋" "[contains as member]" "[contains as member]" "∋") + ("nabla" "\\nabla" t "∇" "[nabla]" "[nabla]" "∇") + ("ang" "\\angle" t "∠" "[angle]" "[angle]" "∠") + ("angle" "\\angle" t "∠" "[angle]" "[angle]" "∠") + ("perp" "\\perp" t "⊥" "[up tack]" "[up tack]" "⊥") + ("sdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") + ("cdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") + ("lceil" "\\lceil" t "⌈" "[left ceiling]" "[left ceiling]" "⌈") + ("rceil" "\\rceil" t "⌉" "[right ceiling]" "[right ceiling]" "⌉") + ("lfloor" "\\lfloor" t "⌊" "[left floor]" "[left floor]" "⌊") + ("rfloor" "\\rfloor" t "⌋" "[right floor]" "[right floor]" "⌋") + ("lang" "\\langle" t "⟨" "<" "<" "⟨") + ("rang" "\\rangle" t "⟩" ">" ">" "⟩") + + "** Arrows" + ("larr" "\\leftarrow" t "←" "<-" "<-" "←") + ("leftarrow" "\\leftarrow" t "←" "<-" "<-" "←") + ("gets" "\\gets" t "←" "<-" "<-" "←") + ("lArr" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") + ("Leftarrow" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") + ("uarr" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") + ("uparrow" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") + ("uArr" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") + ("Uparrow" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") + ("rarr" "\\rightarrow" t "→" "->" "->" "→") + ("to" "\\to" t "→" "->" "->" "→") + ("rightarrow" "\\rightarrow" t "→" "->" "->" "→") + ("rArr" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") + ("Rightarrow" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") + ("darr" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") + ("downarrow" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") + ("dArr" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") + ("Downarrow" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") + ("harr" "\\leftrightarrow" t "↔" "<->" "<->" "↔") + ("leftrightarrow" "\\leftrightarrow" t "↔" "<->" "<->" "↔") + ("hArr" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") + ("Leftrightarrow" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") + ("crarr" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") + ("hookleftarrow" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") + + "** Function names" + ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos") + ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin") + ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan") + ("arg" "\\arg" t "arg" "arg" "arg" "arg") + ("cos" "\\cos" t "cos" "cos" "cos" "cos") + ("cosh" "\\cosh" t "cosh" "cosh" "cosh" "cosh") + ("cot" "\\cot" t "cot" "cot" "cot" "cot") + ("coth" "\\coth" t "coth" "coth" "coth" "coth") + ("csc" "\\csc" t "csc" "csc" "csc" "csc") + ("deg" "\\deg" t "°" "deg" "deg" "deg") + ("det" "\\det" t "det" "det" "det" "det") + ("dim" "\\dim" t "dim" "dim" "dim" "dim") + ("exp" "\\exp" t "exp" "exp" "exp" "exp") + ("gcd" "\\gcd" t "gcd" "gcd" "gcd" "gcd") + ("hom" "\\hom" t "hom" "hom" "hom" "hom") + ("inf" "\\inf" t "inf" "inf" "inf" "inf") + ("ker" "\\ker" t "ker" "ker" "ker" "ker") + ("lg" "\\lg" t "lg" "lg" "lg" "lg") + ("lim" "\\lim" t "lim" "lim" "lim" "lim") + ("liminf" "\\liminf" t "liminf" "liminf" "liminf" "liminf") + ("limsup" "\\limsup" t "limsup" "limsup" "limsup" "limsup") + ("ln" "\\ln" t "ln" "ln" "ln" "ln") + ("log" "\\log" t "log" "log" "log" "log") + ("max" "\\max" t "max" "max" "max" "max") + ("min" "\\min" t "min" "min" "min" "min") + ("Pr" "\\Pr" t "Pr" "Pr" "Pr" "Pr") + ("sec" "\\sec" t "sec" "sec" "sec" "sec") + ("sin" "\\sin" t "sin" "sin" "sin" "sin") + ("sinh" "\\sinh" t "sinh" "sinh" "sinh" "sinh") + ("sup" "\\sup" t "⊃" "sup" "sup" "sup") + ("tan" "\\tan" t "tan" "tan" "tan" "tan") + ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh") + + "** Signs & Symbols" + ("bull" "\\textbullet{}" nil "•" "*" "*" "•") + ("bullet" "\\textbullet{}" nil "•" "*" "*" "•") + ("star" "\\star" t "*" "*" "*" "⋆") + ("lowast" "\\ast" t "∗" "*" "*" "∗") + ("ast" "\\ast" t "∗" "*" "*" "*") + ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ") + ("oplus" "\\oplus" t "⊕" "[circled plus]" "[circled plus]" "⊕") + ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") + ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + + "** Miscellaneous (seldom used)" + ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") + ("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ª" "ª") + ("ordm" "\\textordmasculine{}" nil "º" "_o_" "º" "º") + ("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸") + ("oline" "\\overline{~}" t "‾" "[overline]" "¯" "‾") + ("uml" "\\textasciidieresis{}" nil "¨" "[diaeresis]" "¨" "¨") + ("zwnj" "\\/{}" nil "‌" "" "" "") + ("zwj" "" nil "‍" "" "" "") + ("lrm" "" nil "‎" "" "" "") + ("rlm" "" nil "‏" "" "" "") + + "** Smilies" + ("smile" "\\smile" t "☺" ":-)" ":-)" "⌣") + ("smiley" "\\smiley{}" nil "☺" ":-)" ":-)" "☺") + ("blacksmile" "\\blacksmiley{}" nil "☻" ":-)" ":-)" "☻") + ("sad" "\\frownie{}" nil "☹" ":-(" ":-(" "☹") + + "** Suits" + ("clubs" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") + ("clubsuit" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") + ("spades" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") + ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") + ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") + ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") + ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") + ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") + ("Diamond" "\\diamond" t "⋄" "[diamond]" "[diamond]" "⋄") + ("loz" "\\diamond" t "◊" "[lozenge]" "[lozenge]" "◊") + ) + "Default entities used in Org-mode to produce special characters. +For details see `org-entities-user'.") + +(defsubst org-entity-get (name) + "Get the proper association for NAME from the entity lists. +This first checks the user list, then the built-in list." + (or (assoc name org-entities-user) + (assoc name org-entities))) + +(defun org-entity-get-representation (name kind) + "Get the correct representation of entity NAME for export type KIND. +Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." + (let* ((e (org-entity-get name)) + (n (cdr (assq kind '((latex . 1) (html . 3) (ascii . 4) + (latin1 . 5) (utf8 . 6))))) + (r (and e n (nth n e)))) + (if (and e r + (not org-entities-ascii-explanatory) + (memq kind '(ascii latin1 utf8)) + (= (string-to-char r) ?\[)) + (concat "\\" name) + r))) + +(defsubst org-entity-latex-math-p (name) + "Does entity NAME require math mode in LaTeX?" + (nth 2 (org-entity-get name))) + +;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org + +(defun org-entities-create-table () + "Create an org-mode table with all entities." + (interactive) + (let ((ll org-entities) + (pos (point)) + e latex mathp html latin utf8 name ascii) + (insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n") + (while ll + (when (listp e) + (setq e (pop ll)) + (setq name (car e) + latex (nth 1 e) + mathp (nth 2 e) + html (nth 3 e) + ascii (nth 4 e) + latin (nth 5 e) + utf8 (nth 6 e)) + (if (equal ascii "|") (setq ascii "\\vert")) + (if (equal latin "|") (setq latin "\\vert")) + (if (equal utf8 "|") (setq utf8 "\\vert")) + (if (equal ascii "=>") (setq ascii "= >")) + (if (equal latin "=>") (setq latin "= >")) + (insert "|" name + "|" (format "=%s=" latex) + "|" (format (if mathp "$%s$" "$\\mbox{%s}$") + latex) + "|" (format "=%s=" html) "|" html + "|" ascii "|" latin "|" utf8 + "|\n"))) + (goto-char pos) + (org-table-align))) + +(defun org-entities-help () + "Create a Help buffer with all available entities." + (interactive) + (with-output-to-temp-buffer "*Org Entity Help*" + (princ "Org-mode entities\n=================\n\n") + (let ((ll (append '("* User-defined additions (variable org-entities-user)") + org-entities-user + org-entities)) + e latex mathp html latin utf8 name ascii + (lastwasstring t) + (head (concat + "\n" + " Symbol Org entity LaTeX code HTML code\n" + " -----------------------------------------------------------\n"))) + (while ll + (setq e (pop ll)) + (if (stringp e) + (progn + (princ e) + (princ "\n") + (setq lastwasstring t)) + (if lastwasstring (princ head)) + (setq lastwasstring nil) + (setq name (car e) + latex (nth 1 e) + html (nth 3 e) + utf8 (nth 6 e)) + (princ (format " %-8s \\%-16s %-22s %-13s\n" + utf8 name latex html)))))) + (with-current-buffer "*Org Entity Help*" + (org-mode)) + (select-window (get-buffer-window "*Org Entity Help*"))) + + +(defun replace-amp () + "Postprocess HTML file to unescape the ampersand." + (interactive) + (while (re-search-forward "<td>&\\([^<;]+;\\)" nil t) + (replace-match (concat "<td>&" (match-string 1)) t t))) + +(provide 'org-entities) + +;; Local variables: +;; coding: utf-8 +;; End: + +;; arch-tag: e6bd163f-7419-4009-9c93-a74623016424 + +;;; org-entities.el ends here diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el index 30400754f27..3723c1d2d2c 100644 --- a/lisp/org/org-exp-blocks.el +++ b/lisp/org/org-exp-blocks.el @@ -4,6 +4,7 @@ ;; Free Software Foundation, Inc. ;; Author: Eric Schulte +;; Version: 7.4 ;; This file is part of GNU Emacs. ;; @@ -67,6 +68,8 @@ ;; `org-export-blocks-add-block' to add your block type to ;; `org-export-blocks'. +;;; Code: + (eval-when-compile (require 'cl)) (require 'org) @@ -92,10 +95,10 @@ '((comment org-export-blocks-format-comment t) (ditaa org-export-blocks-format-ditaa nil) (dot org-export-blocks-format-dot nil)) - "Use this a-list to associate block types with block exporting -functions. The type of a block is determined by the text -immediately following the '#+BEGIN_' portion of the block header. -Each block export function should accept three argumets..." + "Use this alist to associate block types with block exporting functions. +The type of a block is determined by the text immediately +following the '#+BEGIN_' portion of the block header. Each block +export function should accept three arguments." :group 'org-export-general :type '(repeat (list @@ -105,14 +108,14 @@ Each block export function should accept three argumets..." :set 'org-export-blocks-set) (defun org-export-blocks-add-block (block-spec) - "Add a new block type to `org-export-blocks'. BLOCK-SPEC -should be a three element list the first element of which should -indicate the name of the block, the second element should be the -formatting function called by `org-export-blocks-preprocess' and -the third element a flag indicating whether these types of blocks -should be fontified in org-mode buffers (see -`org-protecting-blocks'). For example the BLOCK-SPEC for ditaa -blocks is as follows... + "Add a new block type to `org-export-blocks'. +BLOCK-SPEC should be a three element list the first element of +which should indicate the name of the block, the second element +should be the formatting function called by +`org-export-blocks-preprocess' and the third element a flag +indicating whether these types of blocks should be fontified in +org-mode buffers (see `org-protecting-blocks'). For example the +BLOCK-SPEC for ditaa blocks is as follows. (ditaa org-export-blocks-format-ditaa nil)" (unless (member block-spec org-export-blocks) @@ -121,25 +124,28 @@ blocks is as follows... (defcustom org-export-interblocks '() - "Use this a-list to associate block types with block exporting -functions. The type of a block is determined by the text -immediately following the '#+BEGIN_' portion of the block header. -Each block export function should accept three argumets..." + "Use this a-list to associate block types with block exporting functions. +The type of a block is determined by the text immediately +following the '#+BEGIN_' portion of the block header. Each block +export function should accept three arguments." :group 'org-export-general :type 'alist) (defcustom org-export-blocks-witheld '(hidden) - "List of block types (see `org-export-blocks') which should not -be exported." + "List of block types (see `org-export-blocks') which should not be exported." :group 'org-export-general :type 'list) -(defvar org-export-blocks-postblock-hooks nil "") +(defcustom org-export-blocks-postblock-hook nil + "Run after blocks have been processed with `org-export-blocks-preprocess'." + :group 'org-export-general + :type 'hook) (defun org-export-blocks-html-quote (body &optional open close) - "Protext BODY from org html export. The optional OPEN and -CLOSE tags will be inserted around BODY." + "Protect BODY from org html export. +The optional OPEN and CLOSE tags will be inserted around BODY." + (concat "\n#+BEGIN_HTML\n" (or open "") @@ -148,8 +154,8 @@ CLOSE tags will be inserted around BODY." "#+END_HTML\n")) (defun org-export-blocks-latex-quote (body &optional open close) - "Protext BODY from org latex export. The optional OPEN and -CLOSE tags will be inserted around BODY." + "Protect BODY from org latex export. +The optional OPEN and CLOSE tags will be inserted around BODY." (concat "\n#+BEGIN_LaTeX\n" (or open "") @@ -158,22 +164,21 @@ CLOSE tags will be inserted around BODY." "#+END_LaTeX\n")) (defun org-export-blocks-preprocess () - "Export all blocks according to the `org-export-blocks' block -exportation alist. Does not export block types specified in -specified in BLOCKS which default to the value of -`org-export-blocks-witheld'." + "Export all blocks according to the `org-export-blocks' block export alist. +Does not export block types specified in specified in BLOCKS +which defaults to the value of `org-export-blocks-witheld'." (interactive) (save-window-excursion (let ((case-fold-search t) (types '()) - indentation type func start body headers preserve-indent) + indentation type func start body headers preserve-indent progress-marker) (flet ((interblock (start end) (mapcar (lambda (pair) (funcall (second pair) start end)) org-export-interblocks))) (goto-char (point-min)) (setq start (point)) (while (re-search-forward - "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n][ \t]*#\\+end_\\S-+.*" nil t) + "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n][ \t]*#\\+end_\\S-+.*[\r\n]?" nil t) (setq indentation (length (match-string 1))) (setq type (intern (downcase (match-string 2)))) (setq headers (save-match-data (org-split-string (match-string 3) "[ \t]+"))) @@ -183,17 +188,18 @@ specified in BLOCKS which default to the value of (setq body (save-match-data (org-remove-indentation body)))) (unless (memq type types) (setq types (cons type types))) (save-match-data (interblock start (match-beginning 0))) - (if (setq func (cadr (assoc type org-export-blocks))) - (progn - (replace-match (save-match-data + (when (setq func (cadr (assoc type org-export-blocks))) + (let ((replacement (save-match-data (if (memq type org-export-blocks-witheld) "" - (apply func body headers))) t t) + (apply func body headers))))) + (when replacement + (replace-match replacement t t) (unless preserve-indent - (indent-code-rigidly (match-beginning 0) (match-end 0) indentation)))) + (indent-code-rigidly + (match-beginning 0) (match-end 0) indentation))))) (setq start (match-end 0))) - (interblock start (point-max)))))) - -(add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess) + (interblock start (point-max)) + (run-hooks 'org-export-blocks-postblock-hook))))) ;;================================================================================ ;; type specific functions @@ -209,7 +215,7 @@ specified in BLOCKS which default to the value of (expand-file-name "../contrib" (file-name-directory (or load-file-name buffer-file-name))))))) - "Path to the ditaa jar executable") + "Path to the ditaa jar executable.") (defun org-export-blocks-format-ditaa (body &rest headers) "Pass block BODY to the ditaa utility creating an image. @@ -219,13 +225,15 @@ passed to the ditaa utility as command line arguments." (message "ditaa-formatting...") (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) (data-file (make-temp-file "org-ditaa")) - (hash (sha1 (prin1-to-string (list body args)))) - (raw-out-file (if headers (car headers))) - (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) - (cons (match-string 1 raw-out-file) - (match-string 2 raw-out-file)) - (cons raw-out-file "png"))) - (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) + (hash (progn + (set-text-properties 0 (length body) nil body) + (sha1 (prin1-to-string (list body args))))) + (raw-out-file (if headers (car headers))) + (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) + (cons (match-string 1 raw-out-file) + (match-string 2 raw-out-file)) + (cons raw-out-file "png"))) + (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) (unless (file-exists-p org-ditaa-jar-path) (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path))) (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body) @@ -279,13 +287,15 @@ digraph data_relationships { (message "dot-formatting...") (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) (data-file (make-temp-file "org-ditaa")) - (hash (sha1 (prin1-to-string (list body args)))) - (raw-out-file (if headers (car headers))) - (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) - (cons (match-string 1 raw-out-file) - (match-string 2 raw-out-file)) - (cons raw-out-file "png"))) - (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) + (hash (progn + (set-text-properties 0 (length body) nil body) + (sha1 (prin1-to-string (list body args))))) + (raw-out-file (if headers (car headers))) + (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) + (cons (match-string 1 raw-out-file) + (match-string 2 raw-out-file)) + (cons raw-out-file "png"))) + (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) (cond ((or htmlp latexp docbookp) (unless (file-exists-p out-file) diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el index 11452045384..a334c45a7f7 100644 --- a/lisp/org/org-exp.el +++ b/lisp/org/org-exp.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -26,11 +26,15 @@ ;; ;;; Commentary: +;;; Code: + (require 'org) (require 'org-macs) (require 'org-agenda) (require 'org-exp-blocks) +(require 'ob-exp) (require 'org-src) + (eval-when-compile (require 'cl)) @@ -42,6 +46,8 @@ (declare-function org-export-htmlize-region-for-paste "org-html" (beg end)) (declare-function htmlize-buffer "ext:htmlize" (&optional buffer)) (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-table-cookie-line-p "org-table" (line)) +(declare-function org-table-colgroup-line-p "org-table" (line)) (autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t) (defgroup org-export nil "Options for exporting org-listings." @@ -54,7 +60,7 @@ :group 'org-export) (defcustom org-export-allow-BIND 'confirm - "Non-nil means, allow #+BIND to define local variable values for export. + "Non-nil means allow #+BIND to define local variable values for export. This is a potential security risk, which is why the user must confirm the use of these lines." :group 'org-export-general @@ -67,7 +73,7 @@ use of these lines." (defvar org-export-publishing-directory nil) (defcustom org-export-show-temporary-export-buffer t - "Non-nil means, show buffer after exporting to temp buffer. + "Non-nil means show buffer after exporting to temp buffer. When Org exports to a file, the buffer visiting that file is ever shown, but remains buried. However, when exporting to a temporary buffer, that buffer is popped up in a second window. When this variable @@ -76,7 +82,14 @@ is nil, the buffer remains buried also in these cases." :type 'boolean) (defcustom org-export-copy-to-kill-ring t - "Non-nil means, exported stuff will also be pushed onto the kill ring." + "Non-nil means exported stuff will also be pushed onto the kill ring." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-kill-product-buffer-when-displayed nil + "Non-nil means kill the product buffer if it is displayed immediately. +This applied to the commands `org-export-html-and-open' and +`org-export-as-pdf-and-open'." :group 'org-export-general :type 'boolean) @@ -86,9 +99,10 @@ This works by starting up a separate Emacs process visiting the same file and doing the export from there. Not all export commands are affected by this - only the ones which actually write to a file, and that do not depend on the buffer state. - +\\<org-mode-map> If this option is nil, you can still get background export by calling -`org-export' with a double prefix arg: `C-u C-u C-c C-e'. +`org-export' with a double prefix arg: \ +\\[universal-argument] \\[universal-argument] \\[org-export]. If this option is t, the double prefix can be used to exceptionally force an export command into the current process." @@ -114,7 +128,7 @@ This is without condition, so even subtrees inside that carry one of the ;; FIXME: rename, this is a general variable (defcustom org-export-html-expand t - "Non-nil means, for HTML export, treat @<...> as HTML tag. + "Non-nil means for HTML export, treat @<...> as HTML tag. When nil, these tags will be exported as plain text and therefore not be interpreted by a browser. @@ -124,7 +138,7 @@ This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." :type 'boolean) (defcustom org-export-with-special-strings t - "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. + "Non-nil means interpret \"\-\", \"--\" and \"---\" for export. When this option is turned on, these strings will be exported as: Org HTML LaTeX @@ -167,7 +181,7 @@ This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." ("no" "Forfatter" "Dato" "Innhold" "Fotnoter") ("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l) ("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk) - ("pl" "Autor" "Data" "Spis treści" "Przypis") + ("pl" "Autor" "Data" "Spis treści" "Przypis") ("sv" "Författare" "Datum" "Innehåll" "Fotnoter")) "Terms used in export text, translated to different languages. Use the variable `org-export-default-language' to set the language, @@ -198,7 +212,7 @@ This is best set with the #+KEYWORDS line in a file, it does not make sense to set this globally.") (defcustom org-export-skip-text-before-1st-heading nil - "Non-nil means, skip all text before the first headline when exporting. + "Non-nil means skip all text before the first headline when exporting. When nil, that text is exported as well." :group 'org-export-general :type 'boolean) @@ -214,7 +228,7 @@ This option can also be set with the +OPTIONS line, e.g. \"H:2\"." :type 'integer) (defcustom org-export-with-section-numbers t - "Non-nil means, add section numbers to headlines when exporting. + "Non-nil means add section numbers to headlines when exporting. This option can also be set with the +OPTIONS line, e.g. \"num:t\"." :group 'org-export-general @@ -224,7 +238,7 @@ This option can also be set with the +OPTIONS line, e.g. \"num:t\"." "Format of section numbers for export. The variable has two components. 1. A list of lists, each indicating a counter type and a separator. - The counter type can be any of \"1\", \"A\", \"a\", \"I\", or \"a\". + The counter type can be any of \"1\", \"A\", \"a\", \"I\", or \"i\". It causes causes numeric, alphabetic, or roman counters, respectively. The separator is only used if another counter for a subsection is being added. @@ -241,7 +255,7 @@ The variable has two components. (string :tag "Terminator"))) (defcustom org-export-with-toc t - "Non-nil means, create a table of contents in exported files. + "Non-nil means create a table of contents in exported files. The TOC contains headlines with levels up to`org-export-headline-levels'. When an integer, include levels up to N in the toc, this may then be different from `org-export-headline-levels', but it will not be allowed @@ -263,24 +277,24 @@ or \"toc:3\"." (integer :tag "TOC to level"))) (defcustom org-export-mark-todo-in-toc nil - "Non-nil means, mark TOC lines that contain any open TODO items." + "Non-nil means mark TOC lines that contain any open TODO items." :group 'org-export-general :type 'boolean) (defcustom org-export-with-todo-keywords t - "Non-nil means, include TODO keywords in export. + "Non-nil means include TODO keywords in export. When nil, remove all these keywords from the export." :group 'org-export-general :type 'boolean) (defcustom org-export-with-priority nil - "Non-nil means, include priority cookies in export. + "Non-nil means include priority cookies in export. When nil, remove priority cookies for export." :group 'org-export-general :type 'boolean) (defcustom org-export-preserve-breaks nil - "Non-nil means, preserve all line breaks when exporting. + "Non-nil means preserve all line breaks when exporting. Normally, in HTML output paragraphs will be reformatted. In ASCII export, line breaks will always be preserved, regardless of this variable. @@ -302,21 +316,29 @@ headline Only export the headline, but skip the tree below it." (const :tag "entirely" t))) (defcustom org-export-author-info t - "Non-nil means, insert author name and email into the exported file. + "Non-nil means insert author name and email into the exported file. This option can also be set with the +OPTIONS line, -e.g. \"author-info:nil\"." +e.g. \"author:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-email-info nil + "Non-nil means insert author name and email into the exported file. + +This option can also be set with the +OPTIONS line, +e.g. \"email:t\"." :group 'org-export-general :type 'boolean) (defcustom org-export-creator-info t - "Non-nil means, the postamble should contain a creator sentence. + "Non-nil means the postamble should contain a creator sentence. This sentence is \"HTML generated by org-mode XX in emacs XXX\"." :group 'org-export-general :type 'boolean) (defcustom org-export-time-stamp-file t - "Non-nil means, insert a time stamp into the exported file. + "Non-nil means insert a time stamp into the exported file. The time stamp shows when the file was created. This option can also be set with the +OPTIONS line, @@ -347,7 +369,7 @@ This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"." (const :tag "On" t))) (defcustom org-export-with-drawers nil - "Non-nil means, export with drawers like the property drawer. + "Non-nil means export with drawers like the property drawer. When t, all drawers are exported. This may also be a list of drawer names to export." :group 'org-export-general @@ -357,9 +379,19 @@ drawer names to export." (repeat :tag "Selected drawers" (string :tag "Drawer name")))) +(defvar org-export-first-hook nil + "Hook called as the first thing in each exporter. +Point will be still in the original buffer. +Good for general initialization") + (defvar org-export-preprocess-hook nil "Hook for preprocessing an export buffer. -Pretty much the first thing when exporting is running this hook.") +Pretty much the first thing when exporting is running this hook. +Point will be in a temporary buffer that contains a copy of +the original buffer, or of the section that is being export. +All the other hooks in the org-export-preprocess... category +also work in that temporary buffer, already modified by various +stages of the processing.") (defvar org-export-preprocess-after-include-files-hook nil "Hook for preprocessing an export buffer. @@ -371,11 +403,28 @@ This is run after selection of trees to be exported has happened. This selection includes tags-based selection, as well as removal of commented and archived trees.") +(defvar org-export-preprocess-after-headline-targets-hook nil + "Hook for preprocessing export buffer. +This is run just after the headline targets have been defined and +the target-alist has been set up.") + +(defvar org-export-preprocess-before-selecting-backend-code-hook nil + "Hook for preprocessing an export buffer. +This is run just before backend-specific blocks get selected.") + (defvar org-export-preprocess-after-blockquote-hook nil "Hook for preprocessing an export buffer. This is run after blockquote/quote/verse/center have been marked with cookies.") +(defvar org-export-preprocess-after-radio-targets-hook nil + "Hook for preprocessing an export buffer. +This is run after radio target processing.") + +(defvar org-export-preprocess-before-normalizing-links-hook nil + "Hook for preprocessing an export buffer. +This hook is run before links are normalized.") + (defvar org-export-preprocess-before-backend-specifics-hook nil "Hook run before backend-specific functions are called during preprocessing.") @@ -390,7 +439,7 @@ returning the buffer string to the backend.") :group 'org-export) (defcustom org-export-with-emphasize t - "Non-nil means, interpret *word*, /word/, and _word_ as emphasized text. + "Non-nil means interpret *word*, /word/, and _word_ as emphasized text. If the export target supports emphasizing text, the word will be typeset in bold, italic, or underlined, respectively. Works only for single words, but you can say: I *really* *mean* *this*. @@ -408,41 +457,13 @@ This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." :group 'org-export-translation :type 'boolean) -(defcustom org-export-with-sub-superscripts t - "Non-nil means, interpret \"_\" and \"^\" for export. -When this option is turned on, you can use TeX-like syntax for sub- and -superscripts. Several characters after \"_\" or \"^\" will be -considered as a single item - so grouping with {} is normally not -needed. For example, the following things will be parsed as single -sub- or superscripts. - - 10^24 or 10^tau several digits will be considered 1 item. - 10^-12 or 10^-tau a leading sign with digits or a word - x^2-y^3 will be read as x^2 - y^3, because items are - terminated by almost any nonword/nondigit char. - x_{i^2} or x^(2-i) braces or parenthesis do grouping. - -Still, ambiguity is possible - so when in doubt use {} to enclose the -sub/superscript. If you set this variable to the symbol `{}', -the braces are *required* in order to trigger interpretations as -sub/superscript. This can be helpful in documents that need \"_\" -frequently in plain text. - -Not all export backends support this, but HTML does. - -This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." - :group 'org-export-translation - :type '(choice - (const :tag "Always interpret" t) - (const :tag "Only with braces" {}) - (const :tag "Never interpret" nil))) - (defcustom org-export-with-TeX-macros t - "Non-nil means, interpret simple TeX-like macros when exporting. + "Non-nil means interpret simple TeX-like macros when exporting. For example, HTML export converts \\alpha to α and \\AA to Å. Not only real TeX macros will work here, but the standard HTML entities for math can be used as macro names as well. For a list of supported -names in HTML export, see the constant `org-html-entities'. +names in HTML export, see the constant `org-entities' and the user option +`org-entities-user'. Not all export backends support this. This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." @@ -450,23 +471,37 @@ This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." :group 'org-export-latex :type 'boolean) -(defcustom org-export-with-LaTeX-fragments nil - "Non-nil means, convert LaTeX fragments to images when exporting to HTML. -When set, the exporter will find LaTeX environments if the \\begin line is -the first non-white thing on a line. It will also find the math delimiters -like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for -display math. +(defcustom org-export-with-LaTeX-fragments t + "Non-nil means process LaTeX math fragments for HTML display. +When set, the exporter will find and process LaTeX environments if the +\\begin line is the first non-white thing on a line. It will also find +and process the math delimiters like $a=b$ and \\( a=b \\) for inline math, +$$a=b$$ and \\[ a=b \\] for display math. + +This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\". + +Allowed values are: -This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\". +nil Don't do anything. +verbatim Keep eveything in verbatim +dvipng Process the LaTeX fragments to images. + This will also include processing of non-math environments. +t Do MathJax preprocessing if there is at least on math snippet, + and arrange for MathJax.js to be loaded. The default is nil, because this option needs the `dvipng' program which is not available on all systems." :group 'org-export-translation :group 'org-export-latex - :type 'boolean) + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Obsolete, use dvipng setting" t) + (const :tag "Use dvipng to make images" dvipng) + (const :tag "Use MathJax to display math" mathjax) + (const :tag "Leave math verbatim" verbatim))) (defcustom org-export-with-fixed-width t - "Non-nil means, lines starting with \":\" will be in fixed width font. + "Non-nil means lines starting with \":\" will be in fixed width font. This can be used to have pre-formatted text, fragments of code etc. For example: : ;; Some Lisp examples @@ -479,12 +514,6 @@ This option can also be set with the +OPTIONS line, e.g. \"::nil\"." :group 'org-export-translation :type 'boolean) -(defcustom org-match-sexp-depth 3 - "Number of stacked braces for sub/superscript matching. -This has to be set before loading org.el to be effective." - :group 'org-export-translation - :type 'integer) - (defgroup org-export-tables nil "Options for exporting tables in Org-mode." :tag "Org Export Tables" @@ -505,7 +534,7 @@ This option can also be set with the +OPTIONS line, e.g. \"|:nil\"." :type 'boolean) (defcustom org-export-highlight-first-table-line t - "Non-nil means, highlight the first table line. + "Non-nil means highlight the first table line. In HTML export, this means use <th> instead of <td>. In tables created with table.el, this applies to the first table line. In Org-mode tables, all lines before the first horizontal separator @@ -523,13 +552,14 @@ the values of constants may be useful to have." :type 'boolean) (defcustom org-export-prefer-native-exporter-for-tables nil - "Non-nil means, always export tables created with table.el natively. -Natively means, use the HTML code generator in table.el. + "Non-nil means always export tables created with table.el natively. +Natively means use the HTML code generator in table.el. When nil, Org-mode's own HTML generator is used when possible (i.e. if the table does not use row- or column-spanning). This has the advantage, that the automatic HTML conversions for math symbols and sub/superscripts can be applied. Org-mode's HTML generator is also -much faster." +much faster. The LaTeX exporter always use the native exporter for +table.el tables." :group 'org-export-tables :type 'boolean) @@ -581,6 +611,7 @@ much faster." (:fixed-width ":" org-export-with-fixed-width) (:timestamps "<" org-export-with-timestamps) (:author-info "author" org-export-author-info) + (:email-info "email" org-export-email-info) (:creator-info "creator" org-export-creator-info) (:time-stamp-file "timestamp" org-export-time-stamp-file) (:tables "|" org-export-with-tables) @@ -658,12 +689,14 @@ modified) list.") (let ((re (org-make-options-regexp (append '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE" + "MATHJAX" "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE" "LATEX_HEADER" "LATEX_CLASS" "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS" - "KEYWORDS" "DESCRIPTION" "MACRO" "BIND") + "KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT") (mapcar 'car org-export-inbuffer-options-extra)))) - p key val text options a pr style + (case-fold-search t) + p key val text options mathjax a pr style latex-header latex-class macros letbind ext-setup-or-nil setup-contents (start 0)) (while (or (and ext-setup-or-nil @@ -695,8 +728,12 @@ modified) list.") (setq text (if text (concat text "\n" val) val))) ((string-equal key "OPTIONS") (setq options (concat val " " options))) + ((string-equal key "MATHJAX") + (setq mathjax (concat val " " mathjax))) ((string-equal key "BIND") (push (read (concat "(" val ")")) letbind)) + ((string-equal key "XSLT") + (setq p (plist-put p :xslt val))) ((string-equal key "LINK_UP") (setq p (plist-put p :link-up val))) ((string-equal key "LINK_HOME") @@ -729,9 +766,12 @@ modified) list.") (setq p (plist-put p :latex-class latex-class))) (when options (setq p (org-export-add-options-to-plist p options))) + (when mathjax + (setq p (plist-put p :mathjax mathjax))) ;; Add macro definitions (setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))")) (setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))")) + (setq p (plist-put p :macro-property "(eval (org-entry-get nil \"$1\" 'selective))")) (setq p (plist-put p :macro-modification-time (and (buffer-file-name) @@ -772,9 +812,10 @@ security risks." (defun org-install-letbind () "Install the values from #+BIND lines as local variables." - (let ((letbind (plist-get org-export-opt-plist :let-bind))) - (while letbind - (org-set-local (caar letbind) (nth 1 (pop letbind)))))) + (let ((letbind (plist-get org-export-opt-plist :let-bind)) + pair) + (while (setq pair (pop letbind)) + (org-set-local (car pair) (nth 1 pair))))) (defun org-export-add-options-to-plist (p options) "Parse an OPTIONS line and set values in the property list P." @@ -831,33 +872,35 @@ in the background. This will be done only for commands that write to a file. For details see the docstring of `org-export-run-in-background'. The prefix argument ARG will be passed to the exporter. However, if -ARG is a double universal prefix `C-u C-u', that means to inverse the +ARG is a double universal prefix \\[universal-argument] \\[universal-argument], \ +that means to inverse the value of `org-export-run-in-background'." (interactive "P") (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background)) + subtree-p (help "[t] insert the export option template \[v] limit export to visible part of outline tree +\[1] only export the current subtree +\[SPC] publish enclosing subtree (with LaTeX_CLASS or EXPORT_FILE_NAME prop) -\[a] export as ASCII [A] to temporary buffer +\[a/n/u] export as ASCII/Latin-1/UTF-8 [A/N/U] to temporary buffer -\[h] export as HTML [H] to temporary buffer [R] export region +\[h] export as HTML [H] to temporary buffer [R] export region \[b] export as HTML and open in browser -\[l] export as LaTeX [L] to temporary buffer -\[p] export as LaTeX and process to PDF -\[d] export as LaTeX, process to PDF, and open the resulting PDF document +\[l] export as LaTeX [L] to temporary buffer +\[p] export as LaTeX and process to PDF [d] ... and open PDF file -\[D] export as DocBook -\[V] export as DocBook, process to PDF, and open the resulting PDF document +\[D] export as DocBook [V] export as DocBook, process to PDF, and open -\[m] export as Freemind mind map +\[j] export as TaskJuggler [J] ... and open +\[m] export as Freemind mind map \[x] export as XOXO \[g] export using Wes Hardaker's generic exporter \[i] export current file as iCalendar file -\[I] export all agenda files as iCalendar files -\[c] export agenda files into combined iCalendar file +\[I] export all agenda files as iCalendar files [c] ...as one combined file \[F] publish current file [P] publish current project \[X] publish a project... [E] publish every projects") @@ -866,6 +909,10 @@ value of `org-export-run-in-background'." (?v org-export-visible nil) (?a org-export-as-ascii t) (?A org-export-as-ascii-to-buffer t) + (?n org-export-as-latin1 t) + (?N org-export-as-latin1-to-buffer t) + (?u org-export-as-utf8 t) + (?U org-export-as-utf8-to-buffer t) (?h org-export-as-html t) (?b org-export-as-html-and-open t) (?H org-export-as-html-to-buffer nil) @@ -874,6 +921,8 @@ value of `org-export-run-in-background'." (?g org-export-generic t) (?D org-export-as-docbook t) (?V org-export-as-docbook-pdf-and-open t) + (?j org-export-as-taskjuggler t) + (?J org-export-as-taskjuggler-and-open t) (?m org-export-as-freemind t) (?l org-export-as-latex t) (?p org-export-as-pdf t) @@ -886,7 +935,8 @@ value of `org-export-run-in-background'." (?P org-publish-current-project t) (?X org-publish t) (?E org-publish-all t))) - r1 r2 ass) + r1 r2 ass + (cpos (point)) (cbuf (current-buffer)) bpos) (save-excursion (save-window-excursion (delete-other-windows) @@ -895,7 +945,25 @@ value of `org-export-run-in-background'." (org-fit-window-to-buffer (get-buffer-window "*Org Export/Publishing Help*")) (message "Select command: ") - (setq r1 (read-char-exclusive)))) + (setq r1 (read-char-exclusive)) + (when (eq r1 ?1) + (setq subtree-p t) + (message "Select command (for subtree): ") + (setq r1 (read-char-exclusive))) + (when (eq r1 ?\ ) + (let ((case-fold-search t)) + (if (re-search-backward + "^[ \t]+\\(:latex_class:\\|:export_title:\\)[ \t]+\\S-" + nil t) + (progn + (org-back-to-heading t) + (setq subtree-p t) + (setq bpos (point)) + (message "Select command (for subtree): ") + (setq r1 (read-char-exclusive))) + (error "No enclosing node with LaTeX_CLASS or EXPORT_FILE_NAME") + ))))) + (and bpos (goto-char bpos)) (setq r2 (if (< r1 27) (+ r1 96) r1)) (unless (setq ass (assq r2 cmds)) (error "No command associated with key %c" r1)) @@ -916,322 +984,30 @@ value of `org-export-run-in-background'." (set-process-sentinel p 'org-export-process-sentinel) (message "Background process \"%s\": started" p)) ;; background processing not requested, or not possible - (call-interactively (nth 1 ass))))) + (if subtree-p (progn (org-mark-subtree) (activate-mark))) + (call-interactively (nth 1 ass)) + (when (and bpos (get-buffer-window cbuf)) + (let ((cw (selected-window))) + (select-window (get-buffer-window cbuf)) + (goto-char cpos) + (deactivate-mark) + (select-window cw)))))) (defun org-export-process-sentinel (process status) (if (string-match "\n+\\'" status) (setq status (substring status 0 -1))) (message "Background process \"%s\": %s" process status)) -(defconst org-html-entities - '(("nbsp") - ("iexcl") - ("cent") - ("pound") - ("curren") - ("yen") - ("brvbar") - ("vert" . "|") - ("sect") - ("uml") - ("copy") - ("ordf") - ("laquo") - ("not") - ("shy") - ("reg") - ("macr") - ("deg") - ("pm" . "±") - ("plusmn") - ("sup2") - ("sup3") - ("acute") - ("micro") - ("para") - ("middot") - ("odot"."o") - ("star"."*") - ("cedil") - ("sup1") - ("ordm") - ("raquo") - ("frac14") - ("frac12") - ("frac34") - ("iquest") - ("Agrave") - ("Aacute") - ("Acirc") - ("Atilde") - ("Auml") - ("Aring") ("AA"."Å") - ("AElig") - ("Ccedil") - ("Egrave") - ("Eacute") - ("Ecirc") - ("Euml") - ("Igrave") - ("Iacute") - ("Icirc") - ("Iuml") - ("ETH") - ("Ntilde") - ("Ograve") - ("Oacute") - ("Ocirc") - ("Otilde") - ("Ouml") - ("times") - ("Oslash") - ("Ugrave") - ("Uacute") - ("Ucirc") - ("Uuml") - ("Yacute") - ("THORN") - ("szlig") - ("agrave") - ("aacute") - ("acirc") - ("atilde") - ("auml") - ("aring") - ("aelig") - ("ccedil") - ("egrave") - ("eacute") - ("ecirc") - ("euml") - ("igrave") - ("iacute") - ("icirc") - ("iuml") - ("eth") - ("ntilde") - ("ograve") - ("oacute") - ("ocirc") - ("otilde") - ("ouml") - ("divide") - ("oslash") - ("ugrave") - ("uacute") - ("ucirc") - ("uuml") - ("yacute") - ("thorn") - ("yuml") - ("fnof") - ("Alpha") - ("Beta") - ("Gamma") - ("Delta") - ("Epsilon") - ("Zeta") - ("Eta") - ("Theta") - ("Iota") - ("Kappa") - ("Lambda") - ("Mu") - ("Nu") - ("Xi") - ("Omicron") - ("Pi") - ("Rho") - ("Sigma") - ("Tau") - ("Upsilon") - ("Phi") - ("Chi") - ("Psi") - ("Omega") - ("alpha") - ("beta") - ("gamma") - ("delta") - ("epsilon") - ("varepsilon"."ε") - ("zeta") - ("eta") - ("theta") - ("iota") - ("kappa") - ("lambda") - ("mu") - ("nu") - ("xi") - ("omicron") - ("pi") - ("rho") - ("sigmaf") ("varsigma"."ς") - ("sigma") - ("tau") - ("upsilon") - ("phi") - ("chi") - ("psi") - ("omega") - ("thetasym") ("vartheta"."ϑ") - ("upsih") - ("piv") - ("bull") ("bullet"."•") - ("hellip") ("dots"."…") - ("prime") - ("Prime") - ("oline") - ("frasl") - ("weierp") - ("image") - ("real") - ("trade") - ("alefsym") - ("larr") ("leftarrow"."←") ("gets"."←") - ("uarr") ("uparrow"."↑") - ("rarr") ("to"."→") ("rightarrow"."→") - ("darr")("downarrow"."↓") - ("harr") ("leftrightarrow"."↔") - ("crarr") ("hookleftarrow"."↵") ; has round hook, not quite CR - ("lArr") ("Leftarrow"."⇐") - ("uArr") ("Uparrow"."⇑") - ("rArr") ("Rightarrow"."⇒") - ("dArr") ("Downarrow"."⇓") - ("hArr") ("Leftrightarrow"."⇔") - ("forall") - ("part") ("partial"."∂") - ("exist") ("exists"."∃") - ("empty") ("emptyset"."∅") - ("nabla") - ("isin") ("in"."∈") - ("notin") - ("ni") - ("prod") - ("sum") - ("minus") - ("lowast") ("ast"."∗") - ("radic") - ("prop") ("proptp"."∝") - ("infin") ("infty"."∞") - ("ang") ("angle"."∠") - ("and") ("wedge"."∧") - ("or") ("vee"."∨") - ("cap") - ("cup") - ("int") - ("there4") - ("sim") - ("cong") ("simeq"."≅") - ("asymp")("approx"."≈") - ("ne") ("neq"."≠") - ("equiv") - ("le") - ("ge") - ("sub") ("subset"."⊂") - ("sup") ("supset"."⊃") - ("nsub") - ("sube") - ("supe") - ("oplus") - ("otimes") - ("perp") - ("sdot") ("cdot"."⋅") - ("lceil") - ("rceil") - ("lfloor") - ("rfloor") - ("lang") - ("rang") - ("loz") ("Diamond"."◊") - ("spades") ("spadesuit"."♠") - ("clubs") ("clubsuit"."♣") - ("hearts") ("diamondsuit"."♥") - ("diams") ("diamondsuit"."♦") - ("smile"."☺") ("blacksmile"."☻") ("sad"."☹") - ("quot") - ("amp") - ("lt") - ("gt") - ("OElig") - ("oelig") - ("Scaron") - ("scaron") - ("Yuml") - ("circ") - ("tilde") - ("ensp") - ("emsp") - ("thinsp") - ("zwnj") - ("zwj") - ("lrm") - ("rlm") - ("ndash") - ("mdash") - ("lsquo") - ("rsquo") - ("sbquo") - ("ldquo") - ("rdquo") - ("bdquo") - ("dagger") - ("Dagger") - ("permil") - ("lsaquo") - ("rsaquo") - ("euro") - - ("arccos"."arccos") - ("arcsin"."arcsin") - ("arctan"."arctan") - ("arg"."arg") - ("cos"."cos") - ("cosh"."cosh") - ("cot"."cot") - ("coth"."coth") - ("csc"."csc") - ("deg"."deg") - ("det"."det") - ("dim"."dim") - ("exp"."exp") - ("gcd"."gcd") - ("hom"."hom") - ("inf"."inf") - ("ker"."ker") - ("lg"."lg") - ("lim"."lim") - ("liminf"."liminf") - ("limsup"."limsup") - ("ln"."ln") - ("log"."log") - ("max"."max") - ("min"."min") - ("Pr"."Pr") - ("sec"."sec") - ("sin"."sin") - ("sinh"."sinh") - ("sup"."sup") - ("tan"."tan") - ("tanh"."tanh") - ) - "Entities for TeX->HTML translation. -Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to -\"&ent;\". An entry can also be a dotted pair like (\"ent\".\"&other;\"). -In that case, \"\\ent\" will be translated to \"&other;\". -The list contains HTML entities for Latin-1, Greek and other symbols. -It is supplemented by a number of commonly used TeX macros with appropriate -translations. There is currently no way for users to extend this.") - ;;; General functions for all backends (defvar org-export-target-aliases nil "Alist of targets with invisible aliases.") (defvar org-export-preferred-target-alist nil "Alist of section id's with preferred aliases.") +(defvar org-export-id-target-alist nil + "Alist of section id's with preferred aliases.") (defvar org-export-code-refs nil - "Alist of code references and line numbers") + "Alist of code references and line numbers.") (defun org-export-preprocess-string (string &rest parameters) "Cleanup STRING so that that the true exported has a more consistent source. @@ -1254,15 +1030,20 @@ on this string to produce the exported version." (outline-regexp "\\*+ ") target-alist rtn) - (setq org-export-target-aliases nil) - (setq org-export-preferred-target-alist nil) - (setq org-export-code-refs nil) + (setq org-export-target-aliases nil + org-export-preferred-target-alist nil + org-export-id-target-alist nil + org-export-code-refs nil) (with-current-buffer (get-buffer-create " org-mode-tmp") (erase-buffer) (insert string) (setq case-fold-search t) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) + '(read-only t))) + ;; Remove license-to-kill stuff ;; The caller marks some stuff for killing, stuff that has been ;; used to create the page title, for example. @@ -1282,7 +1063,7 @@ on this string to produce the exported version." (untabify (point-min) (point-max)) ;; Handle include files, and call a hook - (org-export-handle-include-files) + (org-export-handle-include-files-recurse) (run-hooks 'org-export-preprocess-after-include-files-hook) ;; Get rid of archived trees @@ -1296,12 +1077,21 @@ on this string to produce the exported version." (plist-get parameters :exclude-tags)) (run-hooks 'org-export-preprocess-after-tree-selection-hook) + ;; Mark end of lists + (org-export-mark-list-ending backend) + + ;; Export code blocks + (org-export-blocks-preprocess) + ;; Handle source code snippets (org-export-replace-src-segments-and-examples backend) ;; Protect short examples marked by a leading colon (org-export-protect-colon-examples) + ;; Protected spaces + (org-export-convert-protected-spaces backend) + ;; Normalize footnotes (when (plist-get parameters :footnotes) (org-footnote-normalize nil t)) @@ -1309,6 +1099,11 @@ on this string to produce the exported version." ;; Find all headings and compute the targets for them (setq target-alist (org-export-define-heading-targets target-alist)) + (run-hooks 'org-export-preprocess-after-headline-targets-hook) + + ;; Find HTML special classes for headlines + (org-export-remember-html-container-classes) + ;; Get rid of drawers (org-export-remove-or-extract-drawers drawers (plist-get parameters :drawers) backend) @@ -1333,6 +1128,7 @@ on this string to produce the exported version." ;; Select and protect backend specific stuff, throw away stuff ;; that is specific for other backends + (run-hooks 'org-export-preprocess-before-selecting-backend-code-hook) (org-export-select-backend-specific-text backend) ;; Protect quoted subtrees @@ -1358,12 +1154,14 @@ on this string to produce the exported version." ;; Find matches for radio targets and turn them into internal links (org-export-mark-radio-links) + (run-hooks 'org-export-preprocess-after-radio-targets-hook) ;; Find all links that contain a newline and put them into a single line (org-export-concatenate-multiline-links) ;; Normalize links: Convert angle and plain links into bracket links ;; and expand link abbreviations + (run-hooks 'org-export-preprocess-before-normalizing-links-hook) (org-export-normalize-links) ;; Find all internal links. If they have a fuzzy match (i.e. not @@ -1375,7 +1173,8 @@ on this string to produce the exported version." (when (plist-get parameters :emph-multiline) (org-export-concatenate-multiline-emphasis)) - ;; Remove special table lines + ;; Remove special table lines, and store alignment information + (org-store-forced-table-alignment) (when org-export-table-remove-special-lines (org-export-remove-special-table-lines)) @@ -1403,6 +1202,9 @@ on this string to produce the exported version." ;; Remove or replace comments (org-export-handle-comments (plist-get parameters :comments)) + ;; Remove #+TBLFM and #+TBLNAME lines + (org-export-handle-table-metalines) + ;; Run the final hook (run-hooks 'org-export-preprocess-final-hook) @@ -1419,40 +1221,55 @@ on this string to produce the exported version." p (or (next-single-property-change p :org-license-to-kill) (point-max)))))) +(defvar org-export-define-heading-targets-headline-hook nil + "Hook that is run when a headline was matched during target search. +This is part of the preprocessing for export.") + (defun org-export-define-heading-targets (target-alist) "Find all headings and define the targets for them. -The new targets are added to TARGET-ALIST, which is also returned." +The new targets are added to TARGET-ALIST, which is also returned. +Also find all ID and CUSTOM_ID properties and store them." (goto-char (point-min)) (org-init-section-numbers) (let ((re (concat "^" org-outline-regexp - "\\| [ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)")) + "\\|" + "^[ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)")) level target last-section-target a id) (while (re-search-forward re nil t) - (if (match-end 2) - (progn - (setq id (org-match-string-no-properties 2)) - (push (cons id target) target-alist) - (setq a (or (assoc last-section-target org-export-target-aliases) - (progn - (push (list last-section-target) - org-export-target-aliases) - (car org-export-target-aliases)))) - (push (caar target-alist) (cdr a)) - (when (equal (match-string 1) "CUSTOM_ID") - (if (not (assoc last-section-target - org-export-preferred-target-alist)) - (push (cons last-section-target id) - org-export-preferred-target-alist)))) - (setq level (org-reduced-level - (save-excursion (goto-char (point-at-bol)) - (org-outline-level)))) - (setq target (org-solidify-link-text - (format "sec-%s" (org-section-number level)))) - (setq last-section-target target) - (push (cons target target) target-alist) - (add-text-properties - (point-at-bol) (point-at-eol) - (list 'target target))))) + (org-if-unprotected-at (match-beginning 0) + (if (match-end 2) + (progn + (setq id (org-match-string-no-properties 2)) + (push (cons id target) target-alist) + (setq a (or (assoc last-section-target org-export-target-aliases) + (progn + (push (list last-section-target) + org-export-target-aliases) + (car org-export-target-aliases)))) + (push (caar target-alist) (cdr a)) + (when (equal (match-string 1) "CUSTOM_ID") + (if (not (assoc last-section-target + org-export-preferred-target-alist)) + (push (cons last-section-target id) + org-export-preferred-target-alist))) + (when (equal (match-string 1) "ID") + (if (not (assoc last-section-target + org-export-id-target-alist)) + (push (cons last-section-target (concat "ID-" id)) + org-export-id-target-alist)))) + (setq level (org-reduced-level + (save-excursion (goto-char (point-at-bol)) + (org-outline-level)))) + (setq target (org-solidify-link-text + (format "sec-%s" (replace-regexp-in-string + "\\." "_" + (org-section-number level))))) + (setq last-section-target target) + (push (cons target target) target-alist) + (add-text-properties + (point-at-bol) (point-at-eol) + (list 'target target)) + (run-hooks 'org-export-define-heading-targets-headline-hook))))) target-alist) (defun org-export-handle-invisible-targets (target-alist) @@ -1488,7 +1305,7 @@ This function also handles the id links, if they have a match in the current file." (goto-char (point-min)) (while (re-search-forward org-bracket-link-regexp nil t) - (org-if-unprotected + (org-if-unprotected-at (1+ (match-beginning 0)) (let* ((md (match-data)) (desc (match-end 2)) (link (org-link-unescape (match-string 1))) @@ -1513,18 +1330,19 @@ the current file." (string-match "^\\." link)) nil) (t - (save-excursion - (setq found (condition-case nil (org-link-search link) - (error nil))) - (when (and found - (or (org-on-heading-p) - (not (eq found 'dedicated)))) - (or (get-text-property (point) 'target) - (get-text-property - (max (point-min) - (1- (or (previous-single-property-change - (point) 'target) 0))) - 'target)))))))) + (let ((org-link-search-inhibit-query t)) + (save-excursion + (setq found (condition-case nil (org-link-search link) + (error nil))) + (when (and found + (or (org-on-heading-p) + (not (eq found 'dedicated)))) + (or (get-text-property (point) 'target) + (get-text-property + (max (point-min) + (1- (or (previous-single-property-change + (point) 'target) 0))) + 'target))))))))) (when target (set-match-data md) (goto-char (match-beginning 1)) @@ -1535,12 +1353,23 @@ the current file." (unless desc (insert "][" link)) (add-text-properties pos (point) props)))))) +(defun org-export-remember-html-container-classes () + "Store the HTML_CONTAINER_CLASS properties in a text property." + (goto-char (point-min)) + (let (class) + (while (re-search-forward + "^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t) + (setq class (match-string 1)) + (save-excursion + (org-back-to-heading t) + (put-text-property (point-at-bol) (point-at-eol) 'html-container-class class))))) + (defvar org-export-format-drawer-function nil "Function to be called to format the contents of a drawer. The function must accept three parameters: - BACKEND one of the symbols html, docbook, latex, ascii, xoxo NAME the drawer name, like \"PROPERTIES\" CONTENT the content of the drawer. + BACKEND one of the symbols html, docbook, latex, ascii, xoxo The function should return the text to be inserted into the buffer. If this is nil, `org-export-format-drawer' is used as a default.") @@ -1659,7 +1488,7 @@ from the buffer." (goto-char (point-min)) (while (re-search-forward re-archive nil t) (if (not (org-on-heading-p t)) - (org-end-of-subtree t) + (goto-char (point-at-eol)) (beginning-of-line 1) (setq a (if export-archived-trees (1+ (point-at-eol)) (point)) @@ -1713,6 +1542,26 @@ from the buffer." (add-text-properties (point) (org-end-of-subtree t) '(org-protected t))))) +(defun org-export-convert-protected-spaces (backend) + "Convert strings like \\____ to protected spaces in all backends." + (goto-char (point-min)) + (while (re-search-forward "\\\\__+" nil t) + (org-if-unprotected-1 + (replace-match + (org-add-props + (cond + ((eq backend 'latex) + (format "\\hspace{%dex}" (- (match-end 0) (match-beginning 0)))) + ((eq backend 'html) + (org-add-props (match-string 0) nil + 'org-whitespace (- (match-end 0) (match-beginning 0)))) + ;; ((eq backend 'docbook)) + ((eq backend 'ascii) + (org-add-props (match-string 0) '(org-whitespace t))) + (t (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) + '(org-protected t)) + t t)))) + (defun org-export-protect-verbatim () "Mark verbatim snippets with the protection property." (goto-char (point-min)) @@ -1739,6 +1588,7 @@ from the buffer." (let ((formatters '((docbook "DOCBOOK" "BEGIN_DOCBOOK" "END_DOCBOOK") (html "HTML" "BEGIN_HTML" "END_HTML") + (beamer "BEAMER" "BEGIN_BEAMER" "END_BEAMER") (ascii "ASCII" "BEGIN_ASCII" "END_ASCII") (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) (case-fold-search t) @@ -1746,15 +1596,25 @@ from the buffer." (while formatters (setq fmt (pop formatters)) - (when (eq (car fmt) backend) - ;; This is selected code, put it into the file for real - (goto-char (point-min)) - (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" (cadr fmt) - ":[ \t]*\\(.*\\)") nil t) + ;; Handle #+Backend: stuff + (goto-char (point-min)) + (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" (cadr fmt) + ":[ \t]*\\(.*\\)") nil t) + (if (not (eq (car fmt) backend)) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) (replace-match "\\1\\2" t) (add-text-properties (point-at-bol) (min (1+ (point-at-eol)) (point-max)) '(org-protected t)))) + ;; Delete #+attr_Backend: stuff of another backend. Those + ;; matching the current backend will be taken care of by + ;; `org-export-attach-captions-and-attributes' + (goto-char (point-min)) + (while (re-search-forward (concat "^\\([ \t]*\\)#\\+attr_" (cadr fmt) + ":[ \t]*\\(.*\\)") nil t) + (when (not (eq (car fmt) backend)) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) + ;; Handle #+begin_Backend and #+end_Backend stuff (goto-char (point-min)) (while (re-search-forward (concat "^[ \t]*#\\+" (caddr fmt) "\\>.*\n?") nil t) @@ -1788,8 +1648,8 @@ These special cookies will later be interpreted by the backend." (setq beg (match-beginning 0) beg1 (1+ (match-end 0))) (when (re-search-forward (concat "^[ \t]*#\\+end_" type "\\>.*") nil t) - (setq end (1+ (point-at-eol)) - end1 (1- (match-beginning 0))) + (setq end1 (1- (match-beginning 0)) + end (+ (point-at-eol) (if (looking-at "\n$") 1 0))) (setq content (org-remove-indentation (buffer-substring beg1 end1))) (setq content (concat "ORG-" (upcase t1) "-START\n" content "\n" @@ -1797,6 +1657,31 @@ These special cookies will later be interpreted by the backend." (delete-region beg end) (insert (org-add-props content nil 'original-indentation ind)))))) +(defun org-export-mark-list-ending (backend) + "Mark list endings with special cookies. +These special cookies will later be interpreted by the backend. +`org-list-end-re' is replaced by a blank line in the process." + (let ((process-buffer + (lambda (end-list-marker) + (goto-char (point-min)) + (while (org-search-forward-unenclosed org-item-beginning-re nil t) + (goto-char (org-list-bottom-point)) + (when (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) + (replace-match "\n")) + (insert end-list-marker))))) + ;; We need to divide backends into 3 categories. + (cond + ;; 1. Backends using `org-list-parse-list' do not need markers. + ((memq backend '(latex)) + nil) + ;; 2. Line-processing backends need to be told where lists end. + ((memq backend '(html docbook)) + (funcall process-buffer "ORG-LIST-END\n")) + ;; 3. Others backends do not need to know this: clean list enders. + (t + (funcall process-buffer ""))))) + (defun org-export-attach-captions-and-attributes (backend target-alist) "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. If the next thing following is a table, add the text properties to the first @@ -1811,38 +1696,55 @@ table line. If it is a link, add it to the line containing the link." "\\|" "^[ \t]*#\\+label:[ \t]+\\(.*\\)" "\\|" - "^[ \t]*|[^-]" + "^[ \t]*\\(|[^-]\\)" "\\|" "^[ \t]*\\[\\[.*\\]\\][ \t]*$")) - cap attr label) + cap shortn attr label end) (while (re-search-forward re nil t) (cond ((match-end 1) - (setq cap (concat cap (if cap " " "") (org-trim (match-string 1))))) + (progn + (setq cap (concat cap (if cap " " "") (org-trim (match-string 1)))) + (when (string-match "\\[\\(.*\\)\\]{\\(.*\\)}" cap) + (setq shortn (match-string 1 cap) + cap (match-string 2 cap))) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) ((match-end 2) - (setq attr (concat attr (if attr " " "") (org-trim (match-string 2))))) + (progn + (setq attr (concat attr (if attr " " "") (org-trim (match-string 2)))) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) ((match-end 3) - (setq label (org-trim (match-string 3)))) + (progn + (setq label (org-trim (match-string 3))) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) (t - (add-text-properties (point-at-bol) (point-at-eol) + (setq end (if (match-end 4) + (let ((ee (org-table-end))) + (prog1 (1- (marker-position ee)) (move-marker ee nil))) + (point-at-eol))) + (add-text-properties (point-at-bol) end (list 'org-caption cap + 'org-caption-shortn shortn 'org-attributes attr 'org-label label)) (if label (push (cons label label) target-alist)) + (goto-char end) (setq cap nil attr nil label nil))))) target-alist) (defun org-export-remove-comment-blocks-and-subtrees () "Remove the comment environment, and also commented subtrees." (let ((re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>")) - (case-fold-search nil)) + case-fold-search) ;; Remove comment environment (goto-char (point-min)) + (setq case-fold-search t) (while (re-search-forward - "^#\\+BEGIN_COMMENT[ \t]*\n[^\000]*?^#\\+END_COMMENT\\>.*" nil t) + "^#\\+begin_comment[ \t]*\n[^\000]*?^#\\+end_comment\\>.*" nil t) (replace-match "" t t)) ;; Remove subtrees that are commented (goto-char (point-min)) + (setq case-fold-search nil) (while (re-search-forward re-commented nil t) (goto-char (match-beginning 0)) (delete-region (point) (org-end-of-subtree t))))) @@ -1851,21 +1753,36 @@ table line. If it is a link, add it to the line containing the link." "Remove comments, or convert to backend-specific format. COMMENTSP can be a format string for publishing comments. When it is nil, all comments will be removed." - (let ((re "^\\(#\\|[ \t]*#\\+\\)\\(.*\n?\\)") + (let ((re "^\\(#\\|[ \t]*#\\+ \\)\\(.*\n?\\)") + pos) + (goto-char (point-min)) + (while (or (looking-at re) + (re-search-forward re nil t)) + (setq pos (match-beginning 0)) + (if (get-text-property pos 'org-protected) + (goto-char (1+ pos)) + (if (and commentsp + (not (equal (char-before (match-end 1)) ?+))) + (progn (add-text-properties + (match-beginning 0) (match-end 0) '(org-protected t)) + (replace-match (format commentsp (match-string 2)) t t)) + (goto-char (1+ pos)) + (replace-match "") + (goto-char (max (point-min) (1- pos)))))))) + +(defun org-export-handle-table-metalines () + "Remove table specific metalines #+TBLNAME: and #+TBLFM:." + (let ((re "^[ \t]*#\\+TBL\\(NAME\\|FM\\):\\(.*\n?\\)") pos) (goto-char (point-min)) (while (or (looking-at re) (re-search-forward re nil t)) (setq pos (match-beginning 0)) - (if (and commentsp - (not (equal (char-before (match-end 1)) ?+))) - (progn (add-text-properties - (match-beginning 0) (match-end 0) '(org-protected t)) - (replace-match (format commentsp (match-string 2)) t t)) + (if (get-text-property (match-beginning 1) 'org-protected) + (goto-char (1+ pos)) (goto-char (1+ pos)) - (org-if-unprotected - (replace-match "") - (goto-char (max (point-min) (1- pos)))))))) + (replace-match "") + (goto-char (max (point-min) (1- pos))))))) (defun org-export-mark-radio-links () "Find all matches for radio targets and turn them into internal links." @@ -1877,30 +1794,54 @@ When it is nil, all comments will be removed." (unless (save-match-data (or (org-in-regexp org-bracket-link-regexp) - (org-in-regexp org-plain-link-re))) + (org-in-regexp org-plain-link-re) + (org-in-regexp "<<[^<>]+>>"))) (org-if-unprotected (replace-match "\\1[[\\2]]"))))))) +(defun org-store-forced-table-alignment () + "Find table lines which force alignment, store the results in properties." + (let (line cnt aligns) + (goto-char (point-min)) + (while (re-search-forward "|[ \t]*<[lrc][0-9]*>[ \t]*|" nil t) + ;; OK, this looks like a table line with an alignment cookie + (org-if-unprotected + (setq line (buffer-substring (point-at-bol) (point-at-eol))) + (when (and (org-at-table-p) + (org-table-cookie-line-p line)) + (setq cnt 0 aligns nil) + (mapc + (lambda (x) + (setq cnt (1+ cnt)) + (if (string-match "\\`<\\([lrc]\\)" x) + (push (cons cnt (downcase (match-string 1 x))) aligns))) + (org-split-string line "[ \t]*|[ \t]*")) + (add-text-properties (org-table-begin) (org-table-end) + (list 'org-forced-aligns aligns)))) + (goto-char (point-at-eol))))) + (defun org-export-remove-special-table-lines () - "Remove tables lines that are used for internal purposes." + "Remove tables lines that are used for internal purposes. +Also, store forcedalignment information found in such lines." (goto-char (point-min)) (while (re-search-forward "^[ \t]*|" nil t) - (beginning-of-line 1) - (if (or (looking-at "[ \t]*| *[!_^] *|") - (not - (memq - nil - (mapcar - (lambda (f) - (or (= (length f) 0) - (string-match - "\\`<\\([0-9]\\|[rl]\\|[rl][0-9]+\\)>\\'" f))) - (org-split-string ;; FIXME, can't we do this without splitting??? - (buffer-substring (point-at-bol) (point-at-eol)) - "[ \t]*|[ \t]*"))))) - (delete-region (max (point-min) (1- (point-at-bol))) - (point-at-eol)) - (end-of-line 1)))) + (org-if-unprotected-at (1- (point)) + (beginning-of-line 1) + (if (or (looking-at "[ \t]*| *[!_^] *|") + (not + (memq + nil + (mapcar + (lambda (f) + (or (= (length f) 0) + (string-match + "\\`<\\([0-9]\\|[lrc]\\|[lrc][0-9]+\\)>\\'" f))) + (org-split-string ;; FIXME, can't we do without splitting??? + (buffer-substring (point-at-bol) (point-at-eol)) + "[ \t]*|[ \t]*"))))) + (delete-region (max (point-min) (1- (point-at-bol))) + (point-at-eol)) + (end-of-line 1))))) (defun org-export-protect-sub-super (s) (save-match-data @@ -1915,16 +1856,19 @@ When it is nil, all comments will be removed." nodesc) (goto-char (point-min)) (while (re-search-forward re-plain-link nil t) - (goto-char (1- (match-end 0))) - (org-if-unprotected-at (1+ (match-beginning 0)) - (let* ((s (concat (match-string 1) - "[[" (match-string 2) ":" (match-string 3) - "][" (match-string 2) ":" (org-export-protect-sub-super - (match-string 3)) - "]]"))) - ;; added 'org-link face to links - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t)))) + (unless (org-string-match-p + "\\[\\[\\S+:\\S-*?\\<" + (buffer-substring (point-at-bol) (match-beginning 0))) + (goto-char (1- (match-end 0))) + (org-if-unprotected-at (1+ (match-beginning 0)) + (let* ((s (concat (match-string 1) + "[[" (match-string 2) ":" (match-string 3) + "][" (match-string 2) ":" (org-export-protect-sub-super + (match-string 3)) + "]]"))) + ;; added 'org-link face to links + (put-text-property 0 (length s) 'face 'org-link s) + (replace-match s t t))))) (goto-char (point-min)) (while (re-search-forward re-angle-link nil t) (goto-char (1- (match-end 0))) @@ -1962,7 +1906,7 @@ This is to make sure that the line-processing export backends can work correctly." (goto-char (point-min)) (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t) - (org-if-unprotected + (org-if-unprotected-at (match-beginning 1) (replace-match "\\1 \\3") (goto-char (match-beginning 0))))) @@ -1975,7 +1919,9 @@ can work correctly." (if (and (not (= (char-after (match-beginning 3)) (char-after (match-beginning 4)))) (save-excursion (goto-char (match-beginning 0)) - (save-match-data (not (org-at-table-p))))) + (save-match-data + (and (not (org-at-table-p)) + (not (org-at-heading-p)))))) (org-if-unprotected (subst-char-in-region (match-beginning 0) (match-end 0) ?\n ?\ t) @@ -2144,16 +2090,15 @@ TYPE must be a string, any of: (intern (concat ":" key))))) (save-match-data (when args - (setq args (org-split-string args ",[ \t\n]*") args2 nil) - (setq args (mapcar 'org-trim args)) + (setq args (org-split-string args ",") args2 nil) (while args (while (string-match "\\\\\\'" (car args)) ;; repair bad splits (setcar (cdr args) (concat (substring (car args) 0 -1) - ";" (nth 1 args))) + "," (nth 1 args))) (pop args)) (push (pop args) args2)) - (setq args (nreverse args2)) + (setq args (mapcar 'org-trim (nreverse args2))) (setq s 0) (while (string-match "\\$\\([0-9]+\\)" val s) (setq s (1+ (match-beginning 0)) @@ -2181,12 +2126,13 @@ TYPE must be a string, any of: (defun org-export-handle-include-files () "Include the contents of include files, with proper formatting." (let ((case-fold-search t) - params file markup lang start end prefix prefix1 switches) + params file markup lang start end prefix prefix1 switches all minlevel) (goto-char (point-min)) (while (re-search-forward "^#\\+INCLUDE:?[ \t]+\\(.*\\)" nil t) (setq params (read (concat "(" (match-string 1) ")")) prefix (org-get-and-remove-property 'params :prefix) prefix1 (org-get-and-remove-property 'params :prefix1) + minlevel (org-get-and-remove-property 'params :minlevel) file (org-symname-or-string (pop params)) markup (org-symname-or-string (pop params)) lang (and (member markup '("src" "SRC")) @@ -2198,6 +2144,7 @@ TYPE must be a string, any of: (not (file-exists-p file)) (not (file-readable-p file))) (insert (format "CANNOT INCLUDE FILE %s" file)) + (setq all (cons file all)) (when markup (if (equal (downcase markup) "src") (setq start (format "#+begin_src %s %s\n" @@ -2208,11 +2155,24 @@ TYPE must be a string, any of: end (format "#+end_%s" markup)))) (insert (or start "")) (insert (org-get-file-contents (expand-file-name file) - prefix prefix1 markup)) + prefix prefix1 markup minlevel)) (or (bolp) (newline)) - (insert (or end "")))))) - -(defun org-get-file-contents (file &optional prefix prefix1 markup) + (insert (or end "")))) + all)) + +(defun org-export-handle-include-files-recurse () + "Recursively include files aborting on circular inclusion." + (let ((now (list org-current-export-file)) all) + (while now + (setq all (append now all)) + (setq now (org-export-handle-include-files)) + (let ((intersection + (delq nil + (mapcar (lambda (el) (when (member el all) el)) now)))) + (when intersection + (error "Recursive #+INCLUDE: %S" intersection)))))) + +(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel) "Get the contents of FILE and return them as a string. If PREFIX is a string, prepend it to each line. If PREFIX1 is a string, prepend it to the first line instead of PREFIX. @@ -2225,7 +2185,7 @@ take care of the block they are in." (goto-char (point-min)) (while (not (eobp)) (insert (or prefix1 prefix)) - (setq prefix1 nil) + (setq prefix1 "") (beginning-of-line 2))) (buffer-string) (when (member markup '("src" "example")) @@ -2234,6 +2194,9 @@ take care of the block they are in." (goto-char (match-beginning 0)) (insert ",") (end-of-line 1))) + (when minlevel + (dotimes (lvl minlevel) + (org-map-region 'org-demote (point-min) (point-max)))) (buffer-string))) (defun org-get-and-remove-property (listvar prop) @@ -2263,24 +2226,36 @@ in the list) and remove property and value from the list in LISTVAR." "Replace source code segments with special code for export." (setq org-export-last-code-line-counter-value 0) (let ((case-fold-search t) - lang code trans opts indent) + lang code trans opts indent caption) (goto-char (point-min)) (while (re-search-forward - "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?[ \t]+\\([^ \t\n]+\\)\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\\)" + "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?\\([ \t]+\\([^ \t\n]+\\)\\)?\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\n?\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\n?\\)" nil t) (if (match-end 1) - ;; src segments - (setq lang (match-string 3) - opts (match-string 4) - code (match-string 5) - indent (length (match-string 2))) + (if (not (match-string 4)) + (error "Source block missing language specification: %s" + (let* ((body (match-string 6)) + (nothing (message "body:%s" body)) + (preview (or (and (string-match + "^[ \t]*\\([^\n\r]*\\)" body) + (match-string 1 body)) body))) + (if (> (length preview) 35) + (concat (substring preview 0 32) "...") + preview))) + ;; src segments + (setq lang (match-string 4) + opts (match-string 5) + code (match-string 6) + indent (length (match-string 2)) + caption (get-text-property 0 'org-caption (match-string 0)))) (setq lang nil - opts (match-string 8) - code (match-string 9) - indent (length (match-string 7)))) + opts (match-string 9) + code (match-string 10) + indent (length (match-string 8)) + caption (get-text-property 0 'org-caption (match-string 0)))) (setq trans (org-export-format-source-code-or-example - backend lang code opts indent)) + backend lang code opts indent caption)) (replace-match trans t t)))) (defvar htmlp) ;; dynamically scoped @@ -2288,9 +2263,10 @@ in the list) and remove property and value from the list in LISTVAR." (defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el (defvar org-export-latex-listings) ;; defined in org-latex.el (defvar org-export-latex-listings-langs) ;; defined in org-latex.el - +(defvar org-export-latex-listings-w-names) ;; defined in org-latex.el +(defvar org-export-latex-minted-langs) ;; defined in org-latex.el (defun org-export-format-source-code-or-example - (backend lang code &optional opts indent) + (backend lang code &optional opts indent caption) "Format CODE from language LANG and return it formatted for export. If LANG is nil, do not add any fontification. OPTS contains formatting options, like `-n' for triggering numbering lines, @@ -2341,13 +2317,15 @@ INDENT was the original indentation of the block." (concat "\n#+BEGIN_DOCBOOK\n" (org-add-props (concat "<programlisting><![CDATA[" rtn - "]]>\n</programlisting>\n") - '(org-protected t)) + "]]></programlisting>\n") + '(org-protected t org-example t)) "#+END_DOCBOOK\n")) ((eq backend 'html) ;; We are exporting to HTML (when lang - (require 'htmlize nil t) + (if (featurep 'xemacs) + (require 'htmlize) + (require 'htmlize nil t)) (when (not (fboundp 'htmlize-region-for-paste)) ;; we do not have htmlize.el, or an old version of it (setq lang nil) @@ -2378,12 +2356,22 @@ INDENT was the original indentation of the block." (org-export-htmlize-region-for-paste (point-min) (point-max)))) (if (string-match "<pre\\([^>]*\\)>\n*" rtn) - (setq rtn (replace-match - (format "<pre class=\"src src-%s\">\n" lang) - t t rtn)))) + (setq rtn + (concat + (if caption + (concat + "<div class=\"org-src-container\">" + (format + "<label class=\"org-src-name\">%s</label>" + caption)) + "") + (replace-match + (format "<pre class=\"src src-%s\">\n" lang) + t t rtn) + (if caption "</div>" ""))))) (if textareap (setq rtn (concat - (format "<p>\n<textarea cols=\"%d\" rows=\"%d\" overflow-x:scroll >\n" + (format "<p>\n<textarea cols=\"%d\" rows=\"%d\">" cols rows) rtn "</textarea>\n</p>\n")) (with-temp-buffer @@ -2400,34 +2388,60 @@ INDENT was the original indentation of the block." cont rpllbl fmt))) (if (string-match "\\(\\`<[^>]*>\\)\n" rtn) (setq rtn (replace-match "\\1" t nil rtn))) - (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t)) "\n#+END_HTML\n\n")) + (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t org-example t)) "\n#+END_HTML\n\n")) ((eq backend 'latex) (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt)) - (concat "\n#+BEGIN_LaTeX\n" + (concat "#+BEGIN_LaTeX\n" (org-add-props - (if org-export-latex-listings - (concat - (if lang - (let* - ((lang-sym (intern lang)) - (lstlang - (or (cadr - (assq - lang-sym - org-export-latex-listings-langs)) - lang))) - (format "\\lstset{language=%s}\n" lstlang)) - "") - "\\begin{lstlisting}\n" - rtn "\\end{lstlisting}\n") - (concat (car org-export-latex-verbatim-wrap) - rtn (cdr org-export-latex-verbatim-wrap))) - '(org-protected t)) - "#+END_LaTeX\n\n")) - ((eq backend 'ascii) - ;; This is not HTML or LaTeX, so just make it an example. - (setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt)) - (concat "#+BEGIN_ASCII\n" + (cond + ((and org-export-latex-listings + (not (eq org-export-latex-listings 'minted))) + (concat + (if lang + (let* + ((lang-sym (intern lang)) + (lstlang + (or (cadr + (assq + lang-sym + org-export-latex-listings-langs)) + lang))) + (format "\\lstset{language=%s}\n" lstlang)) + "\n") + (when (and caption + org-export-latex-listings-w-names) + (format "\n%s $\\equiv$ \n" + (replace-regexp-in-string + "_" "\\\\_" caption))) + "\\begin{lstlisting}\n" + rtn "\\end{lstlisting}\n")) + ((eq org-export-latex-listings 'minted) + (if lang + (let* + ((lang-sym (intern lang)) + (minted-lang + (or (cadr + (assq + lang-sym + org-export-latex-minted-langs)) + (downcase lang)))) + (concat + (when (and caption + org-export-latex-listings-w-names) + (format "\n%s $\\equiv$ \n" + (replace-regexp-in-string + "_" "\\\\_" caption))) + (format "\\begin{minted}{%s}\n" minted-lang) + rtn "\\end{minted}\n")))) + (t (concat (car org-export-latex-verbatim-wrap) + rtn (cdr org-export-latex-verbatim-wrap)))) + '(org-protected t org-example t)) + "#+END_LaTeX\n")) + ((eq backend 'ascii) + ;; This is not HTML or LaTeX, so just make it an example. + (setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt)) + (concat caption "\n" + "#+BEGIN_ASCII\n" (org-add-props (concat (mapconcat @@ -2435,7 +2449,7 @@ INDENT was the original indentation of the block." (org-split-string rtn "\n") "\n") "\n") - '(org-protected t)) + '(org-protected t org-example t)) "#+END_ASCII\n")))) (org-add-props rtn nil 'original-indentation indent)))) @@ -2538,22 +2552,27 @@ INDENT was the original indentation of the block." (defun org-export-visible (type arg) "Create a copy of the visible part of the current buffer, and export it. The copy is created in a temporary buffer and removed after use. -TYPE is the final key (as a string) that also select the export command in -the `C-c C-e' export dispatcher. - -As a special case, if you type SPC at the prompt, the temporary org-mode -file will not be removed but presented to you so that you can continue to -use it. The prefix arg ARG is passed through to the exporting command." +TYPE is the final key (as a string) that also selects the export command in +the \\<org-mode-map>\\[org-export] export dispatcher. +As a special case, if the you type SPC at the prompt, the temporary +org-mode file will not be removed but presented to you so that you can +continue to use it. The prefix arg ARG is passed through to the exporting +command." (interactive (list (progn - (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]uffer with HTML [D]ocBook [x]OXO [ ]keep buffer") + (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]buffer with HTML [D]ocBook [l]atex [p]df [d]view pdf [L]atex buffer [x]OXO [ ]keep buffer") (read-char-exclusive)) current-prefix-arg)) - (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?D ?x ?\ ))) + (if (not (member type '(?a ?n ?u ?\C-a ?b ?\C-b ?h ?D ?x ?\ ?l ?p ?d ?L))) (error "Invalid export key")) (let* ((binding (cdr (assoc type - '((?a . org-export-as-ascii) + '( + (?a . org-export-as-ascii) (?A . org-export-as-ascii-to-buffer) + (?n . org-export-as-latin1) + (?N . org-export-as-latin1-to-buffer) + (?u . org-export-as-utf8) + (?U . org-export-as-utf8-to-buffer) (?\C-a . org-export-as-ascii) (?b . org-export-as-html-and-open) (?\C-b . org-export-as-html-and-open) @@ -2561,6 +2580,12 @@ use it. The prefix arg ARG is passed through to the exporting command." (?H . org-export-as-html-to-buffer) (?R . org-export-region-as-html) (?D . org-export-as-docbook) + + (?l . org-export-as-latex) + (?p . org-export-as-pdf) + (?d . org-export-as-pdf-and-open) + (?L . org-export-as-latex-to-buffer) + (?x . org-export-as-xoxo))))) (keepp (equal type ?\ )) (file buffer-file-name) @@ -2587,9 +2612,10 @@ use it. The prefix arg ARG is passed through to the exporting command." ;; does do the trick. (if (looking-at "#[^\r\n]*") (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0)))) - (while (re-search-forward "[\n\r]#[^\n\r]*" nil t) - (append-to-buffer buffer (1+ (match-beginning 0)) - (min (point-max) (1+ (match-end 0)))))) + (when (re-search-forward "^\\*+[ \t]+" nil t) + (while (re-search-backward "[\n\r]#[^\n\r]*" nil t) + (append-to-buffer buffer (1+ (match-beginning 0)) + (min (point-max) (1+ (match-end 0))))))) (set-buffer buffer) (let ((buffer-file-name file) (org-inhibit-startup t)) @@ -2614,6 +2640,28 @@ use it. The prefix arg ARG is passed through to the exporting command." (defvar org-export-htmlized-org-css-url) ;; defined in org-html.el +(defun org-export-string (string fmt &optional dir) + "Export STRING to FMT using existing export facilities. +During export STRING is saved to a temporary file whose location +could vary. Optional argument DIR can be used to force the +directory in which the temporary file is created during export +which can be useful for resolving relative paths. Dir defaults +to the value of `temporary-file-directory'." + (let ((temporary-file-directory (or dir temporary-file-directory)) + (tmp-file (make-temp-file "org-"))) + (unwind-protect + (with-temp-buffer + (insert string) + (write-file tmp-file) + (org-load-modules-maybe) + (unless org-local-vars + (setq org-local-vars (org-get-local-variables))) + (eval ;; convert to fmt -- mimicing `org-run-like-in-org-mode' + (list 'let org-local-vars + (list (intern (concat "org-export-as-" fmt)) + nil nil nil ''string t)))) + (delete-file tmp-file)))) + ;;;###autoload (defun org-export-as-org (arg &optional hidden ext-plist to-buffer body-only pub-dir) @@ -2655,7 +2703,8 @@ directory." filename))) (backup-inhibited t) (buffer (find-file-noselect filename)) - (region (buffer-string))) + (region (buffer-string)) + str-ret) (save-excursion (switch-to-buffer buffer) (erase-buffer) @@ -2701,7 +2750,11 @@ directory." (write-file (concat filename ".html"))) (kill-buffer newbuf))) (set-buffer-modified-p nil) - (kill-buffer (current-buffer))))) + (if (equal to-buffer 'string) + (progn (setq str-ret (buffer-string)) + (kill-buffer (current-buffer)) + str-ret) + (kill-buffer (current-buffer)))))) (defvar org-archive-location) ;; gets loaded with the org-archive require. (defun org-get-current-options () @@ -2723,6 +2776,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+EXPORT_EXCLUDE_TAGS: %s #+LINK_UP: %s #+LINK_HOME: %s +#+XSLT: #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s @@ -2815,13 +2869,16 @@ If yes remove the column and the special lines." "^[ \t]*| *\\([\#!$*_^ /]\\) *|") x))) lines)) + ;; No special marking column (progn (setq org-table-clean-did-remove-column nil) (delq nil (mapcar (lambda (x) (cond - ((string-match "^[ \t]*| */ *|" x) + ((org-table-colgroup-line-p x) + ;; This line contains colgroup info, extract it + ;; and then discard the line (setq org-table-colgroup-info (mapcar (lambda (x) (cond ((member x '("<" "<")) :start) @@ -2830,14 +2887,20 @@ If yes remove the column and the special lines." (t nil))) (org-split-string x "[ \t]*|[ \t]*"))) nil) + ((org-table-cookie-line-p x) + ;; This line contains formatting cookies, discard it + nil) (t x))) lines))) + ;; there is a special marking column (setq org-table-clean-did-remove-column t) (delq nil (mapcar (lambda (x) (cond - ((string-match "^[ \t]*| */ *|" x) + ((org-table-colgroup-line-p x) + ;; This line contains colgroup info, extract it + ;; and then discard the line (setq org-table-colgroup-info (mapcar (lambda (x) (cond ((member x '("<" "<")) :start) @@ -2846,8 +2909,12 @@ If yes remove the column and the special lines." (t nil))) (cdr (org-split-string x "[ \t]*|[ \t]*")))) nil) + ((org-table-cookie-line-p x) + ;; This line contains formatting cookies, discard it + nil) ((string-match "^[ \t]*| *[!_^/] *|" x) - nil) ; ignore this line + ;; ignore this line + nil) ((or (string-match "^\\([ \t]*\\)|-+\\+" x) (string-match "^\\([ \t]*\\)|[^|]*|" x)) ;; remove the first column @@ -2857,7 +2924,7 @@ If yes remove the column and the special lines." (defun org-export-cleanup-toc-line (s) "Remove tags and timestamps from lines going into the toc." (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s) + (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) (setq s (replace-match "" t t s)))) (when org-export-remove-timestamps-from-toc (while (string-match org-maybe-keyword-time-regexp s) @@ -2869,41 +2936,6 @@ If yes remove the column and the special lines." (setq s (replace-match "" t t s))) s) -(defun org-create-multibrace-regexp (left right n) - "Create a regular expression which will match a balanced sexp. -Opening delimiter is LEFT, and closing delimiter is RIGHT, both given -as single character strings. -The regexp returned will match the entire expression including the -delimiters. It will also define a single group which contains the -match except for the outermost delimiters. The maximum depth of -stacked delimiters is N. Escaping delimiters is not possible." - (let* ((nothing (concat "[^" left right "]*?")) - (or "\\|") - (re nothing) - (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) - (while (> n 1) - (setq n (1- n) - re (concat re or next) - next (concat "\\(?:" nothing left next right "\\)+" nothing))) - (concat left "\\(" re "\\)" right))) - -(defvar org-match-substring-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\|" - "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" - "\\|" - "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") - "The regular expression matching a sub- or superscript.") - -(defvar org-match-substring-with-braces-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\)") - "The regular expression matching a sub- or superscript, forcing braces.") - (defun org-get-text-property-any (pos prop &optional object) (or (get-text-property pos prop object) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index 70bd7eb0cb1..d4f458232ce 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -49,7 +49,7 @@ (defgroup org-faces nil "Faces in Org-mode." :tag "Org Faces" - :group 'org-font-lock) + :group 'org-appearance) (defface org-hide '((((background light)) (:foreground "white")) @@ -247,9 +247,7 @@ column view defines special faces for each outline level. See the file :group 'org-faces) (defface org-link - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t))) + '((t :inherit link)) "Face for links." :group 'org-faces) @@ -338,29 +336,53 @@ This face is only used if `org-fontify-done-headline' is set. If applies to the part of the headline after the DONE keyword." :group 'org-faces) +(defcustom org-faces-easy-properties + '((todo . :foreground) (tag . :foreground) (priority . :foreground)) + "The property changes by easy faces. +This is an alist, the keys show the area of application, the values +can be `:foreground' or `:background'. A color string for special +keywords will then be interpreted as either foreground or background +color." + :group 'org-faces + :group 'org-todo + :type '(repeat + (cons (choice (const todo) (const tag) (const priority)) + (choice (const :foreground) (const :background))))) + (defcustom org-todo-keyword-faces nil "Faces for specific TODO keywords. This is a list of cons cells, with TODO keywords in the car -and faces in the cdr. The face can be a symbol, or a property -list of attributes, like (:foreground \"blue\" :weight bold :underline t)." +and faces in the cdr. The face can be a symbol, a color +as a string (in which case the rest is inherited from the `org-todo' face), +or a property list of attributes, like + (:foreground \"blue\" :weight bold :underline t). +If it is a color string, the variable `org-faces-easy-properties' +determines if it is a foreground or a background color." :group 'org-faces :group 'org-todo :type '(repeat (cons - (string :tag "keyword") - (sexp :tag "face")))) + (string :tag "Keyword") + (choice :tag "Face " + (string :tag "Color") + (sexp :tag "Face"))))) (defcustom org-priority-faces nil "Faces for specific Priorities. This is a list of cons cells, with priority character in the car -and faces in the cdr. The face can be a symbol, or a property -list of attributes, like (:foreground \"blue\" :weight bold :underline t)." +and faces in the cdr. The face can be a symbol, a color as +as a string, or a property list of attributes, like + (:foreground \"blue\" :weight bold :underline t). +If it is a color string, the variable `org-faces-easy-properties' +determines if it is a foreground or a background color." :group 'org-faces :group 'org-todo :type '(repeat (cons (character :tag "Priority") - (sexp :tag "face")))) + (choice :tag "Face " + (string :tag "Color") + (sexp :tag "Face"))))) (defvar org-tags-special-faces-re nil) (defun org-set-tag-faces (var value) @@ -378,15 +400,16 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)." (org-copy-face 'org-todo 'org-checkbox-statistics-todo - "Face used for unfinished checkbox statistics.") + "Face used for unfinished checkbox statistics.") (org-copy-face 'org-done 'org-checkbox-statistics-done - "Face used for finished checkbox statistics.") + "Face used for finished checkbox statistics.") (defcustom org-tag-faces nil "Faces for specific tags. This is a list of cons cells, with tags in the car and faces in the cdr. -The face can be a symbol, or a property list of attributes, +The face can be a symbol, a foreground color (in which case the rest is +inherited from the `org-tag' face) or a property list of attributes, like (:foreground \"blue\" :weight bold :underline t). If you set this variable through customize, it will immediately be effective in new buffers and in modified lines. @@ -397,8 +420,10 @@ changes." :set 'org-set-tag-faces :type '(repeat (cons - (string :tag "Tag") - (sexp :tag "Face")))) + (string :tag "Tag ") + (choice :tag "Face" + (string :tag "Foreground color") + (sexp :tag "Face"))))) (defface org-table ;; originally copied from font-lock-function-name-face (org-compatible-face nil @@ -431,7 +456,7 @@ changes." (:foreground "green")) (((class color) (min-colors 8) (background dark)) (:foreground "yellow")))) - "Face for fixed-with text like code snippets." + "Face for fixed-width text like code snippets." :group 'org-faces :version "22.1") @@ -441,6 +466,34 @@ changes." :group 'org-faces :version "22.1") +(defface org-document-title + '((((class color) (background light)) (:foreground "midnight blue" :weight bold :height 1.44)) + (((class color) (background dark)) (:foreground "pale turquoise" :weight bold :height 1.44)) + (t (:weight bold :height 1.44))) + "Face for document title, i.e. that which follows the #+TITLE: keyword." + :group 'org-faces) + +(defface org-document-info + '((((class color) (background light)) (:foreground "midnight blue")) + (((class color) (background dark)) (:foreground "pale turquoise")) + (t nil)) + "Face for document date, author and email; i.e. that which +follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword." + :group 'org-faces) + +(defface org-document-info-keyword + (org-compatible-face 'shadow + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50")) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70")) + (((class color) (min-colors 8) (background light)) + (:foreground "green")) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow")))) + "Face for #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords." + :group 'org-faces) + (defface org-block (org-compatible-face 'shadow '((((class color grayscale) (min-colors 88) (background light)) @@ -474,6 +527,13 @@ changes." (org-copy-face 'org-block 'org-verse "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.") +(defcustom org-fontify-quote-and-verse-blocks nil + "Non-nil means, add a special face to #+begin_quote and #+begin_verse block. +When nil, format these as normal Org. This is the default, because the +content of these blocks will still be treated as Org syntax." + :group 'org-faces + :type 'boolean) + (defface org-clock-overlay ;; copied from secondary-selection (org-compatible-face nil '((((class color) (min-colors 88) (background light)) @@ -502,17 +562,17 @@ changes." :group 'org-faces) (org-copy-face 'org-agenda-structure 'org-agenda-date - "Face used in agenda for normal days.") + "Face used in agenda for normal days.") (org-copy-face 'org-agenda-date 'org-agenda-date-today - "Face used in agenda for today." - :weight 'bold :italic 't) + "Face used in agenda for today." + :weight 'bold :italic 't) (org-copy-face 'secondary-selection 'org-agenda-clocking - "Face marking the current clock item in the agenda.") + "Face marking the current clock item in the agenda.") (org-copy-face 'org-agenda-date 'org-agenda-date-weekend - "Face used in agenda for weekend days. + "Face used in agenda for weekend days. See the variable `org-agenda-weekend-days' for a definition of which days belong to the weekend." :weight 'bold) @@ -538,7 +598,7 @@ belong to the weekend." (defface org-agenda-dimmed-todo-face '((((background light)) (:foreground "grey50")) (((background dark)) (:foreground "grey50"))) - "Face used to dimm blocked tasks in the agenda." + "Face used to dim blocked tasks in the agenda." :group 'org-faces) (defface org-scheduled-previously @@ -605,6 +665,12 @@ month and 365.24 days for a year)." "Face used for time grids." :group 'org-faces) +(defface org-agenda-diary + (org-compatible-face 'default + nil) + "Face used for agenda entries that come from the Emacs diary." + :group 'org-faces) + (defconst org-level-faces '(org-level-1 org-level-2 org-level-3 org-level-4 org-level-5 org-level-6 org-level-7 org-level-8 @@ -617,6 +683,15 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." :type 'integer :group 'org-faces) +(defcustom org-cycle-level-faces t + "Non-nil means level styles cycle after level `org-n-level-faces'. +Then so level org-n-level-faces+1 is styled like level 1. +If nil, then all levels >=org-n-level-faces are styled like +level org-n-level-faces" + :group 'org-appearance + :group 'org-faces + :type 'boolean) + (defface org-latex-and-export-specials (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit underline)) @@ -634,7 +709,10 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." :group 'org-faces) (org-copy-face 'modeline 'org-mode-line-clock - "Face used for clock display in mode line.") + "Face used for clock display in mode line.") +(org-copy-face 'modeline 'org-mode-line-clock-overrun + "Face used for clock display for overrun tasks in mode line." + :background "red") (provide 'org-faces) diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index 8f973b96908..27a96f7be23 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -45,7 +45,7 @@ ;; With this setup, the command `M-x org-feed-update-all' will ;; collect new entries in the feed at the given URL and create ;; entries as subheadings under the "ReQall Entries" heading in the -;; file "~/org-feeds.org". Each feed should normally have its own +;; file "~/org/feeds.org". Each feed should normally have its own ;; heading - however see the `:drawer' parameter. ;; ;; Besides these standard elements that need to be specified for each @@ -83,8 +83,8 @@ ;; ;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS ;; -;; Acknowledgements -;; ---------------- +;; Acknowledgments +;; --------------- ;; ;; org-feed.el is based on ideas by Brad Bozarth who implemented a ;; similar mechanism using shell and awk scripts. @@ -99,10 +99,11 @@ (declare-function xml-get-children "xml" (node child-name)) (declare-function xml-get-attribute "xml" (node attribute)) (declare-function xml-get-attribute-or-nil "xml" (node attribute)) +(declare-function xml-substitute-special "xml" (string)) (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." - :tag "Org ID" + :tag "Org Feed" :group 'org) (defcustom org-feed-alist nil @@ -165,10 +166,11 @@ Here are the keyword-value pair allows in `org-feed-alist'. When the handler is called, point will be at the feed headline. :parse-feed function - This function gets passed a buffer, and should return a list of entries, - each being a property list containing the `:guid' and `:item-full-text' - keys. The default is `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' - is an alternative. + This function gets passed a buffer, and should return a list + of entries, each being a property list containing the + `:guid' and `:item-full-text' keys. The default is + `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' is an + alternative. :parse-entry function This function gets passed an entry as returned by the parse-feed @@ -199,12 +201,12 @@ Here are the keyword-value pair allows in `org-feed-alist'. (list :inline t :tag "Changed items" (const :changed-handler) (symbol :tag "Handler Function")) - (list :inline t :tag "Parse Feed" - (const :parse-feed) - (symbol :tag "Parse Feed Function")) - (list :inline t :tag "Parse Entry" - (const :parse-entry) - (symbol :tag "Parse Entry Function")) + (list :inline t :tag "Parse Feed" + (const :parse-feed) + (symbol :tag "Parse Feed Function")) + (list :inline t :tag "Parse Entry" + (const :parse-entry) + (symbol :tag "Parse Entry Function")) ))))) (defcustom org-feed-drawer "FEEDSTATUS" @@ -234,7 +236,7 @@ following special escapes are valid as well: :type '(string :tag "Template")) (defcustom org-feed-save-after-adding t - "Non-nil means, save buffer after adding new feed items." + "Non-nil means save buffer after adding new feed items." :group 'org-feed :type 'boolean) @@ -302,10 +304,10 @@ it can be a list structured like an entry in `org-feed-alist'." org-feed-default-template)) (drawer (or (nth 1 (memq :drawer feed)) org-feed-drawer)) - (parse-feed (or (nth 1 (memq :parse-feed feed)) - 'org-feed-parse-rss-feed)) - (parse-entry (or (nth 1 (memq :parse-entry feed)) - 'org-feed-parse-rss-entry)) + (parse-feed (or (nth 1 (memq :parse-feed feed)) + 'org-feed-parse-rss-feed)) + (parse-entry (or (nth 1 (memq :parse-entry feed)) + 'org-feed-parse-rss-entry)) feed-buffer inbox-pos new-formatted entries old-status status new changed guid-alist e guid olds) (setq feed-buffer (org-feed-get-feed url)) @@ -321,10 +323,11 @@ it can be a list structured like an entry in `org-feed-alist'." (setq old-status (org-feed-read-previous-status inbox-pos drawer)) ;; Add the "handled" status to the appropriate entries (setq entries (mapcar (lambda (e) - (setq e (plist-put e :handled - (nth 1 (assoc - (plist-get e :guid) - old-status))))) + (setq e + (plist-put e :handled + (nth 1 (assoc + (plist-get e :guid) + old-status))))) entries)) ;; Find out which entries are new and which are changed (dolist (e entries) @@ -539,7 +542,8 @@ If that property is already present, nothing changes." (setq tmp (org-feed-make-indented-block tmp (org-get-indentation)))))) (replace-match tmp t t)))) - (buffer-string))))) + (decode-coding-string + (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) (defun org-feed-make-indented-block (s n) "Add indentation of N spaces to a multiline string S." @@ -579,11 +583,12 @@ Assumes headers are indeed present!" "Parse BUFFER for RSS feed entries. Returns a list of entries, with each entry a property list, containing the properties `:guid' and `:item-full-text'." - (let (entries beg end item guid entry) + (let ((case-fold-search t) + entries beg end item guid entry) (with-current-buffer buffer (widen) (goto-char (point-min)) - (while (re-search-forward "<item>" nil t) + (while (re-search-forward "<item\\>.*?>" nil t) (setq beg (point) end (and (re-search-forward "</item>" nil t) (match-beginning 0))) @@ -598,6 +603,7 @@ containing the properties `:guid' and `:item-full-text'." (defun org-feed-parse-rss-entry (entry) "Parse the `:item-full-text' field for xml tags and create new properties." + (require 'xml) (with-temp-buffer (insert (plist-get entry :item-full-text)) (goto-char (point-min)) @@ -605,7 +611,7 @@ containing the properties `:guid' and `:item-full-text'." nil t) (setq entry (plist-put entry (intern (concat ":" (match-string 1))) - (match-string 2)))) + (xml-substitute-special (match-string 2))))) (goto-char (point-min)) (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t) (setq entry (plist-put entry :guid-permalink t)))) @@ -618,14 +624,15 @@ containing the properties `:guid' and `:item-full-text'. The `:item-full-text' property actually contains the sexp formatted as a string, not the original XML data." + (require 'xml) (with-current-buffer buffer (widen) (let ((feed (car (xml-parse-region (point-min) (point-max))))) (mapcar (lambda (entry) - (list - :guid (car (xml-node-children (car (xml-get-children entry 'id)))) - :item-full-text (prin1-to-string entry))) + (list + :guid (car (xml-node-children (car (xml-get-children entry 'id)))) + :item-full-text (prin1-to-string entry))) (xml-get-children feed 'entry))))) (defun org-feed-parse-atom-entry (entry) @@ -633,28 +640,36 @@ formatted as a string, not the original XML data." (let ((xml (car (read-from-string (plist-get entry :item-full-text))))) ;; Get first <link href='foo'/>. (setq entry (plist-put entry :link - (xml-get-attribute - (car (xml-get-children xml 'link)) - 'href))) + (xml-get-attribute + (car (xml-get-children xml 'link)) + 'href))) ;; Add <title/> as :title. (setq entry (plist-put entry :title - (car (xml-node-children - (car (xml-get-children xml 'title)))))) + (xml-substitute-special + (car (xml-node-children + (car (xml-get-children xml 'title))))))) (let* ((content (car (xml-get-children xml 'content))) - (type (xml-get-attribute-or-nil content 'type))) + (type (xml-get-attribute-or-nil content 'type))) (when content - (cond - ((string= type "text") - ;; We like plain text. - (setq entry (plist-put entry :description (car (xml-node-children content))))) - ((string= type "html") - ;; TODO: convert HTML to Org markup. - (setq entry (plist-put entry :description (car (xml-node-children content))))) - ((string= type "xhtml") - ;; TODO: convert XHTML to Org markup. - (setq entry (plist-put entry :description (prin1-to-string (xml-node-children content))))) - (t - (setq entry (plist-put entry :description (format "Unknown '%s' content." type))))))) + (cond + ((string= type "text") + ;; We like plain text. + (setq entry (plist-put entry :description + (xml-substitute-special + (car (xml-node-children content)))))) + ((string= type "html") + ;; TODO: convert HTML to Org markup. + (setq entry (plist-put entry :description + (xml-substitute-special + (car (xml-node-children content)))))) + ((string= type "xhtml") + ;; TODO: convert XHTML to Org markup. + (setq entry (plist-put entry :description + (prin1-to-string + (xml-node-children content))))) + (t + (setq entry (plist-put entry :description + (format "Unknown '%s' content." type))))))) entry)) (provide 'org-feed) diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index d606049336c..24ec581e75c 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -47,7 +47,9 @@ (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-in-verbatim-emphasis "org" ()) +(declare-function org-inside-latex-macro-p "org" ()) (defvar org-odd-levels-only) ;; defined in org.el +(defvar message-signature-separator) ;; defined in message.el (defconst org-footnote-re (concat "[^][\n]" ; to make sure it is not at the beginning of a line @@ -64,6 +66,11 @@ (org-re "^\\(\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]\\)") "Regular expression matching the definition of a footnote.") +(defgroup org-footnote nil + "Footnotes in Org-mode." + :tag "Org Footnote" + :group 'org) + (defcustom org-footnote-section "Footnotes" "Outline heading containing footnote definitions before export. This can be nil, to place footnotes locally at the end of the current @@ -74,7 +81,7 @@ automatically, i.e. when creating the footnote, and when sorting the notes. However, by hand you may place definitions *anywhere*. If this is a string, during export, all subtrees starting with this heading will be removed after extracting footnote definitions." - :group 'org-footnotes + :group 'org-footnote :type '(choice (string :tag "Collect footnotes under heading") (const :tag "Define footnotes locally" nil))) @@ -86,11 +93,11 @@ as in Org-mode. Outside Org-mode, new footnotes are always placed at the end of the file. When you normalize the notes, any line containing only this tag will be removed, a new one will be inserted at the end of the file, followed by the collected and normalized footnotes." - :group 'org-footnotes + :group 'org-footnote :type 'string) (defcustom org-footnote-define-inline nil - "Non-nil means, define footnotes inline, at reference location. + "Non-nil means define footnotes inline, at reference location. When nil, footnotes will be defined in a special section near the end of the document. When t, the [fn:label:definition] notation will be used to define the footnote at the reference position." @@ -98,7 +105,7 @@ will be used to define the footnote at the reference position." :type 'boolean) (defcustom org-footnote-auto-label t - "Non-nil means, define automatically new labels for footnotes. + "Non-nil means define automatically new labels for footnotes. Possible values are: nil prompt the user for each label @@ -115,7 +122,7 @@ plain Automatically create plain number labels like [1]" (const :tag "Create automatic [N]" plain))) (defcustom org-footnote-auto-adjust nil - "Non-nil means, automatically adjust footnotes after insert/delete. + "Non-nil means automatically adjust footnotes after insert/delete. When this is t, after each insertion or deletion of a footnote, simple fn:N footnotes will be renumbered, and all footnotes will be sorted. If you want to have just sorting or just renumbering, set this variable @@ -132,7 +139,7 @@ The main values of this variable can be set with in-buffer options: (const :tag "Renumber and Sort" t))) (defcustom org-footnote-fill-after-inline-note-extraction nil - "Non-nil means, fill paragraphs after extracting footnotes. + "Non-nil means fill paragraphs after extracting footnotes. When extracting inline footnotes, the lengths of lines can change a lot. When this option is set, paragraphs from which an inline footnote has been extracted will be filled again." @@ -181,25 +188,25 @@ with start and label of the footnote if there is a definition at point." (org-show-context 'link-search) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))) -(defun org-footnote-goto-next-reference (label) - "Find the definition of the footnote with label LABEL." +(defun org-footnote-goto-previous-reference (label) + "Find the first closest (to point) reference of footnote with label LABEL." (interactive "sLabel: ") (org-mark-ring-push) (setq label (org-footnote-normalize-label label)) (let ((re (format ".\\[%s[]:]" label)) (p0 (point)) pos) (save-excursion - (setq pos (or (re-search-forward re nil t) - (and (goto-char (point-min)) - (re-search-forward re nil t)) + (setq pos (or (re-search-backward re nil t) + (and (goto-char (point-max)) + (re-search-backward re nil t)) (and (progn (widen) t) (goto-char p0) - (re-search-forward re nil t)) - (and (goto-char (point-min)) + (re-search-backward re nil t)) + (and (goto-char (point-max)) (re-search-forward re nil t))))) (if pos (progn - (goto-char pos) + (goto-char (match-end 0)) (org-show-context 'link-search)) (error "Cannot find reference of footnote %s" label)))) @@ -296,15 +303,19 @@ or new, let the user edit the definition of the footnote." (t (setq re (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$")) (unless (re-search-forward re nil t) - (goto-char (point-max)) - (skip-chars-backward " \t\r\n") - (insert "\n\n") - (delete-region (point) (point-max)) - (insert org-footnote-tag-for-non-org-mode-files "\n")) - (goto-char (point-max)) - (skip-chars-backward " \t\r\n"))) - (insert "\n\n") - (insert "[" label "] ") + (let ((max (if (and (derived-mode-p 'message-mode) + (re-search-forward message-signature-separator nil t)) + (progn (beginning-of-line) (point)) + (goto-char (point-max))))) + (skip-chars-backward " \t\r\n") + (delete-region (point) max) + (insert "\n\n") + (insert org-footnote-tag-for-non-org-mode-files "\n"))))) + ;; Skip existing footnotes + (while (re-search-forward "^[[:space:]]*\\[[^]]+\\] " nil t) + (forward-line)) + (insert "[" label "] \n") + (goto-char (1- (point))) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))) ;;;###autoload @@ -338,7 +349,7 @@ With prefix arg SPECIAL, offer additional commands in a menu." (org-footnote-goto-definition (nth 1 tmp)) (goto-char (match-beginning 4)))) ((setq tmp (org-footnote-at-definition-p)) - (org-footnote-goto-next-reference (nth 1 tmp))) + (org-footnote-goto-previous-reference (nth 1 tmp))) (t (org-footnote-new))))) ;;;###autoload @@ -366,7 +377,8 @@ referenced sequence." ;; Now find footnote references, and extract the definitions (goto-char (point-min)) (while (re-search-forward org-footnote-re nil t) - (unless (or (org-in-commented-line) (org-in-verbatim-emphasis)) + (unless (or (org-in-commented-line) (org-in-verbatim-emphasis) + (org-inside-latex-macro-p)) (org-if-unprotected (setq def (match-string 4) idef def @@ -397,13 +409,13 @@ referenced sequence." (skip-chars-backward " \t\n\t") (delete-region (1+ (point)) (match-beginning 0)))))) (unless sort-only - (replace-match (concat before "[" marker "]")) + (replace-match (concat before "[" marker "]") t t) (and idef org-footnote-fill-after-inline-note-extraction (fill-paragraph))) (if (not a) (push (list ref marker def (if idef t nil)) ref-table))))) - + ;; First find and remove the footnote section (goto-char (point-min)) (cond @@ -499,7 +511,8 @@ ENTRY is (fn-label num-mark definition)." (beginning-of-line 0)) (if (looking-at "[ \t]*#\\+TBLFM:") (beginning-of-line 2)) (end-of-line 1) - (skip-chars-backward "\n\r\t ")) + (skip-chars-backward "\n\r\t ") + (forward-line)) (defun org-footnote-delete (&optional label) "Delete the footnote at point. diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el index dc3b8c2dd4b..8027eb505e8 100644 --- a/lisp/org/org-freemind.el +++ b/lisp/org/org-freemind.el @@ -5,7 +5,7 @@ ;; Author: Lennart Borgman (lennart O borgman A gmail O com) ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -81,30 +81,35 @@ (require 'xml) (require 'org) +;(require 'rx) (require 'org-exp) (eval-when-compile (require 'cl)) +(defgroup org-freemind nil + "Customization group for org-freemind export/import." + :group 'org) + ;; Fix-me: I am not sure these are useful: ;; ;; (defcustom org-freemind-main-fgcolor "black" ;; "Color of main node's text." ;; :type 'color -;; :group 'freemind) +;; :group 'org-freemind) ;; (defcustom org-freemind-main-color "black" ;; "Background color of main node." ;; :type 'color -;; :group 'freemind) +;; :group 'org-freemind) ;; (defcustom org-freemind-child-fgcolor "black" ;; "Color of child nodes' text." ;; :type 'color -;; :group 'freemind) +;; :group 'org-freemind) ;; (defcustom org-freemind-child-color "black" ;; "Background color of child nodes." ;; :type 'color -;; :group 'freemind) +;; :group 'org-freemind) (defvar org-freemind-node-style nil "Internal use.") @@ -151,11 +156,25 @@ NOT READY YET." (string :tag "Font name" :value "SansSerif")) (list :format "%v" (const :format "" font-size) (integer :tag "Font size" :value 12))))))) - :group 'freemind) + :group 'org-freemind) ;;;###autoload -(defun org-export-as-freemind (arg &optional hidden ext-plist +(defun org-export-as-freemind (&optional hidden ext-plist to-buffer body-only pub-dir) + "Export the current buffer as a Freemind file. +If there is an active region, export only the region. HIDDEN is +obsolete and does nothing. EXT-PLIST is a property list with +external parameters overriding org-mode's default settings, but +still inferior to file-local settings. When TO-BUFFER is +non-nil, create a buffer with that name and export to that +buffer. If TO-BUFFER is the symbol `string', don't leave any +buffer behind but just return the resulting HTML as a string. +When BODY-ONLY is set, don't produce the file header and footer, +simply return the content of the document (all top level +sections). When PUB-DIR is set, use this as the publishing +directory. + +See `org-freemind-from-org-mode' for more information." (interactive "P") (let* ((opt-plist (org-combine-plists (org-default-export-plist) ext-plist @@ -202,7 +221,20 @@ NOT READY YET." (let ((name (read-file-name "FreeMind file: " nil nil nil (if (buffer-file-name) - (file-name-nondirectory (buffer-file-name)) + (let* ((name-ext (file-name-nondirectory (buffer-file-name))) + (name (file-name-sans-extension name-ext)) + (ext (file-name-extension name-ext))) + (cond + ((string= "mm" ext) + name-ext) + ((string= "org" ext) + (let ((name-mm (concat name ".mm"))) + (if (file-exists-p name-mm) + name-mm + (message "Not exported to Freemind format yet") + ""))) + (t + ""))) "") ;; Fix-me: Is this an Emacs bug? ;; This predicate function is never @@ -226,7 +258,7 @@ The characters \"&<> will be escaped." (dolist (cc chars) (setq fm-str (concat fm-str - (if (< cc 256) + (if (< cc 160) (cond ((= cc ?\") """) ((= cc ?\&) "&") @@ -240,7 +272,7 @@ The characters \"&<> will be escaped." ;; file is utf-8: ;; ;; (format "&#x%x;" (- cc ;; ?\x800)) - (format "&#x%x" (encode-char cc 'ucs)) + (format "&#x%x;" (encode-char cc 'ucs)) )))) fm-str)) @@ -264,52 +296,84 @@ will also unescape &#nn;." ))) org-str)))) -;; (org-freemind-test-escape) -(defun org-freemind-test-escape () - (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: ") - (str2 (org-freemind-escape-str-from-org str1)) - (str3 (org-freemind-unescape-str-to-org str2)) +;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: ") +;; (str2 (org-freemind-escape-str-from-org str1)) +;; (str3 (org-freemind-unescape-str-to-org str2))) +;; (unless (string= str1 str3) +;; (error "Error str3=%s" str3))) + +(defun org-freemind-convert-links-helper (matched) + "Helper for `org-freemind-convert-links-from-org'. +MATCHED is the link just matched." + (let* ((link (match-string 1 matched)) + (text (match-string 2 matched)) + (ext (file-name-extension link)) + (col-pos (string-match-p ":" link)) + (is-img (and (image-type-from-file-name link) + (let ((url-type (substring link 0 col-pos))) + (member url-type '("file" "http" "https"))))) ) - (unless (string= str1 str3) - (error "str3=%s" str3)) - )) + (if is-img + ;; Fix-me: I can't find a way to get the border to "shrink + ;; wrap" around the image using <div>. + ;; + ;; (concat "<div style=\"border: solid 1px #ddd; width:auto;\">" + ;; "<img src=\"" link "\" alt=\"" text "\" />" + ;; "<br />" + ;; "<i>" text "</i>" + ;; "</div>") + (concat "<table border=\"0\" style=\"border: solid 1px #ddd;\"><tr><td>" + "<img src=\"" link "\" alt=\"" text "\" />" + "<br />" + "<i>" text "</i>" + "</td></tr></table>") + (concat "<a href=\"" link "\">" text "</a>")))) (defun org-freemind-convert-links-from-org (org-str) "Convert org links in ORG-STR to freemind links and return the result." (let ((fm-str (replace-regexp-in-string - (rx (not (any "[\"")) - (submatch - "http" - (opt ?\s) - "://" - (1+ - (any "-%.?@a-zA-Z0-9()_/:~=&#")))) + ;;(rx (not (any "[\"")) + ;; (submatch + ;; "http" + ;; (opt ?\s) + ;; "://" + ;; (1+ + ;; (any "-%.?@a-zA-Z0-9()_/:~=&#")))) + "[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)" "[[\\1][\\1]]" - org-str))) - (replace-regexp-in-string (rx "[[" - (submatch (*? nonl)) - "][" - (submatch (*? nonl)) - "]]") - "<a href=\"\\1\">\\2</a>" - fm-str))) + org-str + nil ;; fixedcase + nil ;; literal + 1 ;; subexp + ))) + (replace-regexp-in-string + ;;(rx "[[" + ;; (submatch (*? nonl)) + ;; "][" + ;; (submatch (*? nonl)) + ;; "]]") + "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]" + ;;"<a href=\"\\1\">\\2</a>" + 'org-freemind-convert-links-helper + fm-str))) ;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>") (defun org-freemind-convert-links-to-org (fm-str) "Convert freemind links in FM-STR to org links and return the result." (let ((org-str (replace-regexp-in-string - (rx "<a" - space - (0+ - (0+ (not (any ">"))) - space) - "href=\"" - (submatch (0+ (not (any "\"")))) - "\"" - (0+ (not (any ">"))) - ">" - (submatch (0+ (not (any "<")))) - "</a>") + ;;(rx "<a" + ;; space + ;; (0+ + ;; (0+ (not (any ">"))) + ;; space) + ;; "href=\"" + ;; (submatch (0+ (not (any "\"")))) + ;; "\"" + ;; (0+ (not (any ">"))) + ;; ">" + ;; (submatch (0+ (not (any "<")))) + ;; "</a>") + "<a[[:space:]]\\(?:[^>]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)</a>" "[[\\1][\\2]]" fm-str))) org-str)) @@ -318,29 +382,60 @@ will also unescape &#nn;." ;;(defun org-freemind-convert-drawers-from-org (text) ;; ) -;; (org-freemind-test-links) -;; (defun org-freemind-test-links () ;; (let* ((str1 "[[http://www.somewhere/][link-text]") ;; (str2 (org-freemind-convert-links-from-org str1)) -;; (str3 (org-freemind-convert-links-to-org str2)) -;; ) +;; (str3 (org-freemind-convert-links-to-org str2))) ;; (unless (string= str1 str3) -;; (error "str3=%s" str3)) -;; )) +;; (error "Error str3=%s" str3))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Org => FreeMind +(defvar org-freemind-bol-helper-base-indent nil) + +(defun org-freemind-bol-helper (matched) + "Helper for `org-freemind-convert-text-p'. +MATCHED is the link just matched." + (let ((res "") + (bi org-freemind-bol-helper-base-indent)) + (dolist (cc (append matched nil)) + (if (= 32 cc) + ;;(setq res (concat res " ")) + ;; We need to use the numerical version. Otherwise Freemind + ;; ver 0.9.0 RC9 can not export to html/javascript. + (progn + (if (< 0 bi) + (setq bi (1- bi)) + (setq res (concat res " ")))) + (setq res (concat res (char-to-string cc))))) + res)) +;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n ")) + (defun org-freemind-convert-text-p (text) "Convert TEXT to html with <p> paragraphs." + ;; (string-match-p "[^ ]" " a") + (setq org-freemind-bol-helper-base-indent (string-match-p "[^ ]" text)) (setq text (org-freemind-escape-str-from-org text)) - (setq text (replace-regexp-in-string (rx "\n" (0+ blank) "\n") "</p><p>\n" text)) - ;;(setq text (replace-regexp-in-string (rx bol (1+ blank) eol) "" text)) - ;;(setq text (replace-regexp-in-string (rx bol (1+ blank)) "<br />" text)) + + (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text)) + (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1<b>\\3</b>\\5" text)) + + (setq text (concat "<p>" text)) + (setq text (replace-regexp-in-string "\n[[:blank:]]*\n" "</p><p>" text)) + (setq text (replace-regexp-in-string "\\(?:<p>\\|\n\\) +" 'org-freemind-bol-helper text)) (setq text (replace-regexp-in-string "\n" "<br />" text)) - (concat "<p>" - (org-freemind-convert-links-from-org text) - "</p>\n")) + (setq text (concat text "</p>")) + + (org-freemind-convert-links-from-org text)) + +(defcustom org-freemind-node-css-style + "p { margin-top: 3px; margin-bottom: 3px; }" + "CSS style for Freemind nodes." + ;; Fix-me: I do not understand this. It worked to export from Freemind + ;; with this setting now, but not before??? Was this perhaps a java + ;; bug or is it a windows xp bug (some resource gets exhausted if you + ;; use sticky keys which I do). + :group 'org-freemind) (defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp) "Convert text part of org node to freemind subnode or note. @@ -389,11 +484,14 @@ DRAWERS-REGEXP are converted to freemind notes." "<node style=\"bubble\" background_color=\"#eeee00\">\n" "<richcontent TYPE=\"NODE\"><html>\n" "<head>\n" + (if (= 0 (length org-freemind-node-css-style)) + "" + (concat "<style type=\"text/css\">\n" "<!--\n" - "p { margin-top: 0 }\n" + org-freemind-node-css-style "-->\n" - "</style>\n" + "</style>\n")) "</head>\n" "<body>\n")) (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML")) @@ -426,21 +524,28 @@ DRAWERS-REGEXP are converted to freemind notes." "</html>\n" "</richcontent>\n" ;; Put a note that this is for the parent node - "<richcontent TYPE=\"NOTE\"><html>" - "<head>" - "</head>" - "<body>" - "<p>" - "-- This is more about \"" node-name "\" --" - "</p>" - "</body>" - "</html>" - "</richcontent>\n" + ;; "<richcontent TYPE=\"NOTE\"><html>" + ;; "<head>" + ;; "</head>" + ;; "<body>" + ;; "<p>" + ;; "-- This is more about \"" node-name "\" --" + ;; "</p>" + ;; "</body>" + ;; "</html>" + ;; "</richcontent>\n" + note-res "</node>\n" ;; ok ))) (list node-res note-res)))) -(defun org-freemind-write-node (mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child) +(defun org-freemind-write-node (mm-buffer drawers-regexp + num-left-nodes base-level + current-level next-level this-m2 + this-node-end + this-children-visible + next-node-start + next-has-some-visible-child) (let* (this-icons this-bg-color this-m2-escaped @@ -502,7 +607,7 @@ DRAWERS-REGEXP are converted to freemind notes." (insert "<icon builtin=\"" icon "\"/>\n"))) ) (with-current-buffer mm-buffer - (when this-rich-note (insert this-rich-note)) + ;;(when this-rich-note (insert this-rich-note)) (when this-rich-node (insert this-rich-node)))) num-left-nodes) @@ -520,11 +625,13 @@ Otherwise give an error say the file exists." (error "File %s already exists" file)) t)) -(defvar org-freemind-node-pattern (rx bol - (submatch (1+ "*")) - (1+ space) - (submatch (*? nonl)) - eol)) +(defvar org-freemind-node-pattern + ;;(rx bol + ;; (submatch (1+ "*")) + ;; (1+ space) + ;; (submatch (*? nonl)) + ;; eol) + "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$") (defun org-freemind-look-for-visible-child (node-level) (save-excursion @@ -561,11 +668,10 @@ Otherwise give an error say the file exists." (num-top2-nodes 0) num-left-nodes (unclosed-nodes 0) + (odd-only org-odd-levels-only) (first-time t) (current-level 1) base-level - skipping-odd - (skipped-odd 0) prev-node-end rich-text unfinished-tag @@ -573,27 +679,31 @@ Otherwise give an error say the file exists." node-at-line-last) (with-current-buffer mm-buffer (erase-buffer) - (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n") + (setq buffer-file-coding-system 'utf-8) + ;; Fix-me: Currentl Freemind (ver 0.9.0 RC9) does not support this: + ;;(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n") (insert "<map version=\"0.9.0\">\n") (insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n")) (save-excursion ;; Get special buffer vars: (goto-char (point-min)) - (while (re-search-forward (rx bol "#+DRAWERS:") nil t) + (message "Writing Freemind file...") + (while (re-search-forward "^#\\+DRAWERS:" nil t) (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position)))) (setq drawers (append drawers (split-string dr-txt) nil)))) (setq drawers-regexp - (concat (rx bol (0+ blank) ":") + (concat "^[[:blank:]]*:" (regexp-opt drawers) - (rx ":" (0+ blank) - "\n" - (*? anything) - "\n" - (0+ blank) - ":END:" - (0+ blank) - eol) - )) + ;;(rx ":" (0+ blank) + ;; "\n" + ;; (*? anything) + ;; "\n" + ;; (0+ blank) + ;; ":END:" + ;; (0+ blank) + ;; eol) + ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$" + )) (if node-at-line ;; Get number of top nodes and last line for this node @@ -671,21 +781,6 @@ Otherwise give an error say the file exists." (setq next-node-start (match-beginning 0)) (setq next-m2 (match-string-no-properties 2)) (setq next-level (length next-m1)) - (when (> next-level current-level) - (if (not (and org-odd-levels-only - (/= (mod current-level 2) 0) - (= next-level (+ 2 current-level)))) - (setq skipping-odd nil) - (setq skipping-odd t) - (setq skipped-odd (1+ skipped-odd))) - (unless (or (= next-level (1+ current-level)) - skipping-odd) - (if (or org-odd-levels-only - (/= next-level (+ 2 current-level))) - (error "Next level step > +1 for node ending at line %s" (line-number-at-pos)) - (error "Next level step = +2 for node ending at line %s, forgot org-odd-levels-only?" - (line-number-at-pos))) - )) (setq next-children-visible (not (eq 'outline (get-char-property (line-end-position) 'invisible)))) @@ -698,11 +793,8 @@ Otherwise give an error say the file exists." (while (>= current-level next-level) (with-current-buffer mm-buffer (insert "</node>\n") - (setq current-level (1- current-level)) - (when (< 0 skipped-odd) - (setq skipped-odd (1- skipped-odd)) - (setq current-level (1- current-level))) - ))) + (setq current-level + (- current-level (if odd-only 2 1)))))) (setq this-node-end (1+ next-node-end)) (setq this-m2 next-m2) (setq current-level next-level) @@ -725,7 +817,8 @@ Otherwise give an error say the file exists." (with-current-buffer mm-buffer (while (> current-level base-level) (insert "</node>\n") - (setq current-level (1- current-level)) + (setq current-level + (- current-level (if odd-only 2 1))) )) (with-current-buffer mm-buffer (insert "</map>") @@ -812,7 +905,8 @@ Otherwise give an error say the file exists." ;;;###autoload (defun org-freemind-from-org-mode-node (node-line mm-file) - "Convert node at line NODE-LINE to the FreeMind file MM-FILE." + "Convert node at line NODE-LINE to the FreeMind file MM-FILE. +See `org-freemind-from-org-mode' for more information." (interactive (progn (unless (org-back-to-heading nil) @@ -825,20 +919,29 @@ Otherwise give an error say the file exists." ".mm")) (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file))) (list line mm-file)))) - (when (org-freemind-check-overwrite mm-file (called-interactively-p 'any)) + (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any)) (let ((org-buffer (current-buffer)) (mm-buffer (find-file-noselect mm-file))) (org-freemind-write-mm-buffer org-buffer mm-buffer node-line) (with-current-buffer mm-buffer (basic-save-buffer) - (when (called-interactively-p 'any) + (when (org-called-interactively-p 'any) (switch-to-buffer-other-window mm-buffer) (when (y-or-n-p "Show in FreeMind? ") (org-freemind-show buffer-file-name))))))) ;;;###autoload (defun org-freemind-from-org-mode (org-file mm-file) - "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE." + "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE. +All the nodes will be opened or closed in Freemind just as you +have them in `org-mode'. + +Note that exporting to Freemind also gives you an alternative way +to export from `org-mode' to html. You can create a dynamic html +version of the your org file, by first exporting to Freemind and +then exporting from Freemind to html. The 'As +XHTML (JavaScript)' version in Freemind works very well \(and you +can use a CSS stylesheet to style it)." ;; Fix-me: better doc, include recommendations etc. (interactive (let* ((org-file buffer-file-name) @@ -849,13 +952,13 @@ Otherwise give an error say the file exists." ".mm")) (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file))) (list org-file mm-file))) - (when (org-freemind-check-overwrite mm-file (called-interactively-p 'any)) + (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any)) (let ((org-buffer (if org-file (find-file-noselect org-file) (current-buffer))) (mm-buffer (find-file-noselect mm-file))) (org-freemind-write-mm-buffer org-buffer mm-buffer nil) (with-current-buffer mm-buffer (basic-save-buffer) - (when (called-interactively-p 'any) + (when (org-called-interactively-p 'any) (switch-to-buffer-other-window mm-buffer) (when (y-or-n-p "Show in FreeMind? ") (org-freemind-show buffer-file-name))))))) @@ -872,7 +975,7 @@ Otherwise give an error say the file exists." "-sparse.mm")) (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file))) (list (current-buffer) mm-file))) - (when (org-freemind-check-overwrite mm-file (called-interactively-p 'any)) + (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any)) (let (org-buffer (mm-buffer (find-file-noselect mm-file))) (save-window-excursion @@ -881,7 +984,7 @@ Otherwise give an error say the file exists." (org-freemind-write-mm-buffer org-buffer mm-buffer nil) (with-current-buffer mm-buffer (basic-save-buffer) - (when (called-interactively-p 'any) + (when (org-called-interactively-p 'any) (switch-to-buffer-other-window mm-buffer) (when (y-or-n-p "Show in FreeMind? ") (org-freemind-show buffer-file-name))))))) @@ -1036,7 +1139,7 @@ PATH should be a list of steps, where each step has the form (save-match-data (let* ((rc (org-freemind-get-richcontent-node node)) (txt (org-freemind-get-tree-text rc))) - ;;(when txt (setq txt (replace-regexp-in-string (rx (1+ whitespace)) " " txt))) + ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt))) txt ))) @@ -1045,7 +1148,7 @@ PATH should be a list of steps, where each step has the form (save-match-data (let* ((rc (org-freemind-get-richcontent-note node)) (txt (when rc (org-freemind-get-tree-text rc)))) - ;;(when txt (setq txt (replace-regexp-in-string (rx (1+ whitespace)) " " txt))) + ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt))) txt ))) @@ -1061,6 +1164,7 @@ PATH should be a list of steps, where each step has the form (let ((qname (car node)) (attributes (cadr node)) text + ;; Fix-me: note is never inserted (note (org-freemind-get-richcontent-note-text node)) (mark "-- This is more about ") (icons (org-freemind-get-icon-names node)) @@ -1091,6 +1195,8 @@ PATH should be a list of steps, where each step has the form (case qname ('node (insert (make-string (- level skip-levels) ?*) " " text "\n") + (when note + (insert ":COMMENT:\n" note "\n:END:\n")) )))) (dolist (child children) (unless (or (null child) @@ -1108,7 +1214,7 @@ PATH should be a list of steps, where each step has the form (default-org-file (concat (file-name-nondirectory mm-file) ".org")) (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file))) (list mm-file org-file)))) - (when (org-freemind-check-overwrite org-file (called-interactively-p 'any)) + (when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any)) (let ((mm-buffer (find-file-noselect mm-file)) (org-buffer (find-file-noselect org-file))) (with-current-buffer mm-buffer @@ -1117,7 +1223,7 @@ PATH should be a list of steps, where each step has the form (note (org-freemind-get-richcontent-note-text top-node)) (skip-levels (if (and note - (string-match (rx bol "--org-mode: WHOLE FILE" eol) note)) + (string-match "^--org-mode: WHOLE FILE$" note)) 1 0))) (with-current-buffer org-buffer diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index da640cfa05a..7a449c793f0 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -7,7 +7,7 @@ ;; Tassilo Horn <tassilo at member dot fsf dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -39,22 +39,33 @@ ;; Declare external functions and variables (declare-function message-fetch-field "message" (header &optional not-all)) (declare-function message-narrow-to-head-1 "message" nil) +(declare-function nnimap-group-overview-filename "nnimap" (group server)) ;; The following line suppresses a compiler warning stemming from gnus-sum.el (declare-function gnus-summary-last-subject "gnus-sum" nil) - ;; Customization variables (when (fboundp 'defvaralias) (defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)) (defcustom org-gnus-prefer-web-links nil - "Non-nil means, `org-store-link' will create web links to Google groups. + "If non-nil, `org-store-link' creates web links to Google groups or Gmane. When nil, Gnus will be used for such links. Using a prefix arg to the command \\[org-store-link] (`org-store-link') negates this setting for the duration of the command." :group 'org-link-store :type 'boolean) +(defcustom org-gnus-nnimap-query-article-no-from-file nil + "If non-nil, `org-gnus-follow-link' will try to translate +Message-Ids to article numbers by querying the .overview file. +Normally, this translation is done by querying the IMAP server, +which is usually very fast. Unfortunately, some (maybe badly +configured) IMAP servers don't support this operation quickly. +So if following a link to a Gnus article takes ages, try setting +this variable to `t'." + :group 'org-link-store + :type 'boolean) + ;; Install the link type (org-add-link-type "gnus" 'org-gnus-open) @@ -62,6 +73,22 @@ negates this setting for the duration of the command." ;; Implementation +(defun org-gnus-nnimap-cached-article-number (group server message-id) + "Return cached article number (uid) of message in GROUP on SERVER. +MESSAGE-ID is the message-id header field that identifies the +message. If the uid is not cached, return nil." + (with-temp-buffer + (let ((nov (nnimap-group-overview-filename group server))) + (when (file-exists-p nov) + (mm-insert-file-contents nov) + (set-buffer-modified-p nil) + (goto-char (point-min)) + (catch 'found + (while (search-forward message-id nil t) + (let ((hdr (split-string (thing-at-point 'line) "\t"))) + (if (string= (nth 4 hdr) message-id) + (throw 'found (nth 0 hdr)))))))))) + (defun org-gnus-group-link (group) "Create a link to the Gnus group GROUP. If GROUP is a newsgroup and `org-gnus-prefer-web-links' is @@ -120,30 +147,52 @@ If `org-store-link' was called with a prefix arg the meaning of ((memq major-mode '(gnus-summary-mode gnus-article-mode)) (let* ((group gnus-newsgroup-name) - (header (with-current-buffer gnus-summary-buffer + (header (with-current-buffer gnus-summary-buffer (gnus-summary-article-header))) (from (mail-header-from header)) (message-id (org-remove-angle-brackets (mail-header-id header))) (date (mail-header-date header)) - (subject (mail-header-subject header)) - (to (cdr (assq 'To (mail-header-extra header)))) - newsgroups x-no-archive desc link) + (date-ts (and date (format-time-string + (org-time-stamp-format t) (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) + (subject (copy-sequence (mail-header-subject header))) + (to (cdr (assq 'To (mail-header-extra header)))) + newsgroups x-no-archive desc link) + ;; Remove text properties of subject string to avoid Emacs bug + ;; #3506 + (set-text-properties 0 (length subject) nil subject) + ;; Fetching an article is an expensive operation; newsgroup and ;; x-no-archive are only needed for web links. (when (org-xor current-prefix-arg org-gnus-prefer-web-links) - ;; Make sure the original article buffer is up-to-date - (save-window-excursion (gnus-summary-select-article)) - (setq to (or to (gnus-fetch-original-field "To")) - newsgroups (gnus-fetch-original-field "Newsgroups") - x-no-archive (gnus-fetch-original-field "x-no-archive"))) - (org-store-link-props :type "gnus" :from from :subject subject + ;; Make sure the original article buffer is up-to-date + (save-window-excursion (gnus-summary-select-article)) + (setq to (or to (gnus-fetch-original-field "To")) + newsgroups (gnus-fetch-original-field "Newsgroups") + x-no-archive (gnus-fetch-original-field "x-no-archive"))) + (org-store-link-props :type "gnus" :from from :subject subject :message-id message-id :group group :to to) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (setq desc (org-email-link-description) link (org-gnus-article-link group newsgroups message-id x-no-archive)) (org-add-link-props :link link :description desc) link)))) +(defun org-gnus-open-nntp (path) + "Follow the nntp: link specified by PATH." + (let* ((spec (split-string path "/")) + (server (split-string (nth 2 spec) "@")) + (group (nth 3 spec)) + (article (nth 4 spec))) + (org-gnus-follow-link + (format "nntp+%s:%s" (or (cdr server) (car server)) group) + article))) + (defun org-gnus-open (path) "Follow the Gnus message or folder link specified by PATH." (let (group article) @@ -169,19 +218,36 @@ If `org-store-link' was called with a prefix arg the meaning of (cond ((and group article) (gnus-activate-group group t) (condition-case nil - (let ((articles 1) - group-opened) - (while (and (not group-opened) - ;; stop on integer overflows - (> articles 0)) - (setq group-opened (gnus-group-read-group articles nil group) - articles (if (< articles 16) - (1+ articles) - (* articles 2)))) - (if group-opened - (gnus-summary-goto-article article nil t) - (message "Couldn't follow gnus link. %s" - "The summary couldn't be opened."))) + (let* ((method (gnus-find-method-for-group group)) + (backend (car method)) + (server (cadr method))) + (cond + ((eq backend 'nndoc) + (if (gnus-group-read-group t nil group) + (gnus-summary-goto-article article nil t) + (message "Couldn't follow gnus link. %s" + "The summary couldn't be opened."))) + (t + (let ((articles 1) + group-opened) + (when (and (eq backend 'nnimap) + org-gnus-nnimap-query-article-no-from-file) + (setq article + (or (org-gnus-nnimap-cached-article-number + (nth 1 (split-string group ":")) + server (concat "<" article ">")) article))) + (while (and (not group-opened) + ;; stop on integer overflows + (> articles 0)) + (setq group-opened (gnus-group-read-group + articles nil group) + articles (if (< articles 16) + (1+ articles) + (* articles 2)))) + (if group-opened + (gnus-summary-goto-article article nil t) + (message "Couldn't follow gnus link. %s" + "The summary couldn't be opened.")))))) (quit (message "Couldn't follow gnus link. %s" "The linked group is empty.")))) (group (gnus-group-jump-to-group group)))) diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index dd1bacdea71..ec58b746d68 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -5,7 +5,7 @@ ;; Author: John Wiegley <johnw at gnu dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -27,11 +27,13 @@ ;; This file contains the habit tracking code for Org-mode +;;; Code: + (require 'org) (require 'org-agenda) + (eval-when-compile - (require 'cl) - (require 'calendar)) + (require 'cl)) (defgroup org-habit nil "Options concerning habit tracking in Org-mode." @@ -67,52 +69,52 @@ relative to the current effective date." :type 'boolean) (defface org-habit-clear-face - '((((background light)) (:background "slateblue")) + '((((background light)) (:background "#8270f9")) (((background dark)) (:background "blue"))) "Face for days on which a task shouldn't be done yet." :group 'org-habit :group 'org-faces) (defface org-habit-clear-future-face - '((((background light)) (:background "powderblue")) + '((((background light)) (:background "#d6e4fc")) (((background dark)) (:background "midnightblue"))) "Face for future days on which a task shouldn't be done yet." :group 'org-habit :group 'org-faces) (defface org-habit-ready-face - '((((background light)) (:background "green")) + '((((background light)) (:background "#4df946")) (((background dark)) (:background "forestgreen"))) "Face for days on which a task should start to be done." :group 'org-habit :group 'org-faces) (defface org-habit-ready-future-face - '((((background light)) (:background "palegreen")) + '((((background light)) (:background "#acfca9")) (((background dark)) (:background "darkgreen"))) "Face for days on which a task should start to be done." :group 'org-habit :group 'org-faces) (defface org-habit-alert-face - '((((background light)) (:background "yellow")) + '((((background light)) (:background "#f5f946")) (((background dark)) (:background "gold"))) "Face for days on which a task is due." :group 'org-habit :group 'org-faces) (defface org-habit-alert-future-face - '((((background light)) (:background "palegoldenrod")) + '((((background light)) (:background "#fafca9")) (((background dark)) (:background "darkgoldenrod"))) "Face for days on which a task is due." :group 'org-habit :group 'org-faces) (defface org-habit-overdue-face - '((((background light)) (:background "red")) + '((((background light)) (:background "#f9372d")) (((background dark)) (:background "firebrick"))) "Face for days on which a task is overdue." :group 'org-habit :group 'org-faces) (defface org-habit-overdue-future-face - '((((background light)) (:background "mistyrose")) + '((((background light)) (:background "#fc9590")) (((background dark)) (:background "darkred"))) "Face for days on which a task is overdue." :group 'org-habit @@ -147,15 +149,17 @@ This list represents a \"habit\" for the rest of this module." (assert (org-is-habit-p (point))) (let* ((scheduled (org-get-scheduled-time (point))) (scheduled-repeat (org-get-repeat org-scheduled-string)) - (sr-days (org-habit-duration-to-days scheduled-repeat)) (end (org-entry-end-position)) - (habit-entry (org-no-properties (nth 5 (org-heading-components)))) - closed-dates deadline dr-days) + (habit-entry (org-no-properties (nth 4 (org-heading-components)))) + closed-dates deadline dr-days sr-days) (if scheduled (setq scheduled (time-to-days scheduled)) (error "Habit %s has no scheduled date" habit-entry)) (unless scheduled-repeat - (error "Habit %s has no scheduled repeat period" habit-entry)) + (error + "Habit '%s' has no scheduled repeat period or has an incorrect one" + habit-entry)) + (setq sr-days (org-habit-duration-to-days scheduled-repeat)) (unless (> sr-days 0) (error "Habit %s scheduled repeat period is less than 1d" habit-entry)) (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat) @@ -179,8 +183,10 @@ This list represents a \"habit\" for the rest of this module." (defsubst org-habit-deadline (habit) (let ((deadline (nth 2 habit))) (or deadline - (+ (org-habit-scheduled habit) - (1- (org-habit-scheduled-repeat habit)))))) + (if (nth 3 habit) + (+ (org-habit-scheduled habit) + (1- (org-habit-scheduled-repeat habit))) + (org-habit-scheduled habit))))) (defsubst org-habit-deadline-repeat (habit) (or (nth 3 habit) (org-habit-scheduled-repeat habit))) @@ -191,10 +197,7 @@ This list represents a \"habit\" for the rest of this module." "Determine the relative priority of a habit. This must take into account not just urgency, but consistency as well." (let ((pri 1000) - (now (time-to-days - (or moment - (time-subtract (current-time) - (list 0 (* 3600 org-extend-today-until) 0))))) + (now (if moment (time-to-days moment) (org-today))) (scheduled (org-habit-scheduled habit)) (deadline (org-habit-deadline habit))) ;; add 10 for every day past the scheduled date, and subtract for every @@ -281,9 +284,16 @@ current time." donep))) markedp face) (if donep - (progn + (let ((done-time (time-add + starting + (days-to-time + (- start (time-to-days starting)))))) + (aset graph index ?*) (setq markedp t) + (put-text-property + index (1+ index) 'help-echo + (format-time-string (org-time-stamp-format) done-time) graph) (while (and done-dates (= start (car done-dates))) (setq last-done-date (car done-dates) @@ -305,6 +315,7 @@ current time." (defun org-habit-insert-consistency-graphs (&optional line) "Insert consistency graph for any habitual tasks." (let ((inhibit-read-only t) l c + (buffer-invisibility-spec '(org-link)) (moment (time-subtract (current-time) (list 0 (* 3600 org-extend-today-until) 0)))) (save-excursion diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el index 85fb0c8d798..8be5709e1de 100644 --- a/lisp/org/org-html.el +++ b/lisp/org/org-html.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -26,7 +26,10 @@ ;; ;;; Commentary: +;;; Code: + (require 'org-exp) + (eval-when-compile (require 'cl)) (declare-function org-id-find-id-file "org-id" (id)) @@ -57,7 +60,7 @@ by the footnotes themselves." :type 'string) (defcustom org-export-html-coding-system nil - "Coding system for HTML export, defaults to buffer-file-coding-system." + "Coding system for HTML export, defaults to `buffer-file-coding-system'." :group 'org-export-html :type 'coding-system) @@ -81,7 +84,7 @@ and corresponding declarations." (string :tag "Declaration"))))) (defcustom org-export-html-style-include-scripts t - "Non-nil means, include the javascript snippets in exported HTML files. + "Non-nil means include the JavaScript snippets in exported HTML files. The actual script is defined in `org-export-html-scripts' and should not be modified." :group 'org-export-html @@ -110,7 +113,7 @@ not be modified." } /*]]>*///--> </script>" -"Basic javascript that is needed by HTML files produced by Org-mode.") +"Basic JavaScript that is needed by HTML files produced by Org-mode.") (defconst org-export-html-style-default "<style type=\"text/css\"> @@ -123,6 +126,9 @@ not be modified." .target { } .timestamp { color: #bebebe; } .timestamp-kwd { color: #5f9ea0; } + .right {margin-left:auto; margin-right:0px; text-align:right;} + .left {margin-left:0px; margin-right:auto; text-align:left;} + .center {margin-left:auto; margin-right:auto; text-align:center;} p.verse { margin-left: 3% } pre { border: 1pt solid #AEBDCC; @@ -133,10 +139,17 @@ not be modified." overflow:auto; } table { border-collapse: collapse; } - td, th { vertical-align: top; } + td, th { vertical-align: top; } + th.right { text-align:center; } + th.left { text-align:center; } + th.center { text-align:center; } + td.right { text-align:right; } + td.left { text-align:left; } + td.center { text-align:center; } dt { font-weight: bold; } div.figure { padding: 0.5em; } div.figure p { text-align: center; } + textarea { overflow-x: auto; } .linenr { font-size:smaller } .code-highlighted {background-color:#ffff00;} .org-info-js_info-navigation { border-style:none; } @@ -153,7 +166,7 @@ have the default style included, customize the variable `org-export-html-style-include-default'.") (defcustom org-export-html-style-include-default t - "Non-nil means, include the default style in exported HTML files. + "Non-nil means include the default style in exported HTML files. The actual style is defined in `org-export-html-style-default' and should not be modified. Use the variables `org-export-html-style' to add your own style information." @@ -205,21 +218,127 @@ settings with <style>...</style> tags." ;;;###autoload (put 'org-export-html-style-extra 'safe-local-variable 'stringp) +(defcustom org-export-html-mathjax-options + '((path "http://orgmode.org/mathjax/MathJax.js") + (scale "100") + (align "center") + (indent "2em") + (mathml nil)) + "Options for MathJax setup. + +path The path where to find MathJax +scale Scaling for the HTML-CSS backend, usually between 100 and 133 +align How to align display math: left, center, or right +indent If align is not center, how far from the left/right side? +mathml Should a MathML player be used if available? + This is faster and reduces bandwidth use, but currently + sometimes has lower spacing quality. Therefore, the default is + nil. When browsers get better, this switch can be flipped. + +You can also customize this for each buffer, using something like + +#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" + :group 'org-export-html + :type '(list :greedy t + (list :tag "path (the path from where to load MathJax.js)" + (const :format " " path) (string)) + (list :tag "scale (scaling for the displayed math)" + (const :format " " scale) (string)) + (list :tag "align (alignment of displayed equations)" + (const :format " " align) (string)) + (list :tag "indent (indentation with left or right alignment)" + (const :format " " indent) (string)) + (list :tag "mathml (should MathML display be used is possible)" + (const :format " " mathml) (boolean)))) + +(defun org-export-html-mathjax-config (template options in-buffer) + "Insert the user setup into the matchjax template." + (let (name val (yes " ") (no "// ") x) + (mapc + (lambda (e) + (setq name (car e) val (nth 1 e)) + (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) + (setq val (car (read-from-string + (substring in-buffer (match-end 0)))))) + (if (not (stringp val)) (setq val (format "%s" val))) + (if (string-match (concat "%" (upcase (symbol-name name))) template) + (setq template (replace-match val t t template)))) + options) + (setq val (nth 1 (assq 'mathml options))) + (if (string-match (concat "\\<mathml:") in-buffer) + (setq val (car (read-from-string + (substring in-buffer (match-end 0)))))) + ;; Exchange prefixes depending on mathml setting + (if (not val) (setq x yes yes no no x)) + ;; Replace cookies to turn on or off the config/jax lines + (if (string-match ":MMLYES:" template) + (setq template (replace-match yes t t template))) + (if (string-match ":MMLNO:" template) + (setq template (replace-match no t t template))) + ;; Return the modified template + template)) + +(defcustom org-export-html-mathjax-template + "<script type=\"text/javascript\" src=\"%PATH\"> +<!--/*--><![CDATA[/*><!--*/ + MathJax.Hub.Config({ + // Only one of the two following lines, depending on user settings + // First allows browser-native MathML display, second forces HTML/CSS + :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"], + :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"], + extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\", + \"TeX/noUndefined.js\"], + tex2jax: { + inlineMath: [ [\"\\\\(\",\"\\\\)\"] ], + displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"] ], + skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"], + ignoreClass: \"tex2jax_ignore\", + processEscapes: false, + processEnvironments: true, + preview: \"TeX\" + }, + showProcessingMessages: true, + displayAlign: \"%ALIGN\", + displayIndent: \"%INDENT\", + + \"HTML-CSS\": { + scale: %SCALE, + availableFonts: [\"STIX\",\"TeX\"], + preferredFont: \"TeX\", + webFont: \"TeX\", + imageFont: \"TeX\", + showMathMenu: true, + }, + MMLorHTML: { + prefer: { + MSIE: \"MML\", + Firefox: \"MML\", + Opera: \"HTML\", + other: \"HTML\" + } + } + }); +/*]]>*///--> +</script>" + "The MathJax setup for XHTML files." + :group 'org-export-html + :type 'string) + (defcustom org-export-html-tag-class-prefix "" - "Prefix to clas names for TODO keywords. + "Prefix to class names for TODO keywords. Each tag gets a class given by the tag itself, with this prefix. The default prefix is empty because it is nice to just use the keyword as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefic can be very useful." +CSS classes, then this prefix can be very useful." :group 'org-export-html :type 'string) (defcustom org-export-html-todo-kwd-class-prefix "" - "Prefix to clas names for TODO keywords. + "Prefix to class names for TODO keywords. Each TODO keyword gets a class given by the keyword itself, with this prefix. The default prefix is empty because it is nice to just use the keyword as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefic can be very useful." +CSS classes, then this prefix can be very useful." :group 'org-export-html :type 'string) @@ -234,10 +353,11 @@ CSS classes, then this prefic can be very useful." | <a accesskey=\"H\" href=\"%s\"> HOME </a> </div>" - "Snippet used to insert the HOME and UP links. This is a format, -the first %s will receive the UP link, the second the HOME link. -If both `org-export-html-link-up' and `org-export-html-link-home' are -empty, the entire snippet will be ignored." + "Snippet used to insert the HOME and UP links. +This is a format string, the first %s will receive the UP link, +the second the HOME link. If both `org-export-html-link-up' and +`org-export-html-link-home' are empty, the entire snippet will be +ignored." :group 'org-export-html :type 'string) @@ -253,7 +373,7 @@ document title." :type 'string) (defcustom org-export-html-link-org-files-as-html t - "Non-nil means, make file links to `file.org' point to `file.html'. + "Non-nil means make file links to `file.org' point to `file.html'. When org-mode is exporting an org-mode file to HTML, links to non-html files are directly put into a href tag in HTML. However, links to other Org-mode files (recognized by the @@ -265,7 +385,7 @@ When nil, the links still point to the plain `.org' file." :type 'boolean) (defcustom org-export-html-inline-images 'maybe - "Non-nil means, inline images into exported HTML pages. + "Non-nil means inline images into exported HTML pages. This is done using an <img> tag. When nil, an anchor with href is used to link to the image. If this option is `maybe', then images in links with an empty description will be inlined, while images with a description will @@ -276,7 +396,7 @@ be linked only." (const :tag "When there is no description" maybe))) (defcustom org-export-html-inline-image-extensions - '("png" "jpeg" "jpg" "gif") + '("png" "jpeg" "jpg" "gif" "svg") "Extensions of image files that can be inlined into HTML." :group 'org-export-html :type '(repeat (string :tag "Extension"))) @@ -289,17 +409,22 @@ borders and spacing." :group 'org-export-html :type 'string) -(defcustom org-export-table-header-tags '("<th scope=\"%s\">" . "</th>") +(defcustom org-export-table-header-tags '("<th scope=\"%s\"%s>" . "</th>") "The opening tag for table header fields. This is customizable so that alignment options can be specified. -%s will be filled with the scope of the field, either row or col. -See also the variable `org-export-html-table-use-header-tags-for-first-column'." +The first %s will be filled with the scope of the field, either row or col. +The second %s will be replaced by a style entry to align the field. +See also the variable `org-export-html-table-use-header-tags-for-first-column'. +See also the variable `org-export-html-table-align-individual-fields'." :group 'org-export-tables :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) -(defcustom org-export-table-data-tags '("<td>" . "</td>") +(defcustom org-export-table-data-tags '("<td%s>" . "</td>") "The opening tag for table data fields. -This is customizable so that alignment options can be specified." +This is customizable so that alignment options can be specified. +The first %s will be filled with the scope of the field, either row or col. +The second %s will be replaced by a style entry to align the field. +See also the variable `org-export-html-table-align-individual-fields'." :group 'org-export-tables :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) @@ -330,16 +455,22 @@ will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"." (string :tag "Specify") (sexp)))) - +(defcustom org-export-html-table-align-individual-fields t + "Non-nil means attach style attributes for alignment to each table field. +When nil, alignment will only be specified in the column tags, but this +is ignored by some browsers (like Firefox, Safari). Opera does it right +though." + :group 'org-export-tables + :type 'boolean) (defcustom org-export-html-table-use-header-tags-for-first-column nil - "Non-nil means, format column one in tables with header tags. + "Non-nil means format column one in tables with header tags. When nil, also column one will use data tags." :group 'org-export-tables :type 'boolean) (defcustom org-export-html-validation-link nil - "Non-nil means, add validationlink to postamble of HTML exported files." + "Non-nil means add validation link to postamble of HTML exported files." :group 'org-export-html :type '(choice (const :tag "Nothing" nil) @@ -348,9 +479,10 @@ When nil, also column one will use data tags." (defcustom org-export-html-with-timestamp nil - "If non-nil, write `org-export-html-html-helper-timestamp' -into the exported HTML text. Otherwise, the buffer will just be saved -to a file." + "If non-nil, write timestamp into the exported HTML text. +If non-nil Write `org-export-html-html-helper-timestamp' into the +exported HTML text. Otherwise, the buffer will just be saved to +a file." :group 'org-export-html :type 'boolean) @@ -404,10 +536,10 @@ with a link to this URL." ;;; Variables, constants, and parameter plists (defvar org-export-html-preamble nil - "Preamble, to be inserted just before <body>. Set by publishing functions. + "Preamble, to be inserted just after <body>. Set by publishing functions. This may also be a function, building and inserting the preamble.") (defvar org-export-html-postamble nil - "Preamble, to be inserted just after </body>. Set by publishing functions. + "Postamble, to be inserted just before </body>. Set by publishing functions. This may also be a function, building and inserting the postamble.") (defvar org-export-html-auto-preamble t "Should default preamble be inserted? Set by publishing functions.") @@ -420,20 +552,36 @@ This may also be a function, building and inserting the postamble.") "Hook run during HTML export, after blockquote, verse, center are done.") (defvar org-export-html-final-hook nil - "Hook run during HTML export, after blockquote, verse, center are done.") + "Hook run at the end of HTML export, in the new buffer.") ;;; HTML export (defun org-export-html-preprocess (parameters) - ;; Convert LaTeX fragments to images + "Convert LaTeX fragments to images." (when (and org-current-export-file (plist-get parameters :LaTeX-fragments)) (org-format-latex (concat "ltxpng/" (file-name-sans-extension (file-name-nondirectory org-current-export-file))) - org-current-export-dir nil "Creating LaTeX image %s")) - (message "Exporting...")) + org-current-export-dir nil "Creating LaTeX image %s" + nil nil + (cond + ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim) + ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax) + ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax) + ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng) + (t nil)))) + (goto-char (point-min)) + (let (label l1) + (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) + (org-if-unprotected-at (match-beginning 1) + (setq label (match-string 1)) + (save-match-data + (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label) + (setq l1 (substring label (match-beginning 1))) + (setq l1 label))) + (replace-match (format "[[#%s][%s]]" label l1) t t))))) ;;;###autoload (defun org-export-as-html-and-open (arg) @@ -443,11 +591,14 @@ The prefix ARG specifies how many levels of the outline should become headlines. The default is 3. Lower levels will become bulleted lists." (interactive "P") (org-export-as-html arg 'hidden) - (org-open-file buffer-file-name)) + (org-open-file buffer-file-name) + (when org-export-kill-product-buffer-when-displayed + (kill-buffer (current-buffer)))) ;;;###autoload (defun org-export-as-html-batch () - "Call `org-export-as-html', may be used in batch processing as + "Call the function `org-export-as-html'. +This function can be used in batch processing as: emacs --batch --load=$HOME/lib/emacs/org.el --eval \"(setq org-export-headline-levels 2)\" @@ -521,6 +672,128 @@ in a window. A non-interactive call will only return the buffer." (defvar html-table-tag nil) ; dynamically scoped into this. (defvar org-par-open nil) + +;;; org-html-cvt-link-fn +(defconst org-html-cvt-link-fn + nil + "Function to convert link URLs to exportable URLs. +Takes two arguments, TYPE and PATH. +Returns exportable url as (TYPE PATH), or nil to signal that it +didn't handle this case. +Intended to be locally bound around a call to `org-export-as-html'." ) + +(defun org-html-cvt-org-as-html (opt-plist type path) + "Convert an org filename to an equivalent html filename. +If TYPE is not file, just return `nil'. +See variable `org-export-html-link-org-files-as-html'" + + (save-match-data + (and + org-export-html-link-org-files-as-html + (string= type "file") + (string-match "\\.org$" path) + (progn + (list + "file" + (concat + (substring path 0 (match-beginning 0)) + "." + (plist-get opt-plist :html-extension))))))) + + +;;; org-html-should-inline-p +(defun org-html-should-inline-p (filename descp) + "Return non-nil if link FILENAME should be inlined. +The decision to inline the FILENAME link is based on the current +settings. DESCP is the boolean of whether there was a link +description. See variables `org-export-html-inline-images' and +`org-export-html-inline-image-extensions'." + (declare (special + org-export-html-inline-images + org-export-html-inline-image-extensions)) + (and (or (eq t org-export-html-inline-images) + (and org-export-html-inline-images (not descp))) + (org-file-image-p + filename org-export-html-inline-image-extensions))) + +;;; org-html-make-link +(defun org-html-make-link (opt-plist type path fragment desc attr + may-inline-p) + "Make an HTML link. +OPT-PLIST is an options list. +TYPE is the device-type of the link (THIS://foo.html) +PATH is the path of the link (http://THIS#locationx) +FRAGMENT is the fragment part of the link, if any (foo.html#THIS) +DESC is the link description, if any. +ATTR is a string of other attributes of the a element. +MAY-INLINE-P allows inlining it as an image." + + (declare (special org-par-open)) + (save-match-data + (let* ((filename path) + ;;First pass. Just sanity stuff. + (components-1 + (cond + ((string= type "file") + (list + type + ;;Substitute just if original path was absolute. + ;;(Otherwise path must remain relative) + (if (file-name-absolute-p path) + (concat "file://" (expand-file-name path)) + path))) + ((string= type "") + (list nil path)) + (t (list type path)))) + + ;;Second pass. Components converted so they can refer + ;;to a remote site. + (components-2 + (or + (and org-html-cvt-link-fn + (apply org-html-cvt-link-fn + opt-plist components-1)) + (apply #'org-html-cvt-org-as-html + opt-plist components-1) + components-1)) + (type (first components-2)) + (thefile (second components-2))) + + + ;;Third pass. Build final link except for leading type + ;;spec. + (cond + ((or + (not type) + (string= type "http") + (string= type "https") + (string= type "file")) + (if fragment + (setq thefile (concat thefile "#" fragment)))) + + (t)) + + ;;Final URL-build, for all types. + (setq thefile + (let + ((str (org-export-html-format-href thefile))) + (if (and type (not (string= "file" type))) + (concat type ":" str) + str))) + + (if (and + may-inline-p + ;;Can't inline a URL with a fragment. + (not fragment)) + (progn + (message "image %s %s" thefile org-par-open) + (org-export-html-format-image thefile org-par-open)) + (concat + "<a href=\"" thefile "\"" attr ">" + (org-export-html-format-desc desc) + "</a>"))))) + +;;; org-export-as-html ;;;###autoload (defun org-export-as-html (arg &optional hidden ext-plist to-buffer body-only pub-dir) @@ -539,6 +812,7 @@ the file header and footer, simply return the content of <body>...</body>, without even the body tags themselves. When PUB-DIR is set, use this as the publishing directory." (interactive "P") + (run-hooks 'org-export-first-hook) ;; Make sure we have a file name when we need it. (when (and (not (or to-buffer body-only)) @@ -624,7 +898,8 @@ PUB-DIR is set, use this as the publishing directory." (author (plist-get opt-plist :author)) (title (or (and subtree-p (org-export-get-title-from-subtree)) (plist-get opt-plist :title) - (and (not + (and (not body-only) + (not (plist-get opt-plist :skip-before-1st-heading)) (org-export-grab-title-from-buffer)) (and buffer-file-name @@ -635,8 +910,8 @@ PUB-DIR is set, use this as the publishing directory." (string-match "\\S-" (plist-get opt-plist :link-up)) (plist-get opt-plist :link-up))) (link-home (and (plist-get opt-plist :link-home) - (string-match "\\S-" (plist-get opt-plist :link-home)) - (plist-get opt-plist :link-home))) + (string-match "\\S-" (plist-get opt-plist :link-home)) + (plist-get opt-plist :link-home))) (dummy (setq opt-plist (plist-put opt-plist :title title))) (html-table-tag (plist-get opt-plist :html-table-tag)) (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) @@ -669,6 +944,7 @@ PUB-DIR is set, use this as the publishing directory." (buffer-substring (if region-p (region-beginning) (point-min)) (if region-p (region-end) (point-max)))) + (org-export-have-math nil) (lines (org-split-string (org-export-preprocess-string @@ -692,11 +968,21 @@ PUB-DIR is set, use this as the publishing directory." :LaTeX-fragments (plist-get opt-plist :LaTeX-fragments)) "[\r\n]")) + (mathjax + (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax) + (and org-export-have-math + (eq (plist-get opt-plist :LaTeX-fragments) t))) + + (org-export-html-mathjax-config + org-export-html-mathjax-template + org-export-html-mathjax-options + (or (plist-get opt-plist :mathjax) "")) + "")) table-open type table-buffer table-orig-buffer - ind item-type starter didclose + ind item-type starter rpl path attr desc descp desc1 desc2 link - snumber fnc item-tag + snumber fnc item-tag item-number footnotes footref-seen id-file href ) @@ -761,6 +1047,7 @@ lang=\"%s\" xml:lang=\"%s\"> <meta name=\"description\" content=\"%s\"/> <meta name=\"keywords\" content=\"%s\"/> %s +%s </head> <body> <div id=\"content\"> @@ -775,10 +1062,11 @@ lang=\"%s\" xml:lang=\"%s\"> "") (or charset "iso-8859-1")) language language - (org-html-expand title) + title (or charset "iso-8859-1") date author description keywords style + mathjax (if (or link-up link-home) (concat (format org-export-html-home/up-format @@ -804,70 +1092,73 @@ lang=\"%s\" xml:lang=\"%s\"> (push "<ul>\n<li>" thetoc) (setq lines (mapcar '(lambda (line) - (if (string-match org-todo-line-regexp line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (save-match-data - (org-html-expand - (org-export-cleanup-toc-line - (match-string 3 line)))) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) + (if (and (string-match org-todo-line-regexp line) + (not (get-text-property 0 'org-protected line))) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (save-match-data + (org-html-expand + (org-export-cleanup-toc-line + (match-string 3 line)))) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (setq snumber (org-section-number level)) - (if org-export-with-section-numbers - (setq txt (concat snumber " " txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (if (<= level umax-toc) - (progn - (if (> level org-last-level) - (progn - (setq cnt (- level org-last-level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "\n<ul>\n<li>" thetoc)) - (push "\n" thetoc))) - (if (< level org-last-level) - (progn - (setq cnt (- org-last-level level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "</li>\n</ul>" thetoc)) - (push "\n" thetoc))) - ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line (replace-match - (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") - t t line))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (setq href (format "sec-%s" snumber)) - (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href)) - (push - (format - (if todo - "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" - "</li>\n<li><a href=\"#%s\">%s</a>") - href txt) thetoc) - - (setq org-last-level level)) - ))) - line) + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (if (string-match + (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) + (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt))) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + (setq snumber (org-section-number level)) + (if org-export-with-section-numbers + (setq txt (concat snumber " " txt))) + (if (<= level (max umax umax-toc)) + (setq head-count (+ head-count 1))) + (if (<= level umax-toc) + (progn + (if (> level org-last-level) + (progn + (setq cnt (- level org-last-level)) + (while (>= (setq cnt (1- cnt)) 0) + (push "\n<ul>\n<li>" thetoc)) + (push "\n" thetoc))) + (if (< level org-last-level) + (progn + (setq cnt (- org-last-level level)) + (while (>= (setq cnt (1- cnt)) 0) + (push "</li>\n</ul>" thetoc)) + (push "\n" thetoc))) + ;; Check for targets + (while (string-match org-any-target-regexp line) + (setq line (replace-match + (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") + t t line))) + (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) + (setq txt (replace-match "" t t txt))) + (setq href + (replace-regexp-in-string + "\\." "_" (format "sec-%s" snumber))) + (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href)) + (push + (format + (if todo + "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" + "</li>\n<li><a href=\"#%s\">%s</a>") + href txt) thetoc) + + (setq org-last-level level)) + ))) + line) lines)) (while (> org-last-level (1- org-min-level)) (setq org-last-level (1- org-last-level)) @@ -910,10 +1201,23 @@ lang=\"%s\" xml:lang=\"%s\"> (org-open-par)) (throw 'nextline nil)) - (org-export-html-close-lists-maybe line) + ;; Explicit list closure + (when (equal "ORG-LIST-END" line) + (while local-list-indent + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) + (pop local-list-indent)) + (setq in-local-list nil) + (org-open-par) + (throw 'nextline nil)) ;; Protected HTML - (when (get-text-property 0 'org-protected line) + (when (and (get-text-property 0 'org-protected line) + ;; Make sure it is the entire line that is protected + (not (< (or (next-single-property-change + 0 'org-protected line) 10000) + (length line)))) (let (par (ind (get-text-property 0 'original-indentation line))) (when (re-search-backward "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) @@ -944,10 +1248,12 @@ lang=\"%s\" xml:lang=\"%s\"> (when (equal "ORG-VERSE-START" line) (org-close-par-maybe) (insert "\n<p class=\"verse\">\n") + (setq org-par-open t) (setq inverse t) (throw 'nextline nil)) (when (equal "ORG-VERSE-END" line) (insert "</p>\n") + (setq org-par-open nil) (org-open-par) (setq inverse nil) (throw 'nextline nil)) @@ -999,7 +1305,7 @@ lang=\"%s\" xml:lang=\"%s\"> "\" class=\"target\">" (match-string 1 line) "@</a> ") t t line))))) - + (setq line (org-html-handle-time-stamps line)) ;; replace "&" by "&", "<" and ">" by "<" and ">" @@ -1036,61 +1342,70 @@ lang=\"%s\" xml:lang=\"%s\"> (setq desc (org-add-props (concat "<img src=\"" desc "\"/>") '(org-protected t)))) - ;; FIXME: do we need to unescape here somewhere? (cond ((equal type "internal") - (setq rpl - (concat - "<a href=\"" - (if (= (string-to-char path) ?#) "" "#") - (org-solidify-link-text - (save-match-data (org-link-unescape path)) nil) - "\"" attr ">" - (org-export-html-format-desc desc) - "</a>"))) + (let + ((frag-0 + (if (= (string-to-char path) ?#) + (substring path 1) + path))) + (setq rpl + (org-html-make-link + opt-plist + "" + "" + (org-solidify-link-text + (save-match-data (org-link-unescape frag-0)) + nil) + desc attr nil)))) ((and (equal type "id") (setq id-file (org-id-find-id-file path))) ;; This is an id: link to another file (if it was the same file, ;; it would have become an internal link...) (save-match-data (setq id-file (file-relative-name - id-file (file-name-directory org-current-export-file))) - (setq id-file (concat (file-name-sans-extension id-file) - "." html-extension)) - (setq rpl (concat "<a href=\"" id-file "#" - (if (org-uuidgen-p path) "ID-") - path "\"" - attr ">" - (org-export-html-format-desc desc) - "</a>")))) + id-file + (file-name-directory org-current-export-file))) + (setq rpl + (org-html-make-link opt-plist + "file" id-file + (concat (if (org-uuidgen-p path) "ID-") path) + desc + attr + nil)))) ((member type '("http" "https")) - ;; standard URL, just check if we need to inline an image - (if (and (or (eq t org-export-html-inline-images) - (and org-export-html-inline-images (not descp))) - (org-file-image-p - path org-export-html-inline-image-extensions)) - (setq rpl (org-export-html-format-image - (concat type ":" path) org-par-open)) - (setq link (concat type ":" path)) - (setq rpl (concat "<a href=\"" - (org-export-html-format-href link) - "\"" attr ">" - (org-export-html-format-desc desc) - "</a>")))) + ;; standard URL, can inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + (org-html-should-inline-p path descp)))) ((member type '("ftp" "mailto" "news")) - ;; standard URL - (setq link (concat type ":" path)) - (setq rpl (concat "<a href=\"" - (org-export-html-format-href link) - "\"" attr ">" - (org-export-html-format-desc desc) - "</a>"))) + ;; standard URL, can't inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + nil))) ((string= type "coderef") - (setq rpl (format "<a href=\"#coderef-%s\" class=\"coderef\" onmouseover=\"CodeHighlightOn(this, 'coderef-%s');\" onmouseout=\"CodeHighlightOff(this, 'coderef-%s');\">%s</a>" - path path path - (format (org-export-get-coderef-format path (and descp desc)) - (cdr (assoc path org-export-code-refs)))))) + (let* + ((coderef-str (format "coderef-%s" path)) + (attr-1 + (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" + coderef-str coderef-str))) + (setq rpl + (org-html-make-link opt-plist + type "" coderef-str + (format + (org-export-get-coderef-format + path + (and descp desc)) + (cdr (assoc path org-export-code-refs))) + attr-1 + nil)))) ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) ;; The link protocol has a function for format the link @@ -1100,49 +1415,54 @@ lang=\"%s\" xml:lang=\"%s\"> ((string= type "file") ;; FILE link - (let* ((filename path) - (abs-p (file-name-absolute-p filename)) - thefile file-is-image-p search) - (save-match-data - (if (string-match "::\\(.*\\)" filename) - (setq search (match-string 1 filename) - filename (replace-match "" t nil filename))) - (setq valid - (if (functionp link-validate) - (funcall link-validate filename current-dir) - t)) - (setq file-is-image-p - (org-file-image-p - filename org-export-html-inline-image-extensions)) - (setq thefile (if abs-p (expand-file-name filename) filename)) - (when (and org-export-html-link-org-files-as-html - (string-match "\\.org$" thefile)) - (setq thefile (concat (substring thefile 0 - (match-beginning 0)) - "." html-extension)) - (if (and search - ;; make sure this is can be used as target search - (not (string-match "^[0-9]*$" search)) - (not (string-match "^\\*" search)) - (not (string-match "^/.*/$" search))) - (setq thefile (concat thefile "#" - (org-solidify-link-text - (org-link-unescape search))))) - (when (string-match "^file:" desc) - (setq desc (replace-match "" t t desc)) - (if (string-match "\\.org$" desc) - (setq desc (replace-match "" t t desc)))))) - (setq rpl (if (and file-is-image-p - (or (eq t org-export-html-inline-images) - (and org-export-html-inline-images - (not descp)))) - (progn - (message "image %s %s" thefile org-par-open) - (org-export-html-format-image thefile org-par-open)) - (concat "<a href=\"" thefile "\"" attr ">" - (org-export-html-format-desc desc) - "</a>"))) - (if (not valid) (setq rpl desc)))) + (save-match-data + (let* + ((components + (if + (string-match "::\\(.*\\)" path) + (list + (replace-match "" t nil path) + (match-string 1 path)) + (list path nil))) + + ;;The proper path, without a fragment + (path-1 + (first components)) + + ;;The raw fragment + (fragment-0 + (second components)) + + ;;Check the fragment. If it can't be used as + ;;target fragment we'll pass nil instead. + (fragment-1 + (if + (and fragment-0 + (not (string-match "^[0-9]*$" fragment-0)) + (not (string-match "^\\*" fragment-0)) + (not (string-match "^/.*/$" fragment-0))) + (org-solidify-link-text + (org-link-unescape fragment-0)) + nil)) + (desc-2 + ;;Description minus "file:" and ".org" + (if (string-match "^file:" desc) + (let + ((desc-1 (replace-match "" t t desc))) + (if (string-match "\\.org$" desc-1) + (replace-match "" t t desc-1) + desc-1)) + desc))) + + (setq rpl + (if + (and + (functionp link-validate) + (not (funcall link-validate path-1 current-dir))) + desc + (org-html-make-link opt-plist + "file" path-1 fragment-1 desc-2 attr + (org-html-should-inline-p path-1 descp))))))) (t ;; just publish the path, as default @@ -1199,14 +1519,6 @@ lang=\"%s\" xml:lang=\"%s\"> (setq txt (replace-match "" t t txt))) (if (<= level (max umax umax-toc)) (setq head-count (+ head-count 1))) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) (setq first-heading-pos (or first-heading-pos (point))) (org-html-level-start level txt umax (and org-export-with-toc (<= level umax)) @@ -1218,19 +1530,6 @@ lang=\"%s\" xml:lang=\"%s\"> (insert "<pre>") (setq inquote t))) - ((string-match "^[ \t]*- __+[ \t]*$" line) - ;; Explicit list closure - (when local-list-type - (let ((ind (org-get-indentation line))) - (while (and local-list-indent - (<= ind (car local-list-indent))) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) - (pop local-list-indent)) - (or local-list-indent (setq in-local-list nil)))) - (throw 'nextline nil)) - ((and org-export-with-tables (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) (when (not table-open) @@ -1263,27 +1562,15 @@ lang=\"%s\" xml:lang=\"%s\"> starter (if (match-beginning 2) (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5)) + item-number nil item-tag nil) + (if (string-match "\\[@\\(?:start:\\)?\\([0-9]+\\)\\][ \t]?" line) + (setq item-number (match-string 1 line) + line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) (setq item-type "d" item-tag (match-string 1 line) line (substring line (match-end 0)))) - (when (and (not (equal item-type "d")) - (not (string-match "[^ \t]" line))) - ;; empty line. Pretend indentation is large. - (setq ind (if org-empty-line-terminates-plain-lists - 0 - (1+ (or (car local-list-indent) 1))))) - (setq didclose nil) - (while (and in-local-list - (or (and (= ind (car local-list-indent)) - (not starter)) - (< ind (car local-list-indent)))) - (setq didclose t) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) (cond ((and starter (or (not in-local-list) @@ -1292,29 +1579,40 @@ lang=\"%s\" xml:lang=\"%s\"> (org-close-par-maybe) (insert (cond ((equal item-type "u") "<ul>\n<li>\n") + ((and (equal item-type "o") item-number) + (format "<ol>\n<li value=\"%s\">\n" item-number)) ((equal item-type "o") "<ol>\n<li>\n") ((equal item-type "d") (format "<dl>\n<dt>%s</dt><dd>\n" item-tag)))) (push item-type local-list-type) (push ind local-list-indent) (setq in-local-list t)) + ;; Continue list (starter - ;; continue current list + ;; terminate any previous sublist but first ensure + ;; list is not ill-formed. + (let ((min-ind (apply 'min local-list-indent))) + (when (< ind min-ind) (setq ind min-ind))) + (while (< ind (car local-list-indent)) + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) (pop local-list-indent) + (setq in-local-list local-list-indent)) + ;; insert new item (org-close-li (car local-list-type)) (insert (cond ((equal (car local-list-type) "d") (format "<dt>%s</dt><dd>\n" (or item-tag "???"))) - (t "<li>\n")))) - (didclose - ;; we did close a list, normal text follows: need <p> - (org-open-par))) + ((and (equal item-type "o") item-number) + (format "<li value=\"%s\">\n" item-number)) + (t "<li>\n"))))) (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) (setq line (replace-match (if (equal (match-string 1 line) "X") "<b>[X]</b>" "<b>[<span style=\"visibility:hidden;\">X</span>]</b>") - t t line)))) + t t line)))) ;; Horizontal line (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) @@ -1369,14 +1667,7 @@ lang=\"%s\" xml:lang=\"%s\"> (when inquote (insert "</pre>\n") (org-open-par)) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) + (org-html-level-start 1 nil umax (and org-export-with-toc (<= level umax)) head-count) @@ -1402,7 +1693,7 @@ lang=\"%s\" xml:lang=\"%s\"> (when (and org-export-author-info author) (insert "<p class=\"author\"> " (nth 1 lang-words) ": " author "\n") - (when email + (when (and org-export-email-info email (string-match "\\S-" email)) (if (listp (split-string email ",+ *")) (mapc (lambda(e) (insert "<a href=\"mailto:" e "\"><" @@ -1457,8 +1748,6 @@ lang=\"%s\" xml:lang=\"%s\"> (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) (replace-match "")) (goto-char (point-min)) - (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t) - (replace-match "")) ;; Convert whitespace place holders (goto-char (point-min)) (let (beg end n) @@ -1469,6 +1758,12 @@ lang=\"%s\" xml:lang=\"%s\"> (delete-region beg end) (insert (format "<span style=\"visibility:hidden;\">%s</span>" (make-string n ?x))))) + ;; Remove empty lines at the beginning of the file. + (goto-char (point-min)) + (when (looking-at "\\s-+\n") (replace-match "")) + ;; Remove display properties + (remove-text-properties (point-min) (point-max) '(display t)) + ;; Run the hook (run-hooks 'org-export-html-final-hook) (or to-buffer (save-buffer)) (goto-char (point-min)) @@ -1506,10 +1801,12 @@ lang=\"%s\" xml:lang=\"%s\"> "Create image tag with source and attributes." (save-match-data (if (string-match "^ltxpng/" src) - (format "<img src=\"%s\"/>" src) + (format "<img src=\"%s\" alt=\"%s\"/>" + src (org-find-text-property-in-string 'org-latex-src src)) (let* ((caption (org-find-text-property-in-string 'org-caption src)) (attr (org-find-text-property-in-string 'org-attributes src)) (label (org-find-text-property-in-string 'org-label src))) + (setq caption (and caption (org-html-do-expand caption))) (concat (if caption (format "%s<div %sclass=\"figure\"> @@ -1545,13 +1842,14 @@ lang=\"%s\" xml:lang=\"%s\"> nil)))) (defvar org-table-number-regexp) ; defined in org-table.el -(defun org-format-table-html (lines olines) - "Find out which HTML converter to use and return the HTML code." +(defun org-format-table-html (lines olines &optional no-css) + "Find out which HTML converter to use and return the HTML code. +NO-CSS is passed to the exporter." (if (stringp lines) (setq lines (org-split-string lines "\n"))) (if (string-match "^[ \t]*|" (car lines)) ;; A normal org table - (org-format-org-table-html lines) + (org-format-org-table-html lines nil no-css) ;; Table made by table.el - test for spanning (let* ((hlines (delq nil (mapcar (lambda (x) @@ -1572,8 +1870,12 @@ lang=\"%s\" xml:lang=\"%s\"> (org-format-table-table-html-using-table-generate-source olines))))) (defvar org-table-number-fraction) ; defined in org-table.el -(defun org-format-org-table-html (lines &optional splice) - "Format a table into HTML." +(defun org-format-org-table-html (lines &optional splice no-css) + "Format a table into HTML. +LINES is a list of lines. Optional argument SPLICE means, do not +insert header and surrounding <table> tags, just format the lines. +Optional argument NO-CSS means use XHTML attributes instead of CSS +for formatting. This is required for the DocBook exporter." (require 'org-table) ;; Get rid of hlines at beginning and end (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) @@ -1585,25 +1887,25 @@ lang=\"%s\" xml:lang=\"%s\"> ;; column and the special lines (setq lines (org-table-clean-before-export lines))) - (let* ((caption (or (get-text-property 0 'org-caption (car lines)) - (get-text-property (or (next-single-property-change - 0 'org-caption (car lines)) - 0) - 'org-caption (car lines)))) - (attributes (or (get-text-property 0 'org-attributes (car lines)) - (get-text-property (or (next-single-property-change - 0 'org-attributes (car lines)) - 0) - 'org-attributes (car lines)))) + (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) + (label (org-find-text-property-in-string 'org-label (car lines))) + (forced-aligns (org-find-text-property-in-string 'org-forced-aligns + (car lines))) + (attributes (org-find-text-property-in-string 'org-attributes + (car lines))) (html-table-tag (org-export-splice-attributes html-table-tag attributes)) (head (and org-export-highlight-first-table-line (delq nil (mapcar (lambda (x) (string-match "^[ \t]*|-" x)) (cdr lines))))) - - (nline 0) fnum i - tbopen line fields html gr colgropen rowstart rowend) + (nline 0) fnum nfields i (cnt 0) + tbopen line fields html gr colgropen rowstart rowend + ali align aligns n) + (setq caption (and caption (org-html-do-expand caption))) + (when (and forced-aligns org-table-clean-did-remove-column) + (setq forced-aligns + (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) forced-aligns))) (if splice (setq head nil)) (unless splice (push (if head "<thead>" "<tbody>") html)) (setq tbopen t) @@ -1619,30 +1921,34 @@ lang=\"%s\" xml:lang=\"%s\"> (throw 'next-line t))) ;; Break the line into fields (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0))) + (unless fnum (setq fnum (make-vector (length fields) 0) + nfields (length fnum))) (setq nline (1+ nline) i -1 rowstart (eval (car org-export-table-row-tags)) rowend (eval (cdr org-export-table-row-tags))) (push (concat rowstart (mapconcat (lambda (x) - (setq i (1+ i)) - (if (and (< i nline) + (setq i (1+ i) ali (format "@@class%03d@@" i)) + (if (and (< i nfields) ; make sure no rogue line causes an error here (string-match org-table-number-regexp x)) (incf (aref fnum i))) (cond (head (concat - (format (car org-export-table-header-tags) "col") + (format (car org-export-table-header-tags) + "col" ali) x (cdr org-export-table-header-tags))) ((and (= i 0) org-export-html-table-use-header-tags-for-first-column) (concat - (format (car org-export-table-header-tags) "row") + (format (car org-export-table-header-tags) + "row" ali) x (cdr org-export-table-header-tags))) (t - (concat (car org-export-table-data-tags) x + (concat (format (car org-export-table-data-tags) ali) + x (cdr org-export-table-data-tags))))) fields "") rowend) @@ -1655,28 +1961,57 @@ lang=\"%s\" xml:lang=\"%s\"> (unless (car org-table-colgroup-info) (setq org-table-colgroup-info (cons :start (cdr org-table-colgroup-info)))) + (setq i 0) (push (mapconcat (lambda (x) - (setq gr (pop org-table-colgroup-info)) - (format "%s<col align=\"%s\" />%s" + (setq gr (pop org-table-colgroup-info) + i (1+ i) + align (if (assoc i forced-aligns) + (cdr (assoc (cdr (assoc i forced-aligns)) + '(("l" . "left") ("r" . "right") + ("c" . "center")))) + (if (> (/ (float x) nline) + org-table-number-fraction) + "right" "left"))) + (push align aligns) + (format (if no-css + "%s<col align=\"%s\" />%s" + "%s<col class=\"%s\" />%s") (if (memq gr '(:start :startend)) (prog1 - (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") + (if colgropen + "</colgroup>\n<colgroup>" + "<colgroup>") (setq colgropen t)) "") - (if (> (/ (float x) nline) org-table-number-fraction) - "right" "left") + align (if (memq gr '(:end :startend)) (progn (setq colgropen nil) "</colgroup>") ""))) fnum "") html) - (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) + (setq aligns (nreverse aligns)) + (if colgropen (setq html (cons (car html) + (cons "</colgroup>" (cdr html))))) ;; Since the output of HTML table formatter can also be used in ;; DocBook document, we want to always include the caption to make ;; DocBook XML file valid. (push (format "<caption>%s</caption>" (or caption "")) html) + (when label (push (format "<a name=\"%s\" id=\"%s\"></a>" label label) + html)) (push html-table-tag html)) + (setq html (mapcar + (lambda (x) + (replace-regexp-in-string + "@@class\\([0-9]+\\)@@" + (lambda (txt) + (if (not org-export-html-table-align-individual-fields) + "" + (setq n (string-to-number (match-string 1 txt))) + (format (if no-css " align=\"%s\"" " class=\"%s\"") + (or (nth n aligns) "left")))) + x)) + html)) (concat (mapconcat 'identity html "\n") "\n"))) (defun org-export-splice-attributes (tag attributes) @@ -1721,10 +2056,10 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." (if (equal x "") (setq x empty)) (if head (concat - (format (car org-export-table-header-tags) "col") + (format (car org-export-table-header-tags) "col" "") x (cdr org-export-table-header-tags)) - (concat (car org-export-table-data-tags) x + (concat (format (car org-export-table-data-tags) "") x (cdr org-export-table-data-tags)))) field-buffer "\n") "</tr>\n")) @@ -1845,7 +2180,7 @@ that uses these same face definitions." (goto-char (point-min))) (defun org-html-protect (s) - ;; convert & to &, < to < and > to > + "convert & to &, < to < and > to >" (let ((start 0)) (while (string-match "&" s start) (setq s (replace-match "&" t t s) @@ -1860,19 +2195,21 @@ that uses these same face definitions." s) (defun org-html-expand (string) - "Prepare STRING for HTML export. Applies all active conversions. + "Prepare STRING for HTML export. Apply all active conversions. If there are links in the string, don't modify these." (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) + (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-html-do-expand s) res) - (push l res)) - (push (org-html-do-expand string) res) - (apply 'concat (nreverse res)))) + (if (string-match "^[ \t]*\\+-[-+]*\\+[ \t]*$" string) + string + (while (setq m (string-match re string)) + (setq s (substring string 0 m) + l (match-string 0 string) + string (substring string (match-end 0))) + (push (org-html-do-expand s) res) + (push l res)) + (push (org-html-do-expand string) res) + (apply 'concat (nreverse res))))) (defun org-html-do-expand (s) "Apply all active conversions to translate special ASCII to HTML." @@ -1887,16 +2224,14 @@ If there are links in the string, don't modify these." (if org-export-with-sub-superscripts (setq s (org-export-html-convert-sub-super s))) (if org-export-with-TeX-macros - (let ((start 0) wd ass) - (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?" + (let ((start 0) wd rep) + (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" s start)) (if (get-text-property (match-beginning 0) 'org-protected s) (setq start (match-end 0)) (setq wd (match-string 1 s)) - (if (setq ass (assoc wd org-html-entities)) - (setq s (replace-match (or (cdr ass) - (concat "&" (car ass) ";")) - t t s)) + (if (setq rep (org-entity-get-representation wd 'html)) + (setq s (replace-match rep t t s)) (setq start (+ start (length wd)))))))) s) @@ -1973,20 +2308,6 @@ If there are links in the string, don't modify these." (defvar in-local-list) (defvar local-list-indent) (defvar local-list-type) -(defun org-export-html-close-lists-maybe (line) - (let ((ind (or (get-text-property 0 'original-indentation line))) -; (and (string-match "\\S-" line) -; (org-get-indentation line)))) - didclose) - (when ind - (while (and in-local-list - (<= ind (car local-list-indent))) - (setq didclose t) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) - (and didclose (org-open-par))))) (defvar body-only) ; dynamically scoped into this. (defun org-html-level-start (level title umax with-toc head-count) @@ -1994,12 +2315,14 @@ If there are links in the string, don't modify these." When TITLE is nil, just close all open levels." (org-close-par-maybe) (let* ((target (and title (org-get-text-property-any 0 'target title))) - (extra-targets (assoc target org-export-target-aliases)) - (preferred (cdr (assoc target org-export-preferred-target-alist))) - (remove (or preferred target)) + (extra-targets (and target + (assoc target org-export-target-aliases))) + (extra-class (and title (org-get-text-property-any 0 'html-container-class title))) + (preferred (and target + (cdr (assoc target org-export-preferred-target-alist)))) (l org-level-max) - snumber href suffix) - (setq extra-targets (remove remove extra-targets)) + snumber snu href suffix) + (setq extra-targets (remove (or preferred target) extra-targets)) (setq extra-targets (mapconcat (lambda (x) (if (org-uuidgen-p x) (setq x (concat "ID-" x))) @@ -2016,7 +2339,7 @@ When TITLE is nil, just close all open levels." (when title ;; If title is nil, this means this function is called to close ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) (setq title (replace-match (if org-export-with-tags (save-match-data @@ -2038,16 +2361,18 @@ When TITLE is nil, just close all open levels." (progn (org-close-li) (if target - (insert (format "<li id=\"%s\">" target) extra-targets title "<br/>\n") + (insert (format "<li id=\"%s\">" (or preferred target)) + extra-targets title "<br/>\n") (insert "<li>" title "<br/>\n"))) (aset org-levels-open (1- level) t) (org-close-par-maybe) (if target - (insert (format "<ul>\n<li id=\"%s\">" target) + (insert (format "<ul>\n<li id=\"%s\">" (or preferred target)) extra-targets title "<br/>\n") (insert "<ul>\n<li>" title "<br/>\n")))) (aset org-levels-open (1- level) t) - (setq snumber (org-section-number level)) + (setq snumber (org-section-number level) + snu (replace-regexp-in-string "\\." "_" snumber)) (setq level (+ level org-export-html-toplevel-hlevel -1)) (if (and org-export-with-section-numbers (not body-only)) (setq title (concat @@ -2055,11 +2380,12 @@ When TITLE is nil, just close all open levels." level snumber) " " title))) (unless (= head-count 1) (insert "\n</div>\n")) - (setq href (cdr (assoc (concat "sec-" snumber) org-export-preferred-target-alist))) - (setq suffix (or href snumber)) - (setq href (or href (concat "sec-" snumber))) - (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n" - suffix level level href + (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist))) + (setq suffix (or href snu)) + (setq href (or href (concat "sec-" snu))) + (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d%s\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n" + suffix level (if extra-class (concat " " extra-class) "") + level href extra-targets title level level suffix)) (org-open-par))))) diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el index 77e64d10a31..346e0496531 100644 --- a/lisp/org/org-icalendar.el +++ b/lisp/org/org-icalendar.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -26,8 +26,13 @@ ;; ;;; Commentary: +;;; Code: + (require 'org-exp) +(eval-when-compile + (require 'cl)) + (declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) (defgroup org-export-icalendar nil @@ -42,13 +47,29 @@ The file name should be absolute, the file will be overwritten without warning." :group 'org-export-icalendar :type 'file) +(defcustom org-icalendar-alarm-time 0 + "Number of minutes for triggering an alarm for exported timed events. +A zero value (the default) turns off the definition of an alarm trigger +for timed events. If non-zero, alarms are created. + +- a single alarm per entry is defined +- The alarm will go off N minutes before the event +- only a DISPLAY action is defined." + :group 'org-export-icalendar + :type 'integer) + (defcustom org-icalendar-combined-name "OrgMode" "Calendar name for the combined iCalendar representing all agenda files." :group 'org-export-icalendar :type 'string) +(defcustom org-icalendar-combined-description nil + "Calendar description for the combined iCalendar (all agenda files)." + :group 'org-export-icalendar + :type 'string) + (defcustom org-icalendar-use-plain-timestamp t - "Non-nil means, make an event from every plain time stamp." + "Non-nil means make an event from every plain time stamp." :group 'org-export-icalendar :type 'boolean) @@ -104,7 +125,7 @@ all-tags All tags, including inherited ones." (const :tag "All tags, including inherited ones" all-tags)))) (defcustom org-icalendar-include-todo nil - "Non-nil means, export to iCalendar files should also cover TODO items. + "Non-nil means export to iCalendar files should also cover TODO items. Valid values are: nil don't include any TODO items t include all TODO items that are not in a DONE state @@ -129,13 +150,13 @@ up in the ics file. But for normal iCalendar export, you can use this for whatever you need.") (defcustom org-icalendar-include-bbdb-anniversaries nil - "Non-nil means, a combined iCalendar files should include anniversaries. + "Non-nil means a combined iCalendar files should include anniversaries. The anniversaries are define in the BBDB database." :group 'org-export-icalendar :type 'boolean) (defcustom org-icalendar-include-sexps t - "Non-nil means, export to iCalendar files should also cover sexp entries. + "Non-nil means export to iCalendar files should also cover sexp entries. These are entries like in the diary, but directly in an Org-mode file." :group 'org-export-icalendar :type 'boolean) @@ -152,12 +173,12 @@ The text will be inserted into the DESCRIPTION field." (integer :tag "Max characters"))) (defcustom org-icalendar-store-UID nil - "Non-nil means, store any created UIDs in properties. + "Non-nil means store any created UIDs in properties. The iCalendar standard requires that all entries have a unique identifier. Org will create these identifiers as needed. When this variable is non-nil, the created UIDs will be stored in the ID property of the entry. Then the next time this entry is exported, it will be exported with the same UID, -superceding the previous form of it. This is essential for +superseding the previous form of it. This is essential for synchronization services. This variable is not turned on by default because we want to avoid creating a property drawer in every entry if people are only playing with this feature, @@ -173,6 +194,13 @@ When nil of the empty string, use the abbreviation retrieved from Emacs." (const :tag "Unspecified" nil) (string :tag "Time zone"))) +(defcustom org-icalendar-use-UTC-date-time () + "Non-nil force the use of the universal time for iCalendar DATE-TIME. +The iCalendar DATE-TIME can be expressed with local time or universal Time, +universal time could be more compatible with some external tools." + :group 'org-export-icalendar + :type 'boolean) + ;;; iCalendar export ;;;###autoload @@ -185,7 +213,7 @@ file, but with extension `.ics'." ;;;###autoload (defun org-export-icalendar-all-agenda-files () - "Export all files in `org-agenda-files' to iCalendar .ics files. + "Export all files in the variable `org-agenda-files' to iCalendar .ics files. Each iCalendar file will be located in the same directory as the Org-mode file, but with extension `.ics'." (interactive) @@ -272,7 +300,7 @@ When COMBINE is non nil, add the category to each line." "DTSTART")) hd ts ts2 state status (inc t) pos b sexp rrule scheduledp deadlinep todo prefix due start - tmp pri categories location summary desc uid + tmp pri categories location summary desc uid alarm (sexp-buffer (get-buffer-create "*ical-tmp*"))) (org-refresh-category-properties) (save-excursion @@ -290,7 +318,7 @@ When COMBINE is non nil, add the category to each line." inc t hd (condition-case nil (org-icalendar-cleanup-string - (org-get-heading)) + (org-get-heading t)) (error (throw :skip nil))) summary (org-icalendar-cleanup-string (org-entry-get nil "SUMMARY")) @@ -304,6 +332,7 @@ When COMBINE is non nil, add the category to each line." (org-id-get-create) (or (org-id-get) (org-id-new))) categories (org-export-get-categories) + alarm "" deadlinep nil scheduledp nil) (if (looking-at re2) (progn @@ -352,6 +381,17 @@ When COMBINE is non nil, add the category to each line." ";INTERVAL=" (match-string 1 ts))) (setq rrule "")) (setq summary (or summary hd)) + ;; create an alarm entry if the entry is timed. this is not very general in that: + ;; (a) only one alarm per entry is defined, + ;; (b) only minutes are allowed for the trigger period ahead of the start time, and + ;; (c) only a DISPLAY action is defined. + ;; [ESF] + (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault)))) + (if (and (> org-icalendar-alarm-time 0) + (car t1) (nth 1 t1) (nth 2 t1)) + (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0D0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time)) + (setq alarm "")) + ) (if (string-match org-bracket-link-regexp summary) (setq summary (replace-match (if (match-end 3) @@ -368,7 +408,7 @@ UID: %s %s %s%s SUMMARY:%s%s%s -CATEGORIES:%s +CATEGORIES:%s%s END:VEVENT\n" (concat prefix uid) (org-ical-ts-to-string ts "DTSTART") @@ -378,7 +418,8 @@ END:VEVENT\n" (concat "\nDESCRIPTION: " desc) "") (if (and location (string-match "\\S-" location)) (concat "\nLOCATION: " location) "") - categories))))) + categories + alarm))))) (when (and org-icalendar-include-sexps (condition-case nil (require 'icalendar) (error nil)) (fboundp 'icalendar-export-region)) @@ -405,7 +446,7 @@ END:VEVENT\n" (when org-icalendar-include-todo (setq prefix "TODO-") (goto-char (point-min)) - (while (re-search-forward org-todo-line-regexp nil t) + (while (re-search-forward org-complex-heading-regexp nil t) (catch :skip (org-agenda-skip) (when org-icalendar-verify-function @@ -437,7 +478,7 @@ END:VEVENT\n" ((eq org-icalendar-include-todo t) ;; include everything that is not done (member state org-not-done-keywords)))) - (setq hd (match-string 3) + (setq hd (match-string 4) summary (org-icalendar-cleanup-string (org-entry-get nil "SUMMARY")) desc (org-icalendar-cleanup-string @@ -511,11 +552,12 @@ whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH characters." (if (not s) nil - (when is-body + (if is-body (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))))) + (while (string-match re2 s) (setq s (replace-match "" t t s)))) + (setq s (replace-regexp-in-string "[[:space:]]+" " " s))) (let ((start 0)) (while (string-match "\\([,;]\\)" s start) (setq start (+ (match-beginning 0) 2) @@ -563,14 +605,16 @@ not used right now." (name (or name "unknown")) (timezone (if (> (length org-icalendar-timezone) 0) org-icalendar-timezone - (cadr (current-time-zone))))) + (cadr (current-time-zone)))) + (description org-icalendar-combined-description)) (princ (format "BEGIN:VCALENDAR VERSION:2.0 X-WR-CALNAME:%s PRODID:-//%s//Emacs with Org-mode//EN X-WR-TIMEZONE:%s -CALSCALE:GREGORIAN\n" name user timezone)))) +X-WR-CALDESC:%s +CALSCALE:GREGORIAN\n" name user timezone description)))) (defun org-finish-icalendar-file () "Finish an iCalendar file by inserting the END statement." @@ -581,22 +625,29 @@ CALSCALE:GREGORIAN\n" name user timezone)))) KEYWORD is added in front, to make a complete line like DTSTART.... When INC is non-nil, increase the hour by two (if time string contains a time), or the day by one (if it does not contain a time)." - (let ((t1 (org-parse-time-string s 'nodefault)) + (let ((t1 (ignore-errors (org-parse-time-string s 'nodefault))) t2 fmt have-time time) - (if (and (car t1) (nth 1 t1) (nth 2 t1)) - (setq t2 t1 have-time t) - (setq t2 (org-parse-time-string s))) - (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) - (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) - (when inc - (if have-time - (if org-agenda-default-appointment-duration - (setq mi (+ org-agenda-default-appointment-duration mi)) - (setq h (+ 2 h))) - (setq d (1+ d)))) - (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time)))) + (if (not t1) + "" + (if (and (car t1) (nth 1 t1) (nth 2 t1)) + (setq t2 t1 have-time t) + (setq t2 (org-parse-time-string s))) + (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) + (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) + (when inc + (if have-time + (if org-agenda-default-appointment-duration + (setq mi (+ org-agenda-default-appointment-duration mi)) + (setq h (+ 2 h))) + (setq d (1+ d)))) + (setq time (encode-time s mi h d m y))) + (setq fmt (if have-time (if org-icalendar-use-UTC-date-time + ":%Y%m%dT%H%M%SZ" + ":%Y%m%dT%H%M%S") + ";VALUE=DATE:%Y%m%d")) + (concat keyword (format-time-string fmt time + (and org-icalendar-use-UTC-date-time + have-time)))))) (provide 'org-icalendar) diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 44b2d917ef2..9c5ac9ec625 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -37,8 +37,9 @@ ;; time of the ID, with microsecond accuracy. This virtually ;; guarantees globally unique identifiers, even if several people are ;; creating IDs at the same time in files that will eventually be used -;; together. As an external method `uuidgen' is supported, if installed -;; on the system. +;; together. +;; +;; By default Org uses UUIDs as global unique identifiers. ;; ;; This file defines the following API: ;; @@ -68,6 +69,8 @@ ;; Find the location of an entry with specific id. ;; +;;; Code: + (require 'org) (declare-function message-make-fqdn "message" ()) @@ -84,18 +87,9 @@ :group 'org-id :type 'string) -(defcustom org-id-method - (condition-case nil - (if (string-match "\\`[-0-9a-fA-F]\\{36\\}\\'" - (org-trim (shell-command-to-string - org-id-uuid-program))) - 'uuidgen - 'org) - (error 'org)) +(defcustom org-id-method 'uuid "The method that should be used to create new IDs. -If `uuidgen' is available on the system, it will be used as the default method. -if not, the method `org' is used. An ID will consist of the optional prefix specified in `org-id-prefix', and a unique part created by the method this variable specifies. @@ -105,11 +99,13 @@ org Org's own internal method, using an encoding of the current time to microsecond accuracy, and optionally the current domain of the computer. See the variable `org-id-include-domain'. -uuidgen Call the external command uuidgen." +uuid Create random (version 4) UUIDs. If the program defined in + `org-id-uuid-program' is available it is used to create the ID. + Otherwise an internal functions is used." :group 'org-id :type '(choice (const :tag "Org's internal method" org) - (const :tag "external: uuidgen" uuidgen))) + (const :tag "external: uuidgen" uuid))) (defcustom org-id-prefix nil "The prefix for IDs. @@ -123,7 +119,7 @@ to have no space characters in them." (string :tag "Prefix"))) (defcustom org-id-include-domain nil - "Non-nil means, add the domain name to new IDs. + "Non-nil means add the domain name to new IDs. This ensures global uniqueness of IDs, and is also suggested by RFC 2445 in combination with RFC 822. This is only relevant if `org-id-method' is `org'. When uuidgen is used, the domain will never @@ -135,7 +131,7 @@ people to make this necessary." :type 'boolean) (defcustom org-id-track-globally t - "Non-nil means, track IDs through files, so that links work globally. + "Non-nil means track IDs through files, so that links work globally. This work by maintaining a hash table for IDs and writing this table to disk when exiting Emacs. Because of this, it works best if you use a single Emacs process, not many. @@ -178,7 +174,7 @@ This variable is only relevant when `org-id-track-globally' is set." (file)))) (defcustom org-id-search-archives t - "Non-nil means, search also the archive files of agenda files for entries. + "Non-nil means search also the archive files of agenda files for entries. This is a possibility to reduce overhead, but it means that entries moved to the archives can no longer be found by ID. This variable is only relevant when `org-id-track-globally' is set." @@ -306,8 +302,10 @@ So a typical ID could look like \"Org:4nd91V40HI\"." unique) (if (equal prefix ":") (setq prefix "")) (cond - ((eq org-id-method 'uuidgen) - (setq unique (org-trim (shell-command-to-string org-id-uuid-program)))) + ((memq org-id-method '(uuidgen uuid)) + (setq unique (org-trim (shell-command-to-string org-id-uuid-program))) + (unless (org-uuidgen-p unique) + (setq unique (org-id-uuid)))) ((eq org-id-method 'org) (let* ((etime (org-id-reverse-string (org-id-time-to-b36))) (postfix (if org-id-include-domain @@ -318,6 +316,30 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (t (error "Invalid `org-id-method'"))) (concat prefix unique))) +(defun org-id-uuid () + "Return string with random (version 4) UUID." + (let ((rnd (md5 (format "%s%s%s%s%s%s%s" + (random t) + (current-time) + (user-uid) + (emacs-pid) + (user-full-name) + user-mail-address + (recent-keys))))) + (format "%s-%s-4%s-%s%s-%s" + (substring rnd 0 8) + (substring rnd 8 12) + (substring rnd 13 16) + (format "%x" + (logior + #b10000000 + (logand + #b10111111 + (string-to-number + (substring rnd 16 18) 16)))) + (substring rnd 18 20) + (substring rnd 20 32)))) + (defun org-id-reverse-string (s) (mapconcat 'char-to-string (nreverse (string-to-list s)) "")) @@ -466,7 +488,7 @@ When CHECK is given, prepare detailed information about duplicate IDs." (defun org-id-locations-save () "Save `org-id-locations' in `org-id-locations-file'." - (when org-id-track-globally + (when (and org-id-track-globally org-id-locations) (let ((out (if (hash-table-p org-id-locations) (org-id-hash-to-alist org-id-locations) org-id-locations))) @@ -545,7 +567,9 @@ When CHECK is given, prepare detailed information about duplicate IDs." (defun org-id-find-id-file (id) "Query the id database for the file in which this ID is located." (unless org-id-locations (org-id-locations-load)) - (or (gethash id org-id-locations) + (or (and org-id-locations + (hash-table-p org-id-locations) + (gethash id org-id-locations)) ;; ball back on current buffer (buffer-file-name (or (buffer-base-buffer (current-buffer)) (current-buffer))))) @@ -572,17 +596,22 @@ optional argument MARKERP, return the position as a new marker." ;; Calling the following function is hard-coded into `org-store-link', ;; so we do have to add it to `org-store-link-functions'. +;;;###autoload (defun org-id-store-link () "Store a link to the current entry, using its ID." (interactive) - (let* ((link (org-make-link "id:" (org-id-get-create))) - (desc (save-excursion - (org-back-to-heading t) - (or (and (looking-at org-complex-heading-regexp) - (if (match-end 4) (match-string 4) (match-string 0))) - link)))) - (org-store-link-props :link link :description desc :type "id") - link)) + (when (and (buffer-file-name (buffer-base-buffer)) (org-mode-p)) + (let* ((link (org-make-link "id:" (org-id-get-create))) + (case-fold-search nil) + (desc (save-excursion + (org-back-to-heading t) + (or (and (looking-at org-complex-heading-regexp) + (if (match-end 4) + (match-string 4) + (match-string 0))) + link)))) + (org-store-link-props :link link :description desc :type "id") + link))) (defun org-id-open (id) "Go to the entry with id ID." diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index b27d3b8f92f..43c7a2bb1ca 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -29,22 +29,28 @@ ;; by adding text properties to a buffer to make sure lines are ;; indented according to outline structure. +;;; Code: + (require 'org-macs) (require 'org-compat) (require 'org) + (eval-when-compile (require 'cl)) +(defvar org-inlinetask-min-level) +(declare-function org-inlinetask-get-task-level "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) (defgroup org-indent nil "Options concerning dynamic virtual outline indentation." - :tag "Org Structure" + :tag "Org Indent" :group 'org) (defconst org-indent-max 40 - "Maximum indentation in characters") + "Maximum indentation in characters.") (defconst org-indent-max-levels 40 - "Maximum indentation in characters") + "Maximum indentation in characters.") (defvar org-indent-strings nil "Vector with all indentation strings. @@ -53,7 +59,7 @@ It will be set in `org-indent-initialize'.") "Vector with all indentation star strings. It will be set in `org-indent-initialize'.") (defvar org-hide-leading-stars-before-indent-mode nil - "Used locally") + "Used locally.") (defcustom org-indent-boundary-char ?\ ; comment to protect space char "The end of the virtual indentation strings, a single-character string. @@ -67,13 +73,15 @@ it may be prettier to customize the org-indent face." :type 'character) (defcustom org-indent-mode-turns-off-org-adapt-indentation t - "Non-nil means, turning on org-indent-mode turns off indentation adaptation. + "Non-nil means setting the variable `org-indent-mode' will \ +turn off indentation adaptation. For details see the variable `org-adapt-indentation'." :group 'org-indent :type 'boolean) (defcustom org-indent-mode-turns-on-hiding-stars t - "Non-nil means, turning on org-indent-mode turns on `org-hide-leading-stars'." + "Non-nil means setting the variable `org-indent-mode' will \ +turn on `org-hide-leading-stars'." :group 'org-indent :type 'boolean) @@ -127,44 +135,57 @@ Internally this works by adding `line-prefix' properties to all non-headlines. These properties are updated locally in idle time. FIXME: How to update when broken?" nil " Ind" nil - (if (org-bound-and-true-p org-inhibit-startup) - (setq org-indent-mode nil) - (if org-indent-mode - (progn - (or org-indent-strings (org-indent-initialize)) - (when org-indent-mode-turns-off-org-adapt-indentation - (org-set-local 'org-adapt-indentation nil)) - (when org-indent-mode-turns-on-hiding-stars - (org-set-local 'org-hide-leading-stars-before-indent-mode - org-hide-leading-stars) - (org-set-local 'org-hide-leading-stars t)) - (make-local-variable 'buffer-substring-filters) - (add-to-list 'buffer-substring-filters - 'org-indent-remove-properties-from-string) - (org-add-hook 'org-after-demote-entry-hook - 'org-indent-refresh-section nil 'local) - (org-add-hook 'org-after-promote-entry-hook - 'org-indent-refresh-section nil 'local) - (org-add-hook 'org-font-lock-hook - 'org-indent-refresh-to nil 'local) - (and font-lock-mode (org-restart-font-lock)) - ) - (save-excursion - (save-restriction - (org-indent-remove-properties (point-min) (point-max)) - (kill-local-variable 'org-adapt-indentation) - (when (boundp 'org-hide-leading-stars-before-indent-mode) - (org-set-local 'org-hide-leading-stars - org-hide-leading-stars-before-indent-mode)) - (setq buffer-substring-filters - (delq 'org-indent-remove-properties-from-string - buffer-substring-filters)) - (remove-hook 'org-after-promote-entry-hook - 'org-indent-refresh-section 'local) - (remove-hook 'org-after-demote-entry-hook - 'org-indent-refresh-section 'local) - (and font-lock-mode (org-restart-font-lock)) - (redraw-display)))))) + (cond + ((org-bound-and-true-p org-inhibit-startup) + (setq org-indent-mode nil)) + ((and org-indent-mode (featurep 'xemacs)) + (message "org-indent-mode does not work in XEmacs - refusing to turn it on") + (setq org-indent-mode nil)) + ((and org-indent-mode + (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) + (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!") + (ding) + (sit-for 1) + (setq org-indent-mode nil)) + (org-indent-mode + ;; mode was turned on. + (org-set-local 'indent-tabs-mode nil) + (or org-indent-strings (org-indent-initialize)) + (when org-indent-mode-turns-off-org-adapt-indentation + (org-set-local 'org-adapt-indentation nil)) + (when org-indent-mode-turns-on-hiding-stars + (org-set-local 'org-hide-leading-stars-before-indent-mode + org-hide-leading-stars) + (org-set-local 'org-hide-leading-stars t)) + (make-local-variable 'buffer-substring-filters) + (add-to-list 'buffer-substring-filters + 'org-indent-remove-properties-from-string) + (org-add-hook 'org-after-demote-entry-hook + 'org-indent-refresh-section nil 'local) + (org-add-hook 'org-after-promote-entry-hook + 'org-indent-refresh-section nil 'local) + (org-add-hook 'org-font-lock-hook + 'org-indent-refresh-to nil 'local) + (and font-lock-mode (org-restart-font-lock)) + ) + (t + ;; mode was turned off (or we refused to turn it on) + (save-excursion + (save-restriction + (org-indent-remove-properties (point-min) (point-max)) + (kill-local-variable 'org-adapt-indentation) + (when (boundp 'org-hide-leading-stars-before-indent-mode) + (org-set-local 'org-hide-leading-stars + org-hide-leading-stars-before-indent-mode)) + (setq buffer-substring-filters + (delq 'org-indent-remove-properties-from-string + buffer-substring-filters)) + (remove-hook 'org-after-promote-entry-hook + 'org-indent-refresh-section 'local) + (remove-hook 'org-after-demote-entry-hook + 'org-indent-refresh-section 'local) + (and font-lock-mode (org-restart-font-lock)) + (redraw-display)))))) (defface org-indent @@ -186,8 +207,9 @@ useful to make it ever so slightly different." (defun org-indent-remove-properties (beg end) "Remove indentations between BEG and END." - (org-unmodified - (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) + (let ((inhibit-modification-hooks t)) + (with-silent-modifications + (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))) (defun org-indent-remove-properties-from-string (string) "Remove indentations between BEG and END." @@ -201,34 +223,49 @@ useful to make it ever so slightly different." (defun org-indent-add-properties (beg end) "Add indentation properties between BEG and END. Assumes that BEG is at the beginning of a line." - (when (or t org-indent-mode) - (let (ov b e n level exit nstars) - (org-unmodified - (save-excursion - (goto-char beg) - (while (not exit) - (setq e end) - (if (not (re-search-forward org-indent-outline-re nil t)) - (setq e (point-max) exit t) - (setq e (match-beginning 0)) - (if (>= e end) (setq exit t)) - (setq level (- (match-end 0) (match-beginning 0) 1)) - (setq nstars (- (* (1- level) org-indent-indentation-per-level) - (1- level))) - (add-text-properties - (point-at-bol) (point-at-eol) - (list 'line-prefix - (aref org-indent-stars nstars) - 'wrap-prefix - (aref org-indent-strings - (* level org-indent-indentation-per-level))))) - (when (and b (> e b)) - (add-text-properties - b e (list 'line-prefix (aref org-indent-strings n) - 'wrap-prefix (aref org-indent-strings n)))) - (setq b (1+ (point-at-eol)) - n (* level org-indent-indentation-per-level)))))))) + (let* ((inhibit-modification-hooks t) + (inlinetaskp (featurep 'org-inlinetask)) + (get-real-level (lambda (pos lvl) + (save-excursion + (goto-char pos) + (if (and inlinetaskp (org-inlinetask-in-task-p)) + (org-inlinetask-get-task-level) + lvl)))) + (b beg) + (e end) + (level 0) + (n 0) + exit nstars) + (with-silent-modifications + (save-excursion + (goto-char beg) + (while (not exit) + (setq e end) + (if (not (re-search-forward org-indent-outline-re nil t)) + (setq e (point-max) exit t) + (setq e (match-beginning 0)) + (if (>= e end) (setq exit t)) + (unless (and inlinetaskp (org-inlinetask-in-task-p)) + (setq level (- (match-end 0) (match-beginning 0) 1))) + (setq nstars (* (1- (funcall get-real-level e level)) + (1- org-indent-indentation-per-level))) + (add-text-properties + (point-at-bol) (point-at-eol) + (list 'line-prefix + (aref org-indent-stars nstars) + 'wrap-prefix + (aref org-indent-strings + (* (funcall get-real-level e level) + org-indent-indentation-per-level))))) + (when (> e b) + (add-text-properties + b e (list 'line-prefix (aref org-indent-strings n) + 'wrap-prefix (aref org-indent-strings n)))) + (setq b (1+ (point-at-eol)) + n (* (funcall get-real-level b level) + org-indent-indentation-per-level))))))) +(defvar org-inlinetask-min-level) (defun org-indent-refresh-section () "Refresh indentation properties in the current outline section. Point is assumed to be at the beginning of a headline." @@ -236,7 +273,11 @@ Point is assumed to be at the beginning of a headline." (when org-indent-mode (let (beg end) (save-excursion - (when (ignore-errors (org-back-to-heading)) + (when (ignore-errors (let ((outline-regexp (format "\\*\\{1,%s\\}[ \t]+" + (if (featurep 'org-inlinetask) + (1- org-inlinetask-min-level) + "")))) + (org-back-to-heading))) (setq beg (point)) (setq end (or (save-excursion (or (outline-next-heading) (point))))) (org-indent-remove-properties beg end) @@ -249,7 +290,11 @@ Point is assumed to be at the beginning of a headline." (when org-indent-mode (let ((beg (point)) (end limit)) (save-excursion - (and (ignore-errors (org-back-to-heading t)) + (and (ignore-errors (let ((outline-regexp (format "\\*\\{1,%s\\}[ \t]+" + (if (featurep 'org-inlinetask) + (1- org-inlinetask-min-level) + "")))) + (org-back-to-heading))) (setq beg (point)))) (org-indent-remove-properties beg end) (org-indent-add-properties beg end))) diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index edc2476c343..f3a4bddbc48 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 5911acb88a5..12b5b5655a1 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; and properties. However, these nodes are treated specially by the ;; visibility cycling and export commands. ;; -;; Visibility cycling exempts these nodes from cycling. So whenever their +;; Visibility cycling exempts these nodes from cycling. So whenever their ;; parent is opened, so are these tasks. This will only work with ;; `org-cycle', so if you are also using other commands to show/hide ;; entries, you will occasionally find these tasks to behave like @@ -74,8 +74,7 @@ ;; ;; C-c C-x t Insert a new inline task with END line - -;;; Code +;;; Code: (require 'org) @@ -91,31 +90,151 @@ or to a number smaller than this one. In fact, when `org-cycle-max-level' is not set, it will be assumed to be one less than the value of smaller than the value of this variable." :group 'org-inlinetask - :type 'boolean) + :type '(choice + (const :tag "Off" nil) + (integer))) (defcustom org-inlinetask-export t - "Non-nil means, export inline tasks. + "Non-nil means export inline tasks. When nil, they will not be exported." :group 'org-inlinetask :type 'boolean) +(defvar org-inlinetask-export-templates + '((html "<pre class=\"inlinetask\"><b>%s%s</b><br>%s</pre>" + '((unless (eq todo "") + (format "<span class=\"%s %s\">%s%s</span> " + class todo todo priority)) + heading content)) + (latex "\\begin\{description\}\\item[%s%s]%s\\end\{description\}" + '((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority)) + heading content)) + (ascii " -- %s%s%s" + '((unless (eq todo "") (format "%s%s " todo priority)) + heading + (unless (eq content "") + (format "\n ¦ %s" + (mapconcat 'identity (org-split-string content "\n") + "\n ¦ "))))) + (docbook "<variablelist> +<varlistentry> +<term>%s%s</term> +<listitem><para>%s</para></listitem> +</varlistentry> +</variablelist>" + '((unless (eq todo "") (format "%s%s " todo priority)) + heading content))) + "Templates for inline tasks in various exporters. + +This variable is an alist in the shape of (BACKEND STRING OBJECTS). + +BACKEND is the name of the backend for the template (ascii, html...). + +STRING is a format control string. + +OBJECTS is a list of elements to be substituted into the format +string. They can be of any type, from a string to a form +returning a value (thus allowing conditional insertion). A nil +object will be substituted as the empty string. Obviously, there +must be at least as many objects as %-sequences in the format +string. + +Moreover, the following special keywords are provided: `todo', +`priority', `heading', `content', `tags'. If some of them are not +defined in an inline task, their value is the empty string. + +As an example, valid associations are: + +(html \"<ul><li>%s <p>%s</p></li></ul>\" (heading content)) + +or, with the additional package \"todonotes\" for LaTeX, + +(latex \"\\todo[inline]{\\textbf{\\textsf{%s %s}}\\linebreak{} %s}\" + '((unless (eq todo \"\") + (format \"\\textsc{%s%s}\" todo priority)) + heading content)))") + (defvar org-odd-levels-only) (defvar org-keyword-time-regexp) (defvar org-drawer-regexp) (defvar org-complex-heading-regexp) (defvar org-property-end-re) -(defun org-inlinetask-insert-task () - "Insert an inline task." - (interactive) +(defcustom org-inlinetask-default-state nil + "Non-nil means make inline tasks have a TODO keyword initially. +This should be the state `org-inlinetask-insert-task' should use by +default, or nil of no state should be assigned." + :group 'org-inlinetask + :type '(choice + (const :tag "No state" nil) + (string :tag "Specific state"))) + +(defun org-inlinetask-insert-task (&optional no-state) + "Insert an inline task. +If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'." + (interactive "P") (or (bolp) (newline)) - (insert (make-string org-inlinetask-min-level ?*) " \n" - (make-string org-inlinetask-min-level ?*) " END\n") + (let ((indent org-inlinetask-min-level)) + (if org-odd-levels-only + (setq indent (- (* 2 indent) 1))) + (insert (make-string indent ?*) + (if (or no-state (not org-inlinetask-default-state)) + " \n" + (concat " " org-inlinetask-default-state " \n")) + (make-string indent ?*) " END\n")) (end-of-line -1)) (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) -(defvar htmlp) ; dynamically scoped into the next function -(defvar latexp) ; dynamically scoped into the next function +(defun org-inlinetask-outline-regexp () + "Return string matching an inline task heading. +The number of levels is controlled by `org-inlinetask-min-level'." + (let ((nstars (if org-odd-levels-only + (1- (* org-inlinetask-min-level 2)) + org-inlinetask-min-level))) + (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars))) + +(defun org-inlinetask-in-task-p () + "Return true if point is inside an inline task." + (save-excursion + (let* ((stars-re (org-inlinetask-outline-regexp)) + (task-beg-re (concat stars-re "\\(?:.*\\)")) + (task-end-re (concat stars-re "\\(?:END\\|end\\)[ \t]*$"))) + (beginning-of-line) + (or (looking-at task-beg-re) + (and (re-search-forward "^\\*+[ \t]+" nil t) + (progn (beginning-of-line) (looking-at task-end-re))))))) + +(defun org-inlinetask-goto-beginning () + "Go to the beginning of the inline task at point." + (end-of-line) + (re-search-backward (org-inlinetask-outline-regexp) nil t) + (when (org-looking-at-p (concat (org-inlinetask-outline-regexp) "END[ \t]*$")) + (re-search-backward (org-inlinetask-outline-regexp) nil t))) + +(defun org-inlinetask-goto-end () + "Go to the end of the inline task at point." + (beginning-of-line) + (cond + ((org-looking-at-p (concat (org-inlinetask-outline-regexp) "END[ \t]*$")) + (forward-line 1)) + ((org-looking-at-p (org-inlinetask-outline-regexp)) + (forward-line 1) + (when (org-inlinetask-in-task-p) + (re-search-forward (org-inlinetask-outline-regexp) nil t) + (forward-line 1))) + (t + (re-search-forward (org-inlinetask-outline-regexp) nil t) + (forward-line 1)))) + +(defun org-inlinetask-get-task-level () + "Get the level of the inline task around. +This assumes the point is inside an inline task." + (save-excursion + (end-of-line) + (re-search-backward (org-inlinetask-outline-regexp) nil t) + (- (match-end 1) (match-beginning 1)))) + +(defvar backend) ; dynamically scoped into the next function (defun org-inlinetask-export-handler () "Handle headlines with level larger or equal to `org-inlinetask-min-level'. Either remove headline and meta data, or do special formatting." @@ -125,7 +244,7 @@ Either remove headline and meta data, or do special formatting." (or org-inlinetask-min-level 200))) (re1 (format "^\\(\\*\\{%d,\\}\\) .*\n" nstars)) (re2 (concat "^[ \t]*" org-keyword-time-regexp)) - headline beg end stars content indent) + headline beg end stars content) (while (re-search-forward re1 nil t) (setq headline (match-string 0) stars (match-string 1) @@ -146,30 +265,34 @@ Either remove headline and meta data, or do special formatting." (delete-region beg (1+ (match-end 0)))) (goto-char beg) (when org-inlinetask-export - (when (string-match org-complex-heading-regexp headline) - (setq headline (concat - (if (match-end 2) - (concat (match-string 2 headline) " ") "") - (match-string 4 headline))) - (when content + ;; content formatting + (when content (if (not (string-match "\\S-" content)) (setq content nil) (if (string-match "[ \t\n]+\\'" content) (setq content (substring content 0 (match-beginning 0)))) - (setq content (org-remove-indentation content)) - (if latexp (setq content (concat "\\quad \\\\\n" content))))) - (insert (make-string (org-inlinetask-get-current-indentation) ?\ ) - "- ") - (setq indent (make-string (current-column) ?\ )) - (insert headline " ::") - (if content - (insert (if htmlp " " (concat "\n" indent)) - (mapconcat 'identity (org-split-string content "\n") - (concat "\n" indent)) "\n") - (insert "\n")) - (insert indent) - (backward-delete-char 2) - (insert "THISISTHEINLINELISTTEMINATOR\n")))))) + (setq content (org-remove-indentation content)))) + (setq content (or content "")) + ;; grab elements to export + (when (string-match org-complex-heading-regexp headline) + (let* ((todo (or (match-string 2 headline) "")) + (class (or (and (eq "" todo) "") + (if (member todo org-done-keywords) "done" "todo"))) + (priority (or (match-string 3 headline) "")) + (heading (or (match-string 4 headline) "")) + (tags (or (match-string 5 headline) "")) + (backend-spec (assq backend org-inlinetask-export-templates)) + (format-str (nth 1 backend-spec)) + (tokens (cadr (nth 2 backend-spec))) + ;; change nil arguments into empty strings + (nil-to-str (lambda (el) (or (eval el) ""))) + ;; build and protect export string + (export-str (org-add-props + (eval (append '(format format-str) + (mapcar nil-to-str tokens))) + nil 'org-protected t))) + ;; eventually insert it + (insert export-str "\n"))))))) (defun org-inlinetask-get-current-indentation () "Get the indentation of the last non-while line above this one." @@ -204,33 +327,12 @@ Either remove headline and meta data, or do special formatting." org-inlinetask-min-level)) (replace-match ""))) -(defun org-inlinetask-remove-terminator () - (let (beg end) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "THISISTHEINLINELISTTEMINATOR\n" nil t) - (setq beg (match-beginning 0) end (match-end 0)) - (save-excursion - (beginning-of-line 1) - (and (looking-at "<p\\(ara\\)?>THISISTHEINLINELISTTEMINATOR[ \t\n]*</p\\(ara\\)?>") - (setq beg (point) end (match-end 0)))) - (delete-region beg end))))) - (eval-after-load "org-exp" '(add-hook 'org-export-preprocess-after-tree-selection-hook 'org-inlinetask-export-handler)) (eval-after-load "org" '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)) -(eval-after-load "org-html" - '(add-hook 'org-export-html-final-hook 'org-inlinetask-remove-terminator)) -(eval-after-load "org-latex" - '(add-hook 'org-export-latex-final-hook 'org-inlinetask-remove-terminator)) -(eval-after-load "org-ascii" - '(add-hook 'org-export-ascii-final-hook 'org-inlinetask-remove-terminator)) -(eval-after-load "org-docbook" - '(add-hook 'org-export-docbook-final-hook 'org-inlinetask-remove-terminator)) (provide 'org-inlinetask) -;; arch-tag: 59fdac51-8bcc-469e-a21e-6897dd6697bb ;;; org-inlinetask.el ends here diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 5d836347335..f5a6e8168a3 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -4,7 +4,7 @@ ;; ;; Author: Philip Jackson <emacs@shellarchive.co.uk> ;; Keywords: erc, irc, link, org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el index 48dff626e49..edd13be2b92 100644 --- a/lisp/org/org-jsinfo.el +++ b/lisp/org/org-jsinfo.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -26,12 +26,12 @@ ;; ;;; Commentary: -;; This file implements the support for Sebastian Rose's Javascript +;; This file implements the support for Sebastian Rose's JavaScript ;; org-info.js to display an org-mode file exported to HTML in an ;; Info-like way, or using folding similar to the outline structure ;; org org-mode itself. -;; Documentation for using this module is in the Org manual. The script +;; Documentation for using this module is in the Org manual. The script ;; itself is documented by Sebastian Rose in a file distributed with ;; the script. FIXME: Accurate pointers! @@ -87,7 +87,7 @@ line in the buffer. See also the variable `org-infojs-options'." (defcustom org-infojs-options (mapcar (lambda (x) (cons (car x) (nth 2 x))) org-infojs-opts-table) - "Options settings for the INFOJS Javascript. + "Options settings for the INFOJS JavaScript. Each of the options must have an entry in `org-export-html/infojs-opts-table'. The value can either be a string that will be passed to the script, or a property. This property is then assumed to be a property that is defined diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el index 17a3c5007f9..7f07052ee54 100644 --- a/lisp/org/org-latex.el +++ b/lisp/org/org-latex.el @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-latex.el -;; Version: 6.33x +;; Version: 7.4 ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -50,9 +50,11 @@ (require 'org) (require 'org-exp) (require 'org-macs) +(require 'org-beamer) ;;; Variables: (defvar org-export-latex-class nil) +(defvar org-export-latex-class-options nil) (defvar org-export-latex-header nil) (defvar org-export-latex-append-header nil) (defvar org-export-latex-options-plist nil) @@ -89,53 +91,30 @@ (defcustom org-export-latex-classes '(("article" - "\\documentclass[11pt]{article} -\\usepackage[utf8]{inputenc} -\\usepackage[T1]{fontenc} -\\usepackage{graphicx} -\\usepackage{longtable} -\\usepackage{float} -\\usepackage{wrapfig} -\\usepackage{soul} -\\usepackage{amssymb} -\\usepackage{hyperref}" + "\\documentclass[11pt]{article}" ("\\section{%s}" . "\\section*{%s}") ("\\subsection{%s}" . "\\subsection*{%s}") ("\\subsubsection{%s}" . "\\subsubsection*{%s}") ("\\paragraph{%s}" . "\\paragraph*{%s}") ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) ("report" - "\\documentclass[11pt]{report} -\\usepackage[utf8]{inputenc} -\\usepackage[T1]{fontenc} -\\usepackage{graphicx} -\\usepackage{longtable} -\\usepackage{float} -\\usepackage{wrapfig} -\\usepackage{soul} -\\usepackage{amssymb} -\\usepackage{hyperref}" + "\\documentclass[11pt]{report}" ("\\part{%s}" . "\\part*{%s}") ("\\chapter{%s}" . "\\chapter*{%s}") ("\\section{%s}" . "\\section*{%s}") ("\\subsection{%s}" . "\\subsection*{%s}") ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) ("book" - "\\documentclass[11pt]{book} -\\usepackage[utf8]{inputenc} -\\usepackage[T1]{fontenc} -\\usepackage{graphicx} -\\usepackage{longtable} -\\usepackage{float} -\\usepackage{wrapfig} -\\usepackage{soul} -\\usepackage{amssymb} -\\usepackage{hyperref}" + "\\documentclass[11pt]{book}" ("\\part{%s}" . "\\part*{%s}") ("\\chapter{%s}" . "\\chapter*{%s}") ("\\section{%s}" . "\\section*{%s}") ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))) + ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) + ("beamer" + "\\documentclass{beamer}" + org-beamer-sectioning + )) "Alist of LaTeX classes and associated header and structure. If #+LaTeX_CLASS is set in the buffer, use its value and the associated information. Here is the structure of each cell: @@ -145,11 +124,60 @@ associated information. Here is the structure of each cell: (numbered-section . unnumbered-section\) ...\) -A %s formatter is mandatory in each section string and will be -replaced by the title of the section. +The header string +----------------- + +The HEADER-STRING is the header that will be inserted into the LaTeX file. +It should contain the \\documentclass macro, and anything else that is needed +for this setup. To this header, the following commands will be added: + +- Calls to \\usepackage for all packages mentioned in the variables + `org-export-latex-default-packages-alist' and + `org-export-latex-packages-alist'. Thus, your header definitions should + avoid to also request these packages. + +- Lines specified via \"#+LaTeX_HEADER:\" + +If you need more control about the sequence in which the header is built +up, or if you want to exclude one of these building blocks for a particular +class, you can use the following macro-like placeholders. + + [DEFAULT-PACKAGES] \\usepackage statements for default packages + [NO-DEFAULT-PACKAGES] do not include any of the default packages + [PACKAGES] \\usepackage statements for packages + [NO-PACKAGES] do not include the packages + [EXTRA] the stuff from #+LaTeX_HEADER + [NO-EXTRA] do not include #+LaTeX_HEADER stuff + [BEAMER-HEADER-EXTRA] the beamer extra headers + +So a header like + + \\documentclass{article} + [NO-DEFAULT-PACKAGES] + [EXTRA] + \\providecommand{\\alert}[1]{\\textbf{#1}} + [PACKAGES] + +will omit the default packages, and will include the #+LaTeX_HEADER lines, +then have a call to \\providecommand, and then place \\usepackage commands +based on the content of `org-export-latex-packages-alist'. + +If your header or `org-export-latex-default-packages-alist' inserts +\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be replaced with +a coding system derived from `buffer-file-coding-system'. See also the +variable `org-export-latex-inputenc-alist' for a way to influence this +mechanism. + +The sectioning structure +------------------------ + +The sectioning structure of the class is given by the elements following +the header string. For each sectioning level, a number of strings is +specified. A %s formatter is mandatory in each section string and will +be replaced by the title of the section. Instead of a cons cell (numbered . unnumbered), you can also provide a list -of 2-4 elements, +of 2 or 4 elements, (numbered-open numbered-close) @@ -157,9 +185,15 @@ or (numbered-open numbered-close unnumbered-open unnumbered-close) -providing opening and closing strings for an environment that should +providing opening and closing strings for a LaTeX environment that should represent the document section. The opening clause should have a %s -to represent the section title." +to represent the section title. + +Instead of a list of sectioning commands, you can also specify a +function name. That function will be called with two parameters, +the (reduced) level of the headline, and the headline text. The function +must return a cons cell with the (possibly modified) headline text, and the +sectioning list in the cdr." :group 'org-export-latex :type '(repeat (list (string :tag "LaTeX class") @@ -167,13 +201,29 @@ to represent the section title." (repeat :tag "Levels" :inline t (choice (cons :tag "Heading" - (string :tag "numbered") - (string :tag "unnumbered)")) + (string :tag " numbered") + (string :tag "unnumbered")) (list :tag "Environment" - (string :tag "Opening (numbered) ") - (string :tag "Closing (numbered) ") + (string :tag "Opening (numbered)") + (string :tag "Closing (numbered)") (string :tag "Opening (unnumbered)") - (string :tag "Closing (unnumbered)"))))))) + (string :tag "Closing (unnumbered)")) + (function :tag "Hook computing sectioning")))))) + +(defcustom org-export-latex-inputenc-alist nil + "Alist of inputenc coding system names, and what should really be used. +For example, adding an entry + + (\"utf8\" . \"utf8x\") + +will cause \\usepackage[utf8x]{inputenc} to be used for buffers that +are written as utf8 files." + :group 'org-export-latex + :type '(repeat + (cons + (string :tag "Derived from buffer") + (string :tag "Use this instead")))) + (defcustom org-export-latex-emphasis-alist '(("*" "\\textbf{%s}" nil) @@ -230,6 +280,11 @@ markup defined, the first one in the association list will be used." (string :tag "Keyword") (string :tag "Markup"))))) +(defcustom org-export-latex-tag-markup "\\textbf{%s}" + "Markup for tags, as a printf format." + :group 'org-export-latex + :type 'string) + (defcustom org-export-latex-timestamp-markup "\\textit{%s}" "A printf format string to be applied to time stamps." :group 'org-export-latex @@ -240,6 +295,20 @@ markup defined, the first one in the association list will be used." :group 'org-export-latex :type 'string) +(defcustom org-export-latex-href-format "\\href{%s}{%s}" + "A printf format string to be applied to href links. +The format must contain two %s instances. The first will be filled with +the link, the second with the link description." + :group 'org-export-latex + :type 'string) + +(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}" + "A printf format string to be applied to hyperref links. +The format must contain two %s instances. The first will be filled with +the link, the second with the link description." + :group 'org-export-latex + :type 'string) + (defcustom org-export-latex-tables-verbatim nil "When non-nil, tables are exported verbatim." :group 'org-export-latex @@ -305,7 +374,7 @@ Defaults to \\begin{verbatim} and \\end{verbatim}." (string :tag "Close"))) (defcustom org-export-latex-listings nil - "Non-nil means, export source code using the listings package. + "Non-nil means export source code using the listings package. This package will fontify source code, possibly even with color. If you want to use this, you also need to make LaTeX use the listings package, and if you want to have color, the color @@ -314,12 +383,30 @@ for example using customize, or with something like (require 'org-latex) (add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\")) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\"))" + (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\")) + +Alternatively, + + (setq org-export-latex-listings 'minted) + +causes source code to be exported using the minted package as +opposed to listings. If you want to use minted, you need to add +the minted package to `org-export-latex-packages-alist', for +example using customize, or with + + (require 'org-latex) + (add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\")) + +In addition, it is neccessary to install +pygments (http://pygments.org), and to configure +`org-latex-to-pdf-process' so that the -shell-escape option is +passed to pdflatex. +" :group 'org-export-latex :type 'boolean) (defcustom org-export-latex-listings-langs - '((emacs-lisp "Lisp") (lisp "Lisp") + '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") (c "C") (cc "C++") (fortran "fortran") (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") @@ -328,7 +415,7 @@ for example using customize, or with something like (shell-script "bash") (gnuplot "Gnuplot") (ocaml "Caml") (caml "Caml") - (sql "SQL")) + (sql "SQL") (sqlite "sql")) "Alist mapping languages to their listing language counterpart. The key is a symbol, the major mode symbol without the \"-mode\". The value is the string that should be inserted as the language parameter @@ -341,9 +428,41 @@ hurt if it is present." (symbol :tag "Major mode ") (string :tag "Listings language")))) +(defcustom org-export-latex-listings-w-names t + "Non-nil means export names of named code blocks. +Code blocks exported with the listings package (controlled by the +`org-export-latex-listings' variable) can be named in the style +of noweb." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-export-latex-minted-langs + '((emacs-lisp "common-lisp") + (cc "c++") + (cperl "perl") + (shell-script "bash") + (caml "ocaml")) + "Alist mapping languages to their minted language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language parameter +for the minted package. If the mode name and the listings name are +the same, the language does not need an entry in this list - but it does not +hurt if it is present. + +Note that minted uses all lower case for language identifiers, +and that the full list of language identifiers can be obtained +with: +pygmentize -L lexers +" + :group 'org-export-latex + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) + (defcustom org-export-latex-remove-from-headlines '(:todo nil :priority nil :tags nil) - "A plist of keywords to remove from headlines. OBSOLETE. + "A plist of keywords to remove from headlines. OBSOLETE. Non-nil means remove this keyword type from the headline. Don't remove the keys, just change their values. @@ -359,6 +478,11 @@ and `org-export-with-tags' instead." :group 'org-export-latex :type 'string) +(defcustom org-export-latex-tabular-environment "tabular" + "Default environment used to build tables." + :group 'org-export-latex + :type 'string) + (defcustom org-export-latex-inline-image-extensions '("pdf" "jpeg" "jpg" "png" "ps" "eps") "Extensions of image files that can be inlined into LaTeX. @@ -370,50 +494,93 @@ allowed. The default we use here encompasses both." :type '(repeat (string :tag "Extension"))) (defcustom org-export-latex-coding-system nil - "Coding system for the exported LaTex file." + "Coding system for the exported LaTeX file." :group 'org-export-latex :type 'coding-system) (defgroup org-export-pdf nil "Options for exporting Org-mode files to PDF, via LaTeX." - :tag "Org Export LaTeX" + :tag "Org Export PDF" :group 'org-export-latex :group 'org-export) (defcustom org-latex-to-pdf-process - '("pdflatex -interaction nonstopmode %s" - "pdflatex -interaction nonstopmode %s") + '("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f") "Commands to process a LaTeX file to a PDF file. This is a list of strings, each of them will be given to the shell -as a command. %s in the command will be replaced by the full file name, %b -by the file base name (i.e. without extension). +as a command. %f in the command will be replaced by the full file name, %b +by the file base name (i.e. without extension) and %o by the base directory +of the file. + The reason why this is a list is that it usually takes several runs of -pdflatex, maybe mixed with a call to bibtex. Org does not have a clever +`pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever mechanism to detect which of these commands have to be run to get to a stable result, and it also does not do any error checking. +By default, Org uses 3 runs of `pdflatex' to do the processing. If you +have texi2dvi on your system and if that does not cause the infamous +egrep/locale bug: + + http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html + +then `texi2dvi' is the superior choice. Org does offer it as one +of the customize options. + Alternatively, this may be a Lisp function that does the processing, so you could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode. This function should accept the file name as its single argument." - :group 'org-export-latex - :type '(choice (repeat :tag "Shell command sequence" + :group 'org-export-pdf + :type '(choice + (repeat :tag "Shell command sequence" (string :tag "Shell command")) - (function))) + (const :tag "2 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "3 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "pdflatex,bibtex,pdflatex,pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "bibtex %b" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "texi2dvi" + ("texi2dvi -p -b -c -V %f")) + (const :tag "rubber" + ("rubber -d --into %o %f")) + (function))) + +(defcustom org-export-pdf-logfiles + '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") + "The list of file extensions to consider as LaTeX logfiles." + :group 'org-export-pdf + :type '(repeat (string :tag "Extension"))) (defcustom org-export-pdf-remove-logfiles t - "Non-nil means, remove the logfiles produced by PDF production. + "Non-nil means remove the logfiles produced by PDF production. These are the .aux, .log, .out, and .toc files." :group 'org-export-pdf :type 'boolean) ;;; Hooks +(defvar org-export-latex-after-initial-vars-hook nil + "Hook run before LaTeX export. +The exact moment is after the initial variables like org-export-latex-class +have been determined from the environment.") + (defvar org-export-latex-after-blockquotes-hook nil "Hook run during LaTeX export, after blockquote, verse, center are done.") (defvar org-export-latex-final-hook nil "Hook run in the finalized LaTeX buffer.") +(defvar org-export-latex-after-save-hook nil + "Hook run in the finalized LaTeX buffer, after it has been saved.") + ;;; Autoload functions: ;;;###autoload @@ -510,10 +677,13 @@ non-nil, create a buffer with that name and export to that buffer. If TO-BUFFER is the symbol `string', don't leave any buffer behind but just return the resulting LaTeX as a string. When BODY-ONLY is set, don't produce the file header and footer, -simply return the content of \begin{document}...\end{document}, -without even the \begin{document} and \end{document} commands. +simply return the content of \\begin{document}...\\end{document}, +without even the \\begin{document} and \\end{document} commands. when PUB-DIR is set, use this as the publishing directory." (interactive "P") + (when (and (not body-only) arg (listp arg)) (setq body-only t)) + (run-hooks 'org-export-first-hook) + ;; Make sure we have a file name when we need it. (when (and (not (or to-buffer body-only)) (not buffer-file-name)) @@ -525,10 +695,14 @@ when PUB-DIR is set, use this as the publishing directory." (message "Exporting to LaTeX...") (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill nil))) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) + '(:org-license-to-kill nil)))) (org-update-radio-target-regexp) (org-export-latex-set-initial-vars ext-plist arg) + (setq org-export-opt-plist org-export-latex-options-plist) + (org-install-letbind) + (run-hooks 'org-export-latex-after-initial-vars-hook) (let* ((wcf (current-window-configuration)) (opt-plist org-export-latex-options-plist) (region-p (org-region-active-p)) @@ -547,27 +721,40 @@ when PUB-DIR is set, use this as the publishing directory." (org-export-add-subtree-options opt-plist rbeg) opt-plist))) ;; Make sure the variable contains the updated values. - (org-export-latex-options-plist opt-plist) + (org-export-latex-options-plist (setq org-export-opt-plist opt-plist)) + ;; The following two are dynamically scoped into other + ;; routines below. + (org-current-export-dir + (or pub-dir (org-export-directory :html opt-plist))) + (org-current-export-file buffer-file-name) (title (or (and subtree-p (org-export-get-title-from-subtree)) (plist-get opt-plist :title) (and (not (plist-get opt-plist :skip-before-1st-heading)) (org-export-grab-title-from-buffer)) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)))) - (filename (concat (file-name-as-directory - (or pub-dir - (org-export-directory :LaTeX ext-plist))) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get rbeg "EXPORT_FILE_NAME" t)) - (file-name-nondirectory ;sans-extension - buffer-file-name))) - ".tex")) - (filename (if (equal (file-truename filename) - (file-truename buffer-file-name)) - (concat filename ".tex") - filename)) + (and buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name))) + "No Title")) + (filename + (and (not to-buffer) + (concat + (file-name-as-directory + (or pub-dir + (org-export-directory :LaTeX ext-plist))) + (file-name-sans-extension + (or (and subtree-p + (org-entry-get rbeg "EXPORT_FILE_NAME" t)) + (file-name-nondirectory ;sans-extension + (or buffer-file-name + (error "Don't know which export file to use"))))) + ".tex"))) + (filename + (and filename + (if (equal (file-truename filename) + (file-truename (or buffer-file-name "dummy.org"))) + (concat filename ".tex") + filename))) (buffer (if to-buffer (cond ((eq to-buffer 'string) (get-buffer-create @@ -602,6 +789,24 @@ when PUB-DIR is set, use this as the publishing directory." (region (buffer-substring (if region-p (region-beginning) (point-min)) (if region-p (region-end) (point-max)))) + (text + (and text (string-match "\\S-" text) + (org-export-preprocess-string + text + :emph-multiline t + :for-LaTeX t + :comments nil + :tags (plist-get opt-plist :tags) + :priority (plist-get opt-plist :priority) + :footnotes (plist-get opt-plist :footnotes) + :drawers (plist-get opt-plist :drawers) + :timestamps (plist-get opt-plist :timestamps) + :todo-keywords (plist-get opt-plist :todo-keywords) + :add-text nil + :skip-before-1st-heading skip + :select-tags nil + :exclude-tags nil + :LaTeX-fragments nil))) (string-for-export (org-export-preprocess-string region @@ -656,6 +861,11 @@ when PUB-DIR is set, use this as the publishing directory." ;; finalization (unless body-only (insert "\n\\end{document}")) + ;; Attach description terms to the \item macro + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*\\\\item\\([ \t]+\\)\\[" nil t) + (delete-region (match-beginning 1) (match-end 1))) + ;; Relocate the table of contents (goto-char (point-min)) (when (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t) @@ -666,8 +876,25 @@ when PUB-DIR is set, use this as the publishing directory." (and (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t) (replace-match "\\tableofcontents" t t))) + ;; Cleanup forced line ends in items where they are not needed + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*\n\\\\begin" + nil t) + (delete-region (match-beginning 1) (match-end 1))) + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*" + nil t) + (if (looking-at "[\n \t]+") + (replace-match "\n"))) + (run-hooks 'org-export-latex-final-hook) - (or to-buffer (save-buffer)) + (if to-buffer + (unless (eq major-mode 'latex-mode) (latex-mode)) + (save-buffer)) + (org-export-latex-fix-inputenc) + (run-hooks 'org-export-latex-after-save-hook) (goto-char (point-min)) (or (org-export-push-to-kill-ring "LaTeX") (message "Exporting to LaTeX...done")) @@ -696,12 +923,12 @@ when PUB-DIR is set, use this as the publishing directory." (save-excursion (goto-char (point-min)) (re-search-forward "\\\\bibliography{" nil t)))) - cmd) + cmd output-dir errors) (with-current-buffer outbuf (erase-buffer)) - (and (file-exists-p pdffile) (delete-file pdffile)) - (message "Processing LaTeX file...") + (message (concat "Processing LaTeX file " file "...")) + (setq output-dir (file-name-directory file)) (if (and cmds (symbolp cmds)) - (funcall cmds file) + (funcall cmds (shell-quote-argument file)) (while cmds (setq cmd (pop cmds)) (while (string-match "%b" cmd) @@ -709,30 +936,64 @@ when PUB-DIR is set, use this as the publishing directory." (save-match-data (shell-quote-argument base)) t t cmd))) - (while (string-match "%s" cmd) + (while (string-match "%f" cmd) (setq cmd (replace-match (save-match-data (shell-quote-argument file)) t t cmd))) - (shell-command cmd outbuf outbuf))) - (message "Processing LaTeX file...done") + (while (string-match "%o" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument output-dir)) + t t cmd))) + (shell-command cmd outbuf))) + (message (concat "Processing LaTeX file " file "...done")) + (setq errors (org-export-latex-get-error outbuf)) (if (not (file-exists-p pdffile)) - (error "PDF file was not produced") + (error (concat "PDF file " pdffile " was not produced" + (if errors (concat ":" errors "") ""))) (set-window-configuration wconfig) (when org-export-pdf-remove-logfiles - (dolist (ext '("aux" "log" "out" "toc")) + (dolist (ext org-export-pdf-logfiles) (setq file (concat base "." ext)) (and (file-exists-p file) (delete-file file)))) - (message "Exporting to PDF...done") + (message (concat + "Exporting to PDF...done" + (if errors + (concat ", with some errors:" errors) + ""))) pdffile))) +(defun org-export-latex-get-error (buf) + "Collect the kinds of errors that remain in pdflatex processing." + (with-current-buffer buf + (save-excursion + (goto-char (point-max)) + (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t) + ;; OK, we are at the location of the final run + (let ((pos (point)) (errors "") (case-fold-search t)) + (if (re-search-forward "Reference.*?undefined" nil t) + (setq errors (concat errors " [undefined reference]"))) + (goto-char pos) + (if (re-search-forward "Citation.*?undefined" nil t) + (setq errors (concat errors " [undefined citation]"))) + (goto-char pos) + (if (re-search-forward "Undefined control sequence" nil t) + (setq errors (concat errors " [undefined control sequence]"))) + (and (org-string-nw-p errors) errors)))))) + ;;;###autoload (defun org-export-as-pdf-and-open (arg) "Export as LaTeX, then process through to PDF, and open." (interactive "P") (let ((pdffile (org-export-as-pdf arg))) (if pdffile - (org-open-file pdffile) + (progn + (org-open-file pdffile) + (when org-export-kill-product-buffer-when-displayed + (kill-buffer (find-buffer-visiting + (concat (file-name-sans-extension (buffer-file-name)) + ".tex"))))) (error "PDF file was not produced")))) ;;; Parsing functions: @@ -745,7 +1006,7 @@ Return a list reflecting the document structure." (goto-char (point-min)) (let* ((cnt 0) output (depth org-export-latex-sectioning-depth)) - (while (re-search-forward + (while (org-re-search-forward-unprotected (concat "^\\(\\(?:\\*\\)\\{" (number-to-string (+ (if odd 2 1) level)) "\\}\\) \\(.*\\)$") @@ -753,7 +1014,7 @@ Return a list reflecting the document structure." (when (> level 0) (save-excursion (save-match-data - (re-search-forward + (org-re-search-forward-unprotected (concat "^\\(\\(?:\\*\\)\\{" (number-to-string level) "\\}\\) \\(.*\\)$") nil t)))) t) @@ -765,7 +1026,7 @@ Return a list reflecting the document structure." (narrow-to-region (point) (save-match-data - (if (re-search-forward + (if (org-re-search-forward-unprotected (concat "^\\(\\(?:\\*\\)\\{" (number-to-string (+ (if odd 2 1) level)) "\\}\\) \\(.*\\)$") nil t) @@ -789,7 +1050,7 @@ Return a list reflecting the document structure." (defun org-export-latex-parse-content () "Extract the content of a section." (let ((beg (point)) - (end (if (re-search-forward "^\\(\\*\\)+ .*$" nil t) + (end (if (org-re-search-forward-unprotected "^\\(\\*\\)+ .*$" nil t) (progn (beginning-of-line) (point)) (point-max)))) (buffer-substring beg end))) @@ -797,7 +1058,7 @@ Return a list reflecting the document structure." (defun org-export-latex-parse-subcontent (level odd) "Extract the subcontent of a section at LEVEL. If ODD Is non-nil, assume subcontent only contains odd sections." - (if (not (re-search-forward + (if (not (org-re-search-forward-unprotected (concat "^\\(\\(?:\\*\\)\\{" (number-to-string (+ (if odd 4 2) level)) "\\}\\) \\(.*\\)$") @@ -824,8 +1085,7 @@ and its content." (defun org-export-latex-subcontent (subcontent num) "Export each cell of SUBCONTENT to LaTeX. If NUM, export sections as numerical sections." - (let* ((heading (org-export-latex-fontify-headline - (cdr (assoc 'heading subcontent)))) + (let* ((heading (cdr (assoc 'heading subcontent))) (level (- (cdr (assoc 'level subcontent)) org-export-latex-add-level)) (occur (number-to-string (cdr (assoc 'occur subcontent)))) @@ -833,32 +1093,61 @@ If NUM, export sections as numerical sections." (subcontent (cadr (assoc 'subcontent subcontent))) (label (org-get-text-property-any 0 'target heading)) (label-list (cons label (cdr (assoc label - org-export-target-aliases))))) + org-export-target-aliases)))) + (sectioning org-export-latex-sectioning) + (depth org-export-latex-sectioning-depth) + main-heading sub-heading) + (when (symbolp (car sectioning)) + (setq sectioning (funcall (car sectioning) level heading)) + (when sectioning + (setq heading (car sectioning) + sectioning (cdr sectioning) + ;; target property migh have changed... + label (org-get-text-property-any 0 'target heading) + label-list (cons label (cdr (assoc label + org-export-target-aliases))))) + (if sectioning (setq sectioning (make-list 10 sectioning))) + (setq depth (if sectioning 10000 0))) + (if (string-match "[ \t]*\\\\\\\\[ \t]*" heading) + (setq main-heading (substring heading 0 (match-beginning 0)) + sub-heading (substring heading (match-end 0)))) + (setq heading (org-export-latex-fontify-headline heading) + sub-heading (and sub-heading + (org-export-latex-fontify-headline sub-heading)) + main-heading (and main-heading + (org-export-latex-fontify-headline main-heading))) (cond ;; Normal conversion - ((<= level org-export-latex-sectioning-depth) - (let* ((sec (nth (1- level) org-export-latex-sectioning)) + ((<= level depth) + (let* ((sec (nth (1- level) sectioning)) start end) (if (consp (cdr sec)) (setq start (nth (if num 0 2) sec) end (nth (if num 1 3) sec)) (setq start (if num (car sec) (cdr sec)))) - (insert (format start heading) "\n") + (insert (format start (if main-heading main-heading heading) + (or sub-heading ""))) + (insert "\n") (when label (insert (mapconcat (lambda (l) (format "\\label{%s}" l)) label-list "\n") "\n")) (insert (org-export-latex-content content)) (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (if end (insert end "\n")))) + ((listp subcontent) + (while (org-looking-back "\n\n") (backward-delete-char 1)) + (org-export-latex-sub subcontent))) + (when (and end (string-match "[^ \t]" end)) + (let ((hook (org-get-text-property-any 0 'org-insert-hook end))) + (and (functionp hook) (funcall hook))) + (insert end "\n")))) ;; At a level under the hl option: we can drop this subsection - ((> level org-export-latex-sectioning-depth) + ((> level depth) (cond ((eq org-export-latex-low-levels 'description) (if (string-match "% ends low level$" (buffer-substring (point-at-bol 0) (point))) (delete-region (point-at-bol 0) (point)) (insert "\\begin{description}\n")) - (insert (format "\n\\item[%s]%s~\n\n" + (insert (format "\n\\item[%s]%s~\n" heading (if label (format "\\label{%s}" label) ""))) (insert (org-export-latex-content content)) @@ -871,7 +1160,7 @@ If NUM, export sections as numerical sections." (delete-region (point-at-bol 0) (point)) (insert (format "\\begin{%s}\n" (symbol-name org-export-latex-low-levels)))) - (insert (format "\n\\item %s\\\\\n%s\n" + (insert (format "\n\\item %s\\\\\n%s%%" heading (if label (format "\\label{%s}" label) ""))) (insert (org-export-latex-content content)) @@ -926,10 +1215,23 @@ LEVEL indicates the default depth for export." (save-restriction (widen) (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([a-zA-Z]+\\)" nil t) + (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\(-[a-zA-Z]+\\)" nil t) (match-string 1)))) (plist-get org-export-latex-options-plist :latex-class) org-export-latex-default-class) + org-export-latex-class-options + (or (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (and (looking-at org-complex-heading-regexp) + (org-entry-get nil "LaTeX_CLASS_OPTIONS" 'selective)))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (and (re-search-forward "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t) + (match-string 1)))) + (plist-get org-export-latex-options-plist :latex-class-options)) org-export-latex-class (or (car (assoc org-export-latex-class org-export-latex-classes)) (error "No definition for class `%s' in `org-export-latex-classes'" @@ -943,51 +1245,60 @@ LEVEL indicates the default depth for export." (let ((hl-levels (plist-get org-export-latex-options-plist :headline-levels)) (sec-depth (length org-export-latex-sectioning))) - (if (> hl-levels sec-depth) sec-depth hl-levels))))) + (if (> hl-levels sec-depth) sec-depth hl-levels)))) + (when (and org-export-latex-class-options + (string-match "\\S-" org-export-latex-class-options) + (string-match "^[ \t]*\\(\\\\documentclass\\)\\(\\[.*?\\]\\)?" + org-export-latex-header)) + (setq org-export-latex-header + (concat (substring org-export-latex-header 0 (match-end 1)) + org-export-latex-class-options + (substring org-export-latex-header (match-end 0)))))) + +(defvar org-export-latex-format-toc-function + 'org-export-latex-format-toc-default + "The function formatting returning the string to create the table of contents. +The function mus take one parameter, the depth of the table of contents.") (defun org-export-latex-make-header (title opt-plist) "Make the LaTeX header and return it as a string. TITLE is the current title from the buffer or region. OPT-PLIST is the options plist for current buffer." (let ((toc (plist-get opt-plist :table-of-contents)) - (author (plist-get opt-plist :author))) + (author (org-export-apply-macros-in-string + (plist-get opt-plist :author)))) (concat (if (plist-get opt-plist :time-stamp-file) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) - ;; insert LaTeX custom header - (org-export-apply-macros-in-string org-export-latex-header) - "\n" - ;; insert information on LaTeX packages - (when org-export-latex-packages-alist - (mapconcat (lambda(p) - (if (equal "" (car p)) - (format "\\usepackage{%s}" (cadr p)) - (format "\\usepackage[%s]{%s}" - (car p) (cadr p)))) - org-export-latex-packages-alist "\n")) - ;; insert additional commands in the header - (org-export-apply-macros-in-string - (plist-get opt-plist :latex-header-extra)) + ;; insert LaTeX custom header and packages from the list + (org-splice-latex-header + (org-export-apply-macros-in-string org-export-latex-header) + org-export-latex-default-packages-alist + org-export-latex-packages-alist nil + (org-export-apply-macros-in-string + (plist-get opt-plist :latex-header-extra))) + ;; append another special variable (org-export-apply-macros-in-string org-export-latex-append-header) + ;; define alert if not yet defined + "\n\\providecommand{\\alert}[1]{\\textbf{#1}}" + ;; beginning of the document + "\n\\begin{document}\n\n" ;; insert the title (format "\n\n\\title{%s}\n" ;; convert the title - (org-export-latex-content - title '(lists tables fixed-width keywords))) + (org-export-latex-fontify-headline title)) ;; insert author info (if (plist-get opt-plist :author-info) (format "\\author{%s}\n" (org-export-latex-fontify-headline (or author user-full-name))) (format "%%\\author{%s}\n" - (or author user-full-name))) + (org-export-latex-fontify-headline (or author user-full-name)))) ;; insert the date (format "\\date{%s}\n" (format-time-string (or (plist-get opt-plist :date) org-export-latex-date-format))) - ;; beginning of the document - "\n\\begin{document}\n\n" ;; insert the title command (when (string-match "\\S-" title) (if (string-match "%s" org-export-latex-title-command) @@ -997,13 +1308,15 @@ OPT-PLIST is the options plist for current buffer." ;; table of contents (when (and org-export-with-toc (plist-get opt-plist :section-numbers)) - (cond ((numberp toc) - (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n" - (min toc (plist-get opt-plist :headline-levels)))) - (toc (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n" - (plist-get opt-plist :headline-levels))))) - (when (plist-get opt-plist :preserve-breaks) - "\\obeylines\n")))) + (funcall org-export-latex-format-toc-function + (cond ((numberp toc) + (min toc (plist-get opt-plist :headline-levels))) + (toc (plist-get opt-plist :headline-levels)))))))) + +(defun org-export-latex-format-toc-default (depth) + (when depth + (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n" + depth))) (defun org-export-latex-first-lines (opt-plist &optional beg end) "Export the first lines before first headline. @@ -1012,7 +1325,7 @@ If END is non-nil, it is the end of the region." (save-excursion (goto-char (or beg (point-min))) (let* ((pt (point)) - (end (if (re-search-forward "^\\*+ " end t) + (end (if (re-search-forward (org-get-limited-outline-regexp) end t) (goto-char (match-beginning 0)) (goto-char (or end (point-max)))))) (prog1 @@ -1028,8 +1341,20 @@ If END is non-nil, it is the end of the region." :timestamps (plist-get opt-plist :timestamps) :footnotes (plist-get opt-plist :footnotes))) (org-unmodified - (add-text-properties pt (max pt (1- end)) - '(:org-license-to-kill t))))))) + (let ((inhibit-read-only t) + (limit (max pt (1- end)))) + (add-text-properties pt limit + '(:org-license-to-kill t)) + (save-excursion + (goto-char pt) + (while (re-search-forward "^[ \t]*#\\+.*\n?" limit t) + (let ((case-fold-search t)) + (unless (org-string-match-p + "^[ \t]*#\\+\\(attr_\\|caption\\>\\|label\\>\\)" + (match-string 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(:org-license-to-kill t)))))))))))) + (defvar org-export-latex-header-defs nil "The header definitions that might be used in the LaTeX body.") @@ -1101,20 +1426,21 @@ links, keywords, lists, tables, fixed-width" (cdr todo-markup) (car todo-markup))) (t (cdr (or (assoc (match-string 1) todo-markup) (car todo-markup)))))) - (replace-match (format fmt (match-string 1)) t t))) + (replace-match (org-export-latex-protect-string + (format fmt (match-string 1))) t t))) ;; convert priority string (when (re-search-forward "\\[\\\\#.\\]" nil t) (if (plist-get remove-list :priority) (replace-match "") (replace-match (format "\\textbf{%s}" (match-string 0)) t t))) ;; convert tags - (when (re-search-forward "\\(:[a-zA-Z0-9_@]+\\)+:" nil t) + (when (re-search-forward "\\(:[a-zA-Z0-9_@#%]+\\)+:" nil t) (if (or (not org-export-with-tags) (plist-get remove-list :tags)) (replace-match "") (replace-match (org-export-latex-protect-string - (format "\\textbf{%s}" + (format org-export-latex-tag-markup (save-match-data (replace-regexp-in-string "_" "\\\\_" (match-string 0))))) @@ -1126,14 +1452,48 @@ links, keywords, lists, tables, fixed-width" ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at ;; the beginning of the buffer - inserting "\n" is safe here though. (insert "\n" string) + + ;; Preserve math snippets + + (let* ((matchers (plist-get org-format-latex-options :matchers)) + (re-list org-latex-regexps) + beg end re e m n block off) + ;; Check the different regular expressions + (while (setq e (pop re-list)) + (setq m (car e) re (nth 1 e) n (nth 2 e) + block (if (nth 3 e) "\n\n" "")) + (setq off (if (member m '("$" "$1")) 1 0)) + (when (and (member m matchers) (not (equal m "begin"))) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0)) + (add-text-properties beg end + '(org-protected t org-latex-math t)))))) + + ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{} + (goto-char (point-min)) + (let ((case-fold-search nil)) + (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t) + (unless (eq (char-before (match-beginning 1)) ?\\) + (org-if-unprotected-1 + (replace-match (org-export-latex-protect-string + (concat "\\" (match-string 1) + "{}")) t t))))) (goto-char (point-min)) - (let ((re (concat "\\\\[a-zA-Z]+\\(?:" - "\\[.*\\]" - "\\)?" - (org-create-multibrace-regexp "{" "}" 3)))) + (let ((re (concat "\\\\\\([a-zA-Z]+\\)" + "\\(?:<[^<>\n]*>\\)*" + "\\(?:\\[[^][\n]*?\\]\\)*" + "\\(?:<[^<>\n]*>\\)*" + "\\(" + (org-create-multibrace-regexp "{" "}" 3) + "\\)\\{1,3\\}"))) (while (re-search-forward re nil t) - (unless (save-excursion (goto-char (match-beginning 0)) - (equal (char-after (point-at-bol)) ?#)) + (unless (or + ;; check for comment line + (save-excursion (goto-char (match-beginning 0)) + (org-in-indented-comment-line)) + ;; Check if this is a defined entity, so that is may need conversion + (org-entity-get (match-string 1))) (add-text-properties (match-beginning 0) (match-end 0) '(org-protected t))))) (when (plist-get org-export-latex-options-plist :emphasize) @@ -1192,7 +1552,8 @@ See the `org-export-latex.el' code for a complete conversion table." (if (equal (match-string 1) "\\") (replace-match (match-string 2) t t) (replace-match (concat (match-string 1) "\\" - (match-string 2)) t t))) + (match-string 2)) t t) + (backward-char 1))) ((equal (match-string 2) "...") (replace-match (concat (match-string 1) @@ -1216,7 +1577,19 @@ See the `org-export-latex.el' code for a complete conversion table." (org-export-latex-treat-backslash-char (match-string 1) (or (match-string 3) ""))) - "") t t)) + "") t t) + (when (and (get-text-property (1- (point)) 'org-entity) + (looking-at "{}")) + ;; OK, this was an entity replacement, and the user + ;; had terminated the entity with {}. Make sure + ;; {} is protected as well, and remove the extra {} + ;; inserted by the conversion. + (put-text-property (point) (+ 2 (point)) 'org-protected t) + (if (save-excursion (goto-char (max (- (point) 2) (point-min))) + (looking-at "{}")) + (replace-match "")) + (forward-char 2)) + (backward-char 1)) ((member (match-string 2) '("_" "^")) (replace-match (or (save-match-data (org-export-latex-treat-sub-super-char @@ -1227,8 +1600,8 @@ See the `org-export-latex.el' code for a complete conversion table." (backward-char 1))))))) '(;"^\\([^\n$]*?\\|^\\)\\(\\\\?\\$\\)\\([^\n$]*\\)$" "\\(\\(\\\\?\\$\\)\\)" - "\\([a-za-z0-9]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-za-z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-za-z0-9]+}\\|([a-za-z0-9]+)\\)" - "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|[a-zA-Z&#%{}\"]+\\)" + "\\([a-zA-Z0-9()]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-zA-Z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-zA-Z0-9]+}\\|([a-zA-Z0-9]+)\\)" + "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)" "\\(.\\|^\\)\\(&\\)" "\\(.\\|^\\)\\(#\\)" "\\(.\\|^\\)\\(%\\)" @@ -1264,7 +1637,9 @@ Convert CHAR depending on STRING-BEFORE and STRING-AFTER." ((and (> (length string-after) 1) (or (eq subsup t) (and (equal subsup '{}) (eq (string-to-char string-after) ?\{))) - (string-match "[({]?\\([^)}]+\\)[)}]?" string-after)) + (or (string-match "[{]?\\([^}]+\\)[}]?" string-after) + (string-match "[(]?\\([^)]+\\)[)]?" string-after))) + (org-export-latex-protect-string (format "%s$%s{%s}$" string-before char (if (and (> (match-end 1) (1+ (match-beginning 1))) @@ -1280,29 +1655,35 @@ Convert CHAR depending on STRING-BEFORE and STRING-AFTER." (defun org-export-latex-treat-backslash-char (string-before string-after) "Convert the \"$\" special character to LaTeX. The conversion is made depending of STRING-BEFORE and STRING-AFTER." - (cond ((member (list string-after) org-html-entities) - ;; backslash is part of a special entity (like "\alpha") - (concat string-before "$\\" - (or (cdar (member (list string-after) org-html-entities)) - string-after) "$")) - ((and (not (string-match "^[ \n\t]" string-after)) - (not (string-match "[ \t]\\'\\|^" string-before))) - ;; backslash is inside a word - (org-export-latex-protect-string - (concat string-before "\\textbackslash{}" string-after))) - ((not (or (equal string-after "") - (string-match "^[ \t\n]" string-after))) - ;; backslash might escape a character (like \#) or a user TeX - ;; macro (like \setcounter) - (org-export-latex-protect-string - (concat string-before "\\" string-after))) - ((and (string-match "^[ \t\n]" string-after) - (string-match "[ \t\n]\\'" string-before)) - ;; backslash is alone, convert it to $\backslash$ - (org-export-latex-protect-string - (concat string-before "\\textbackslash{}" string-after))) - (t (org-export-latex-protect-string - (concat string-before "\\textbackslash{}" string-after))))) + (let ((ass (org-entity-get string-after))) + (cond + (ass (org-add-props + (if (nth 2 ass) + (concat string-before + (org-export-latex-protect-string + (concat "$" (nth 1 ass) "$"))) + (concat string-before (org-export-latex-protect-string + (nth 1 ass)))) + nil 'org-entity t)) + ((and (not (string-match "^[ \n\t]" string-after)) + (not (string-match "[ \t]\\'\\|^" string-before))) + ;; backslash is inside a word + (concat string-before + (org-export-latex-protect-string + (concat "\\textbackslash{}" string-after)))) + ((not (or (equal string-after "") + (string-match "^[ \t\n]" string-after))) + ;; backslash might escape a character (like \#) or a user TeX + ;; macro (like \setcounter) + (concat string-before + (org-export-latex-protect-string (concat "\\" string-after)))) + ((and (string-match "^[ \t\n]" string-after) + (string-match "[ \t\n]\\'" string-before)) + ;; backslash is alone, convert it to $\backslash$ + (org-export-latex-protect-string + (concat string-before "\\textbackslash{}" string-after))) + (t (org-export-latex-protect-string + (concat string-before "\\textbackslash{}" string-after)))))) (defun org-export-latex-keywords () "Convert special keywords to LaTeX." @@ -1312,34 +1693,42 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (match-string 0)) t t) (save-excursion (beginning-of-line 1) - (unless (looking-at ".*\\\\newline[ \t]*$") + (unless (looking-at ".*\n[ \t]*\n") (end-of-line 1) - (insert "\\newline"))))) + (insert "\n"))))) (defun org-export-latex-fixed-width (opt) "When OPT is non-nil convert fixed-width sections to LaTeX." (goto-char (point-min)) (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t) - (if opt - (progn (goto-char (match-beginning 0)) - (insert "\\begin{verbatim}\n") - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat (match-string 1) - (match-string 2)) t t) - (forward-line)) - (insert "\\end{verbatim}\n\n")) - (progn (goto-char (match-beginning 0)) - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat "%" (match-string 1) - (match-string 2)) t t) - (forward-line)))))) - + (unless (get-text-property (point) 'org-example) + (if opt + (progn (goto-char (match-beginning 0)) + (insert "\\begin{verbatim}\n") + (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") + (replace-match (concat (match-string 1) + (match-string 2)) t t) + (forward-line)) + (insert "\\end{verbatim}\n\n")) + (progn (goto-char (match-beginning 0)) + (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") + (replace-match (concat "%" (match-string 1) + (match-string 2)) t t) + (forward-line))))))) (defvar org-table-last-alignment) ; defined in org-table.el (defvar org-table-last-column-widths) ; defined in org-table.el (declare-function orgtbl-to-latex "org-table" (table params) t) (defun org-export-latex-tables (insert) "Convert tables to LaTeX and INSERT it." + ;; First, get the table.el tables + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*\\(\\+-[-+]*\\+\\)[ \t]*\n[ \t]*|" nil t) + (org-if-unprotected + (require 'table) + (org-export-latex-convert-table.el-table))) + + ;; And now the Org-mode tables (goto-char (point-min)) (while (re-search-forward "^\\([ \t]*\\)|" nil t) (org-if-unprotected-at (1- (point)) @@ -1351,7 +1740,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (org-table-last-column-widths (copy-sequence org-table-last-column-widths)) fnum fields line lines olines gr colgropen line-fmt align - caption label attr floatp longtblp) + caption shortn label attr floatp placement longtblp) (if org-export-latex-tables-verbatim (let* ((tbl (concat "\\begin{verbatim}\n" raw-table "\\end{verbatim}\n"))) @@ -1360,6 +1749,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (progn (setq caption (org-find-text-property-in-string 'org-caption raw-table) + shortn (org-find-text-property-in-string + 'org-caption-shortn raw-table) attr (org-find-text-property-in-string 'org-attributes raw-table) label (org-find-text-property-in-string @@ -1367,9 +1758,15 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." longtblp (and attr (stringp attr) (string-match "\\<longtable\\>" attr)) align (and attr (stringp attr) - (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr) + (string-match "\\<align=\\([^ \t\n\r]+\\)" attr) (match-string 1 attr)) - floatp (or caption label)) + floatp (or caption label) + placement (if (and attr + (stringp attr) + (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr)) + (match-string 1 attr) + "[htb]")) + (setq caption (and caption (org-export-latex-fontify-headline caption))) (setq lines (org-split-string raw-table "\n")) (apply 'delete-region (list beg end)) (when org-export-table-remove-special-lines @@ -1423,16 +1820,19 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (concat (if longtblp (concat "\\begin{longtable}{" align "}\n") - (if floatp "\\begin{table}[htb]\n")) - (if (or floatp longtblp) + (if floatp (format "\\begin{table}%s\n" placement))) + (if floatp (format - "\\caption{%s%s}" - (if label (concat "\\\label{" label "}") "") - (or caption ""))) - (if longtblp "\\\\\n" "\n") + "\\caption%s{%s} %s" + (if shortn (concat "[" shortn "]") "") + (or caption "") + (if label (format "\\label{%s}" label) ""))) + (if (and longtblp caption) "\\\\\n" "\n") (if (and org-export-latex-tables-centered (not longtblp)) "\\begin{center}\n") - (if (not longtblp) (concat "\\begin{tabular}{" align "}\n")) + (if (not longtblp) + (format "\\begin{%s}{%s}\n" + org-export-latex-tabular-environment align)) (orgtbl-to-latex lines `(:tstart nil :tend nil @@ -1444,7 +1844,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." \\endfoot \\endlastfoot" (length org-table-last-alignment)) nil))) - (if (not longtblp) (concat "\n\\end{tabular}")) + (if (not longtblp) + (format "\n\\end{%s}" + org-export-latex-tabular-environment)) (if longtblp "\n" (if org-export-latex-tables-centered "\n\\end{center}\n" "\n")) (if longtblp @@ -1452,6 +1854,58 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (if floatp "\\end{table}")))) "\n\n")))))))) +(defun org-export-latex-convert-table.el-table () + "Replace table.el table at point with LaTeX code." + (let (tbl caption shortn label line floatp attr align rmlines) + (setq line (buffer-substring (point-at-bol) (point-at-eol)) + label (org-get-text-property-any 0 'org-label line) + caption (org-get-text-property-any 0 'org-caption line) + shortn (org-get-text-property-any 0 'org-caption-shortn line) + attr (org-get-text-property-any 0 'org-attributes line) + align (and attr (stringp attr) + (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr) + (match-string 1 attr)) + rmlines (and attr (stringp attr) + (string-match "\\<rmlines\\>" attr)) + floatp (or label caption)) + (and (get-buffer "*org-export-table*") + (kill-buffer (get-buffer "*org-export-table*"))) + (table-generate-source 'latex "*org-export-table*" "caption") + (setq tbl (with-current-buffer "*org-export-table*" + (buffer-string))) + (while (string-match "^%.*\n" tbl) + (setq tbl (replace-match "" t t tbl))) + ;; fix the hlines + (when rmlines + (let ((n 0) lines) + (setq lines (mapcar (lambda (x) + (if (string-match "^\\\\hline$" x) + (progn + (setq n (1+ n)) + (if (= n 2) x nil)) + x)) + (org-split-string tbl "\n"))) + (setq tbl (mapconcat 'identity (delq nil lines) "\n")))) + (when (and align (string-match "\\\\begin{tabular}{.*}" tbl)) + (setq tbl (replace-match (concat "\\begin{tabular}{" align "}") + t t tbl))) + (and (get-buffer "*org-export-table*") + (kill-buffer (get-buffer "*org-export-table*"))) + (beginning-of-line 0) + (while (looking-at "[ \t]*\\(|\\|\\+-\\)") + (delete-region (point) (1+ (point-at-eol)))) + (when org-export-latex-tables-centered + (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}"))) + (when floatp + (setq tbl (concat "\\begin{table}\n" + (format "\\caption%s{%s}%s\n" + (if shortn (format "[%s]" shortn) "") + (if label (format "\\label{%s}" label) "") + (or caption "")) + tbl + "\n\\end{table}\n"))) + (insert (org-export-latex-protect-string tbl)))) + (defun org-export-latex-fontify () "Convert fontification to LaTeX." (goto-char (point-min)) @@ -1468,12 +1922,17 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (unless (or (and (get-text-property (- (point) 2) 'org-protected) (not (get-text-property (- (point) 2) 'org-verbatim-emph))) + (equal (char-after (match-beginning 3)) + (char-after (1+ (match-beginning 3)))) (save-excursion (goto-char (match-beginning 1)) (save-match-data (and (org-at-table-p) (string-match - "[|\n]" (buffer-substring beg end)))))) + "[|\n]" (buffer-substring beg end))))) + (and (equal (match-string 3) "+") + (save-match-data + (string-match "\\`-+\\'" (match-string 4))))) (setq s (match-string 4)) (setq rpl (concat (match-string 1) (org-export-latex-emph-format (cadr emph) @@ -1482,7 +1941,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (if (caddr emph) (setq rpl (org-export-latex-protect-string rpl)) (save-match-data - (if (string-match "\\`.\\(\\\\[a-z]+{\\)\\(.*\\)\\(}\\).?\\'" rpl) + (if (string-match "\\`.?\\(\\\\[a-z]+{\\)\\(.*\\)\\(}\\).?\\'" rpl) (progn (add-text-properties (match-beginning 1) (match-end 1) '(org-protected t) rpl) @@ -1541,10 +2000,11 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "file"))) (coderefp (equal type "coderef")) (caption (org-find-text-property-in-string 'org-caption raw-path)) + (shortn (org-find-text-property-in-string 'org-caption-shortn raw-path)) (attr (or (org-find-text-property-in-string 'org-attributes raw-path) (plist-get org-export-latex-options-plist :latex-image-options))) (label (org-find-text-property-in-string 'org-label raw-path)) - imgp radiop + imgp radiop fnc ;; define the path of the link (path (cond ((member type '("coderef")) @@ -1573,43 +2033,54 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." raw-path)))))))) ;; process with link inserting (apply 'delete-region remove) + (setq caption (and caption (org-export-latex-fontify-headline caption))) (cond ((and imgp (plist-get org-export-latex-options-plist :inline-images)) ;; OK, we need to inline an image (insert - (org-export-latex-format-image raw-path caption label attr))) + (org-export-latex-format-image raw-path caption label attr shortn))) (coderefp (insert (format (org-export-get-coderef-format path desc) (cdr (assoc path org-export-code-refs))))) - (radiop (insert (format "\\hyperref[%s]{%s}" + (radiop (insert (format org-export-latex-hyperref-format (org-solidify-link-text raw-path) desc))) ((not type) - (insert (format "\\hyperref[%s]{%s}" + (insert (format org-export-latex-hyperref-format (org-remove-initial-hash (org-solidify-link-text raw-path)) desc))) - (path + (path (when (org-at-table-p) ;; There is a strange problem when we have a link in a table, ;; ampersands then cause a problem. I think this must be ;; a LaTeX issue, but we here implement a work-around anyway. (setq path (org-export-latex-protect-amp path) desc (org-export-latex-protect-amp desc))) - (insert (format "\\href{%s}{%s}" path desc))) + (insert (format org-export-latex-href-format path desc))) + + ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) + ;; The link protocol has a function for formatting the link + (insert + (save-match-data + (funcall fnc (org-link-unescape raw-path) desc 'latex)))) + (t (insert "\\texttt{" desc "}"))))))) -(defun org-export-latex-format-image (path caption label attr) +(defun org-export-latex-format-image (path caption label attr &optional shortn) "Format the image element, depending on user settings." - (let (floatp wrapp placement figenv) + (let (ind floatp wrapp multicolumnp placement figenv) (setq floatp (or caption label)) + (setq ind (org-get-text-property-any 0 'original-indentation path)) (when (and attr (stringp attr)) (if (string-match "[ \t]*\\<wrap\\>" attr) (setq wrapp t floatp nil attr (replace-match "" t t attr))) (if (string-match "[ \t]*\\<float\\>" attr) - (setq wrapp nil floatp t attr (replace-match "" t t attr)))) - + (setq wrapp nil floatp t attr (replace-match "" t t attr))) + (if (string-match "[ \t]*\\<multicolumn\\>" attr) + (setq multicolumnp t attr (replace-match "" t t attr)))) + (setq placement (cond (wrapp "{l}{0.5\\textwidth}") @@ -1630,8 +2101,13 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (wrapp "\\begin{wrapfigure}%placement \\centering \\includegraphics[%attr]{%path} -\\caption{%labelcmd%caption} +\\caption%shortn{%labelcmd%caption} \\end{wrapfigure}") + (multicolumnp "\\begin{figure*}%placement +\\centering +\\includegraphics[%attr]{%path} +\\caption{%labelcmd%caption} +\\end{figure*}") (floatp "\\begin{figure}%placement \\centering \\includegraphics[%attr]{%path} @@ -1639,20 +2115,29 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." \\end{figure}") (t "\\includegraphics[%attr]{%path}"))) + + (setq figenv (mapconcat 'identity (split-string figenv "\n") + (save-excursion (beginning-of-line 1) + (looking-at "[ \t]*") + (concat "\n" (match-string 0))))) + (if (and (not label) (not caption) (string-match "^\\\\caption{.*\n" figenv)) (setq figenv (replace-match "" t t figenv))) - (org-fill-template - figenv - (list (cons "path" - (if (file-name-absolute-p path) - (expand-file-name path) - path)) - (cons "attr" attr) - (cons "labelcmd" (if label (format "\\label{%s}" - label)"")) - (cons "caption" (or caption "")) - (cons "placement" (or placement "")))))) + (org-add-props + (org-fill-template + figenv + (list (cons "path" + (if (file-name-absolute-p path) + (expand-file-name path) + path)) + (cons "attr" attr) + (cons "shortn" (if shortn (format "[%s]" shortn) "")) + (cons "labelcmd" (if label (format "\\label{%s}" + label)"")) + (cons "caption" (or caption "")) + (cons "placement" (or placement "")))) + nil 'original-indentation ind))) (defun org-export-latex-protect-amp (s) (while (string-match "\\([^\\\\]\\)\\(&\\)" s) @@ -1666,7 +2151,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." s)) (defvar org-latex-entities) ; defined below (defvar org-latex-entities-regexp) ; defined below -(defvar org-latex-entities-exceptions) ; defined below (defun org-export-latex-preprocess (parameters) "Clean stuff in the LaTeX export." @@ -1679,7 +2163,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ;; Preserve latex environments (goto-char (point-min)) (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t) - (let* ((start (progn (beginning-of-line) (point))) + (org-if-unprotected + (let* ((start (progn (beginning-of-line) (point))) (end (and (re-search-forward (concat "^[ \t]*\\\\end{" (regexp-quote (match-string 1)) @@ -1687,7 +2172,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (point-at-eol)))) (if end (add-text-properties start end '(org-protected t)) - (goto-char (point-at-eol))))) + (goto-char (point-at-eol)))))) ;; Preserve math snippets @@ -1705,13 +2190,15 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0)) (add-text-properties beg end '(org-protected t org-latex-math t)))))) - ;; Convert LaTeX to \LaTeX{} + ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{} (goto-char (point-min)) (let ((case-fold-search nil)) - (while (re-search-forward "\\([^+_]\\)LaTeX" nil t) - (org-if-unprotected - (replace-match (org-export-latex-protect-string - (concat (match-string 1) "\\LaTeX{}")) t t)))) + (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t) + (unless (eq (char-before (match-beginning 1)) ?\\) + (org-if-unprotected-1 + (replace-match (org-export-latex-protect-string + (concat "\\" (match-string 1) + "{}")) t t))))) ;; Convert blockquotes (goto-char (point-min)) @@ -1759,25 +2246,36 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (replace-match (org-export-latex-protect-string "\\hrule") t t))) ;; Protect LaTeX commands like \command[...]{...} or \command{...} - (let ((re (concat "\\\\[a-zA-Z]+\\(?:" - "\\[.*\\]" - "\\)?" - (org-create-multibrace-regexp "{" "}" 3)))) + (goto-char (point-min)) + (let ((re (concat + "\\\\\\([a-zA-Z]+\\)" + "\\(?:<[^<>\n]*>\\)*" + "\\(?:\\[[^][\n]*?\\]\\)*" + "\\(?:<[^<>\n]*>\\)*" + "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}"))) (while (re-search-forward re nil t) - (unless (save-excursion (goto-char (match-beginning 0)) - (equal (char-after (point-at-bol)) ?#)) + (unless (or + ;; check for comment line + (save-excursion (goto-char (match-beginning 0)) + (org-in-indented-comment-line)) + ;; Check if this is a defined entity, so that is may need conversion + (org-entity-get (match-string 1)) + ) (add-text-properties (match-beginning 0) (match-end 0) '(org-protected t))))) + ;; Special case for \nbsp + (goto-char (point-min)) + (while (re-search-forward "\\\\nbsp\\({}\\|\\>\\)" nil t) + (org-if-unprotected + (replace-match (org-export-latex-protect-string "~")))) + ;; Protect LaTeX entities (goto-char (point-min)) - (let (a) - (while (re-search-forward org-latex-entities-regexp nil t) - (if (setq a (assoc (match-string 0) org-latex-entities-exceptions)) - (replace-match (org-add-props (nth 1 a) nil 'org-protected t) - t t) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))))) + (while (re-search-forward org-latex-entities-regexp nil t) + (org-if-unprotected + (add-text-properties (match-beginning 0) (match-end 0) + '(org-protected t)))) ;; Replace radio links (goto-char (point-min)) @@ -1786,10 +2284,12 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ">>>?\\((INVISIBLE)\\)?") nil t) (org-if-unprotected-at (+ (match-beginning 0) 2) (replace-match - (org-export-latex-protect-string - (format "\\label{%s}%s" (save-match-data (org-solidify-link-text - (match-string 1))) - (if (match-string 2) "" (match-string 1)))) t t))) + (concat + (org-export-latex-protect-string + (format "\\label{%s}" (save-match-data (org-solidify-link-text + (match-string 1))))) + (if (match-string 2) "" (match-string 1))) + t t))) ;; Delete @<...> constructs ;; Thanks to Daniel Clemente for this regexp @@ -1832,6 +2332,10 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (add-text-properties (1- (length footnote-rpl)) (length footnote-rpl) '(org-protected t) footnote-rpl) + (if (org-on-heading-p) + (setq footnote-rpl + (concat (org-export-latex-protect-string "\\protect") + footnote-rpl))) (insert footnote-rpl))) ))))) @@ -1842,17 +2346,44 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (org-if-unprotected (replace-match ""))))) +(defun org-export-latex-fix-inputenc () + "Set the coding system in inputenc to what the buffer is." + (let* ((cs buffer-file-coding-system) + (opt (or (ignore-errors (latexenc-coding-system-to-inputenc cs)) + "utf8"))) + (when opt + ;; Translate if that is requested + (setq opt (or (cdr (assoc opt org-export-latex-inputenc-alist)) opt)) + ;; find the \usepackage statement and replace the option + (goto-char (point-min)) + (while (re-search-forward "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" + nil t) + (goto-char (match-beginning 1)) + (delete-region (match-beginning 1) (match-end 1)) + (insert opt)) + (and buffer-file-name + (save-buffer))))) + ;;; List handling: (defun org-export-latex-lists () "Convert plain text lists in current buffer into LaTeX lists." - (goto-char (point-min)) - (while (re-search-forward org-list-beginning-re nil t) - (org-if-unprotected - (beginning-of-line) - (insert (org-list-to-latex (org-list-parse-list t) - org-export-latex-list-parameters)) - "\n"))) + (let (res) + (goto-char (point-min)) + (while (org-search-forward-unenclosed org-item-beginning-re nil t) + (beginning-of-line) + (setq res (org-list-to-latex (org-list-parse-list t) + org-export-latex-list-parameters)) + (while (string-match "^\\(\\\\item[ \t]+\\)\\[@\\(?:start:\\)?\\([0-9]+\\)\\]" + res) + (setq res (replace-match + (concat (format "\\setcounter{enumi}{%d}" + (1- (string-to-number + (match-string 2 res)))) + "\n" + (match-string 1 res)) + t t res))) + (insert res)))) (defconst org-latex-entities '("\\!" @@ -1959,7 +2490,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\medskip" "\\multicolumn" "\\multiput" - ("\\nbsp" "~") "\\newcommand" "\\newcounter" "\\newenvironment" @@ -2031,14 +2561,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\vspace") "A list of LaTeX commands to be protected when performing conversion.") -(defvar org-latex-entities-exceptions nil) - (defconst org-latex-entities-regexp (let (names rest) (dolist (x org-latex-entities) - (when (consp x) - (add-to-list 'org-latex-entities-exceptions x) - (setq x (car x))) (if (string-match "[a-zA-Z]$" x) (push x names) (push x rest))) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 41fa7764240..0bbc7f33c52 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -7,7 +7,7 @@ ;; Bastien Guerry <bzg AT altern DOT org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -31,6 +31,8 @@ ;;; Code: +(eval-when-compile + (require 'cl)) (require 'org-macs) (require 'org-compat) @@ -38,20 +40,31 @@ (defvar org-M-RET-may-split-line) (defvar org-complex-heading-regexp) (defvar org-odd-levels-only) +(defvar org-outline-regexp) +(defvar org-ts-regexp) +(defvar org-ts-regexp-both) (declare-function org-invisible-p "org" ()) (declare-function org-on-heading-p "org" (&optional invisible-ok)) (declare-function outline-next-heading "outline" ()) (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-back-over-empty-lines "org" ()) -(declare-function org-skip-whitespace "org" ()) (declare-function org-trim "org" (s)) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-timer-item "org-timer" (&optional arg)) +(declare-function org-timer-hms-to-secs "org-timer" (hms)) (declare-function org-combine-plists "org" (&rest plists)) -(declare-function org-entry-get "org" (pom property &optional inherit)) +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-show-subtree "org" ()) +(declare-function org-in-regexps-block-p "org" + (start-re end-re &optional bound)) +(declare-function org-level-increment "org" ()) +(declare-function org-at-heading-p "org" (&optional ignored)) +(declare-function outline-previous-heading "outline" ()) +(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-time-string-to-seconds "org" (s)) (defgroup org-plain-lists nil "Options concerning plain lists in Org-mode." @@ -60,7 +73,6 @@ (defcustom org-cycle-include-plain-lists t "When t, make TAB cycle visibility on plain list items. - Cycling plain lists works only when the cursor is on a plain list item. When the cursor is on an outline heading, plain lists are treated as text. This is the most stable way of handling this, @@ -84,7 +96,29 @@ heading will be exposed in a children' view." (defcustom org-list-demote-modify-bullet nil "Default bullet type installed when demoting an item. This is an association list, for each bullet type, this alist will point -to the bulled that should be used when this item is demoted." +to the bullet that should be used when this item is demoted. +For example, + + (setq org-list-demote-modify-bullet + '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\"))) + +will make + + + Movies + + Silence of the Lambs + + My Cousin Vinny + + Books + + The Hunt for Red October + + The Road to Omaha + +into + + + Movies + - Silence of the Lambs + - My Cousin Vinny + + Books + - The Hunt for Red October + - The Road to Omaha" :group 'org-plain-lists :type '(repeat (cons @@ -115,39 +149,91 @@ the safe choice." (defcustom org-list-two-spaces-after-bullet-regexp nil "A regular expression matching bullets that should have 2 spaces after them. When nil, no bullet will have two spaces after them. -When a string, it will be used as a regular expression. When the bullet -type of a list is changed, the new bullet type will be matched against this -regexp. If it matches, there will be two spaces instead of one after -the bullet in each item of he list." - :group 'org-plain-list +When a string, it will be used as a regular expression. When the +bullet type of a list is changed, the new bullet type will be +matched against this regexp. If it matches, there will be two +spaces instead of one after the bullet in each item of the list." + :group 'org-plain-lists :type '(choice (const :tag "never" nil) (regexp))) -(defcustom org-empty-line-terminates-plain-lists nil - "Non-nil means, an empty line ends all plain list levels. -When nil, empty lines are part of the preceding item." +(defcustom org-list-ending-method 'both + "Determine where plain lists should end. +Valid values are: `regexp', `indent' or `both'. + +When set to `regexp', Org will look into two variables, +`org-empty-line-terminates-plain-lists' and the more general +`org-list-end-regexp', to determine what will end lists. This is +the fastest method. + +When set to `indent', a list will end whenever a line following +an item, but not starting one, is less or equally indented than +it. + +When set to `both', each of the preceding methods is applied to +determine lists endings. This is the default method." :group 'org-plain-lists - :type 'boolean) + :type '(choice + (const :tag "With a regexp defining ending" regexp) + (const :tag "With indentation of regular (no bullet) text" indent) + (const :tag "With both methods" both))) -(defcustom org-auto-renumber-ordered-lists t - "Non-nil means, automatically renumber ordered plain lists. -Renumbering happens when the sequence have been changed with -\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands, -use \\[org-ctrl-c-ctrl-c] to trigger renumbering." +(defcustom org-empty-line-terminates-plain-lists nil + "Non-nil means an empty line ends all plain list levels. +This variable only makes sense if `org-list-ending-method' is set +to `regexp' or `both'. This is then equivalent to set +`org-list-end-regexp' to \"^[ \\t]*$\"." :group 'org-plain-lists :type 'boolean) -(defcustom org-provide-checkbox-statistics t - "Non-nil means, update checkbox statistics after insert and toggle. -When this is set, checkbox statistics is updated each time you -either insert a new checkbox with \\[org-insert-todo-heading] or -toggle a checkbox with \\[org-ctrl-c-ctrl-c]." +(defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n" + "Regexp matching the end of all plain list levels. +It must start with \"^\" and end with \"\\n\". It defaults to 2 +blank lines. `org-empty-line-terminates-plain-lists' has +precedence over it." :group 'org-plain-lists - :type 'boolean) + :type 'string) + +(defcustom org-list-automatic-rules '((bullet . t) + (checkbox . t) + (indent . t) + (insert . t)) + "Non-nil means apply set of rules when acting on lists. +By default, automatic actions are taken when using + \\[org-meta-return], \\[org-metaright], \\[org-metaleft], + \\[org-shiftmetaright], \\[org-shiftmetaleft], + \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or + \\[org-insert-todo-heading]. You can disable individually these + rules by setting them to nil. Valid rules are: + +bullet when non-nil, cycling bullet do not allow lists at + column 0 to have * as a bullet and descriptions lists + to be numbered. +checkbox when non-nil, checkbox statistics is updated each time + you either insert a new checkbox or toggle a checkbox. + It also prevents from inserting a checkbox in a + description item. +indent when non-nil, indenting or outdenting list top-item + with its subtree will move the whole list and + outdenting a list whose bullet is * to column 0 will + change that bullet to - +insert when non-nil, trying to insert an item inside a block + will insert it right before the block instead of + throwing an error." + :group 'org-plain-lists + :type '(alist :tag "Sets of rules" + :key-type + (choice + (const :tag "Bullet" bullet) + (const :tag "Checkbox" checkbox) + (const :tag "Indent" indent) + (const :tag "Insert" insert)) + :value-type + (boolean :tag "Activate" :value t))) (defcustom org-hierarchical-checkbox-statistics t - "Non-nil means, checkbox statistics counts only the state of direct children. + "Non-nil means checkbox statistics counts only the state of direct children. When nil, all boxes below the cookie are counted. This can be set to nil on a per-node basis using a COOKIE_DATA property with the word \"recursive\" in the value." @@ -161,27 +247,24 @@ When the indentation would be larger than this, it will become :group 'org-plain-lists :type 'integer) -(defvar org-list-beginning-re - "^\\([ \t]*\\)\\([-+]\\|[0-9]+[.)]\\) +\\(.*\\)$") - (defcustom org-list-radio-list-templates '((latex-mode "% BEGIN RECEIVE ORGLST %n % END RECEIVE ORGLST %n \\begin{comment} #+ORGLST: SEND %n org-list-to-latex -| | | +- \\end{comment}\n") (texinfo-mode "@c BEGIN RECEIVE ORGLST %n @c END RECEIVE ORGLST %n @ignore #+ORGLST: SEND %n org-list-to-texinfo -| | | +- @end ignore\n") (html-mode "<!-- BEGIN RECEIVE ORGLST %n --> <!-- END RECEIVE ORGLST %n --> <!-- #+ORGLST: SEND %n org-list-to-html -| | | +- -->\n")) "Templates for radio lists in different major modes. All occurrences of %n in a template will be replaced with the name of the @@ -191,21 +274,547 @@ list, obtained by prompting the user." (list (symbol :tag "Major mode") (string :tag "Format")))) -;;;; Plain list items, including checkboxes +;;; Internal functions + +(defun org-list-end-re () + "Return the regex corresponding to the end of a list. +It depends on `org-empty-line-terminates-plain-lists'." + (if org-empty-line-terminates-plain-lists + "^[ \t]*\n" + org-list-end-regexp)) + +(defun org-item-re (&optional general) + "Return the correct regular expression for plain lists. +If GENERAL is non-nil, return the general regexp independent of the value +of `org-plain-list-ordered-item-terminator'." + (cond + ((or general (eq org-plain-list-ordered-item-terminator t)) + "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") + ((= org-plain-list-ordered-item-terminator ?.) + "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") + ((= org-plain-list-ordered-item-terminator ?\)) + "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") + (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))) + +(defconst org-item-beginning-re (concat "^" (org-item-re)) + "Regexp matching the beginning of a plain list item.") + +(defun org-list-ending-between (min max &optional firstp) + "Find the position of a list ending between MIN and MAX, or nil. +This function looks for `org-list-end-re' outside a block. + +If FIRSTP in non-nil, return the point at the beginning of the +nearest valid terminator from MIN. Otherwise, return the point at +the end of the nearest terminator from MAX." + (save-excursion + (let* ((start (if firstp min max)) + (end (if firstp max min)) + (search-fun (if firstp + #'org-search-forward-unenclosed + #'org-search-backward-unenclosed)) + (list-end-p (progn + (goto-char start) + (funcall search-fun (org-list-end-re) end t)))) + ;; Is there a valid list ending somewhere ? + (and list-end-p + ;; we want to be on the first line of the list ender + (match-beginning 0))))) + +(defun org-list-maybe-skip-block (search limit) + "Return non-nil value if point is in a block, skipping it on the way. +It looks for the boundary of the block in SEARCH direction, +stopping at LIMIT." + (save-match-data + (let ((case-fold-search t) + (boundary (if (eq search 're-search-forward) 3 5))) + (when (save-excursion + (and (funcall search "^[ \t]*#\\+\\(begin\\|end\\)_" limit t) + (= (length (match-string 1)) boundary))) + ;; We're in a block: get out of it + (goto-char (match-beginning 0)))))) + +(defun org-list-search-unenclosed-generic (search re bound noerr) + "Search a string outside blocks and protected places. +Arguments SEARCH, RE, BOUND and NOERR are similar to those in +`search-forward', `search-backward', `re-search-forward' and +`re-search-backward'." + (catch 'exit + (let ((origin (point))) + (while t + ;; 1. No match: return to origin or bound, depending on NOERR. + (unless (funcall search re bound noerr) + (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound)) + nil))) + ;; 2. Match not in block or protected: return point. Else + ;; skip the block and carry on. + (unless (or (get-text-property (match-beginning 0) 'org-protected) + (org-list-maybe-skip-block search bound)) + (throw 'exit (point))))))) + +(defun org-search-backward-unenclosed (regexp &optional bound noerror) + "Like `re-search-backward' but don't stop inside blocks or protected places. +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-backward'." + (org-list-search-unenclosed-generic + #'re-search-backward regexp (or bound (point-min)) noerror)) + +(defun org-search-forward-unenclosed (regexp &optional bound noerror) + "Like `re-search-forward' but don't stop inside blocks or protected places. +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-forward'." + (org-list-search-unenclosed-generic + #'re-search-forward regexp (or bound (point-max)) noerror)) + +(defun org-list-in-item-p-with-indent (limit) + "Is the cursor inside a plain list? +Plain lists are considered ending when a non-blank line is less +indented than the previous item within LIMIT." + (save-excursion + (beginning-of-line) + (cond + ;; do not start searching inside a block... + ((org-list-maybe-skip-block #'re-search-backward limit)) + ;; ... or at a blank line + ((looking-at "^[ \t]*$") + (skip-chars-backward " \r\t\n") + (beginning-of-line))) + (beginning-of-line) + (or (org-at-item-p) + (let* ((case-fold-search t) + (ind-ref (org-get-indentation)) + ;; Ensure there is at least an item above + (up-item-p (save-excursion + (org-search-backward-unenclosed + org-item-beginning-re limit t)))) + (and up-item-p + (catch 'exit + (while t + (cond + ((org-at-item-p) + (throw 'exit (< (org-get-indentation) ind-ref))) + ((looking-at "^[ \t]*$") + (skip-chars-backward " \r\t\n") + (beginning-of-line)) + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_")) + (t + (setq ind-ref (min (org-get-indentation) ind-ref)) + (forward-line -1)))))))))) + +(defun org-list-in-item-p-with-regexp (limit) + "Is the cursor inside a plain list? +Plain lists end when `org-list-end-regexp' is matched, or at a +blank line if `org-empty-line-terminates-plain-lists' is true. + +Argument LIMIT specifies the upper-bound of the search." + (save-excursion + (let* ((actual-pos (goto-char (point-at-eol))) + ;; Moved to eol so current line can be matched by + ;; `org-item-re'. + (last-item-start (save-excursion + (org-search-backward-unenclosed + org-item-beginning-re limit t))) + (list-ender (org-list-ending-between + last-item-start actual-pos))) + ;; We are in a list when we are on an item line or when we can + ;; find an item before point and there is no valid list ender + ;; between it and the point. + (and last-item-start (not list-ender))))) + +(defun org-list-top-point-with-regexp (limit) + "Return point at the top level item in a list. +Argument LIMIT specifies the upper-bound of the search. + +List ending is determined by regexp. See +`org-list-ending-method'. for more information." + (save-excursion + (let ((pos (point-at-eol))) + ;; Is there some list above this one ? If so, go to its ending. + ;; Otherwise, go back to the heading above or bob. + (goto-char (or (org-list-ending-between limit pos) limit)) + ;; From there, search down our list. + (org-search-forward-unenclosed org-item-beginning-re pos t) + (point-at-bol)))) + +(defun org-list-bottom-point-with-regexp (limit) + "Return point just before list ending. +Argument LIMIT specifies the lower-bound of the search. + +List ending is determined by regexp. See +`org-list-ending-method'. for more information." + (save-excursion + (let ((pos (org-get-item-beginning))) + ;; The list ending is either first point matching + ;; `org-list-end-re', point at first white-line before next + ;; heading, or eob. + (or (org-list-ending-between (min pos limit) limit t) limit)))) + +(defun org-list-top-point-with-indent (limit) + "Return point at the top level in a list. +Argument LIMIT specifies the upper-bound of the search. + +List ending is determined by indentation of text. See +`org-list-ending-method'. for more information." + (save-excursion + (let ((case-fold-search t)) + (let ((item-ref (goto-char (org-get-item-beginning))) + (ind-ref 10000)) + (forward-line -1) + (catch 'exit + (while t + (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) + (org-get-indentation)))) + (cond + ((looking-at "^[ \t]*:END:") + (throw 'exit item-ref)) + ((<= (point) limit) + (throw 'exit + (if (and (org-at-item-p) (< ind ind-ref)) + (point-at-bol) + item-ref))) + ((looking-at "^[ \t]*$") + (skip-chars-backward " \r\t\n") + (beginning-of-line)) + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_")) + ((not (org-at-item-p)) + (setq ind-ref (min ind ind-ref)) + (forward-line -1)) + ((>= ind ind-ref) + (throw 'exit item-ref)) + (t + (setq item-ref (point-at-bol) ind-ref 10000) + (forward-line -1)))))))))) + +(defun org-list-bottom-point-with-indent (limit) + "Return point just before list ending or nil if not in a list. +Argument LIMIT specifies the lower-bound of the search. + +List ending is determined by the indentation of text. See +`org-list-ending-method' for more information." + (save-excursion + (let ((ind-ref (progn + (goto-char (org-get-item-beginning)) + (org-get-indentation))) + (case-fold-search t)) + ;; do not start inside a block + (org-list-maybe-skip-block #'re-search-forward limit) + (beginning-of-line) + (catch 'exit + (while t + (skip-chars-forward " \t") + (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) + (org-get-indentation)))) + (cond + ((or (>= (point) limit) + (looking-at ":END:")) + (throw 'exit (progn + ;; Ensure bottom is just after a + ;; non-blank line. + (skip-chars-backward " \r\t\n") + (min (point-max) (1+ (point-at-eol)))))) + ((= (point) (point-at-eol)) + (skip-chars-forward " \r\t\n") + (beginning-of-line)) + ((org-at-item-p) + (setq ind-ref ind) + (forward-line 1)) + ((<= ind ind-ref) + (throw 'exit (progn + ;; Again, ensure bottom is just after a + ;; non-blank line. + (skip-chars-backward " \r\t\n") + (min (point-max) (1+ (point-at-eol)))))) + ((looking-at "#\\+begin_") + (re-search-forward "[ \t]*#\\+end_") + (forward-line 1)) + (t (forward-line 1))))))))) + +(defun org-list-at-regexp-after-bullet-p (regexp) + "Is point at a list item with REGEXP after bullet?" + (and (org-at-item-p) + (save-excursion + (goto-char (match-end 0)) + ;; Ignore counter if any + (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") + (goto-char (match-end 0))) + (looking-at regexp)))) + +(defun org-list-get-item-same-level (search-fun pos limit pre-move) + "Return point at the beginning of next item at the same level. +Search items using function SEARCH-FUN, from POS to LIMIT. It +uses PRE-MOVE before search. Return nil if no item was found." + (save-excursion + (goto-char pos) + (let* ((start (org-get-item-beginning)) + (ind (progn (goto-char start) (org-get-indentation)))) + ;; We don't want to match the current line. + (funcall pre-move) + ;; Skip any sublist on the way + (while (and (funcall search-fun org-item-beginning-re limit t) + (> (org-get-indentation) ind))) + (when (and (/= (point-at-bol) start) ; Have we moved ? + (= (org-get-indentation) ind)) + (point-at-bol))))) + +(defun org-list-separating-blank-lines-number (pos top bottom) + "Return number of blank lines that should separate items in list. +POS is the position of point to be considered. + +TOP and BOTTOM are respectively position of list beginning and +list ending. + +Assume point is at item's beginning. If the item is alone, apply +some heuristics to guess the result." + (save-excursion + (let ((insert-blank-p + (cdr (assq 'plain-list-item org-blank-before-new-entry))) + usr-blank) + (cond + ;; Trivial cases where there should be none. + ((or (and (not (eq org-list-ending-method 'indent)) + org-empty-line-terminates-plain-lists) + (not insert-blank-p)) 0) + ;; When `org-blank-before-new-entry' says so, it is 1. + ((eq insert-blank-p t) 1) + ;; plain-list-item is 'auto. Count blank lines separating + ;; neighbours items in list. + (t (let ((next-p (org-get-next-item (point) bottom))) + (cond + ;; Is there a next item? + (next-p (goto-char next-p) + (org-back-over-empty-lines)) + ;; Is there a previous item? + ((org-get-previous-item (point) top) + (org-back-over-empty-lines)) + ;; User inserted blank lines, trust him + ((and (> pos (org-end-of-item-before-blank bottom)) + (> (save-excursion + (goto-char pos) + (skip-chars-backward " \t") + (setq usr-blank (org-back-over-empty-lines))) 0)) + usr-blank) + ;; Are there blank lines inside the item ? + ((save-excursion + (org-search-forward-unenclosed + "^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1) + ;; No parent: no blank line. + (t 0)))))))) + +(defun org-list-insert-item-generic (pos &optional checkbox after-bullet) + "Insert a new list item at POS. +If POS is before first character after bullet of the item, the +new item will be created before the current one. + +Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET +after the bullet. Cursor will be after this text once the +function ends." + (goto-char pos) + ;; Is point in a special block? + (when (org-in-regexps-block-p + "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" + '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) + (if (not (cdr (assq 'insert org-list-automatic-rules))) + ;; Rule in `org-list-automatic-rules' forbids insertion. + (error "Cannot insert item inside a block") + ;; Else, move before it prior to add a new item. + (end-of-line) + (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) + (end-of-line 0))) + (let* ((true-pos (point)) + (top (org-list-top-point)) + (bottom (copy-marker (org-list-bottom-point))) + (bullet (and (goto-char (org-get-item-beginning)) + (org-list-bullet-string (org-get-bullet)))) + (ind (org-get-indentation)) + (before-p (progn + ;; Description item: text starts after colons. + (or (org-at-item-description-p) + ;; At a checkbox: text starts after it. + (org-at-item-checkbox-p) + ;; Otherwise, text starts after bullet. + (org-at-item-p)) + (<= true-pos (match-end 0)))) + (blank-lines-nb (org-list-separating-blank-lines-number + true-pos top bottom)) + (insert-fun + (lambda (text) + ;; insert bullet above item in order to avoid bothering + ;; with possible blank lines ending last item. + (goto-char (org-get-item-beginning)) + (org-indent-to-column ind) + (insert (concat bullet (when checkbox "[ ] ") after-bullet)) + ;; Stay between after-bullet and before text. + (save-excursion + (insert (concat text (make-string (1+ blank-lines-nb) ?\n)))) + (unless before-p + ;; store bottom: exchanging items doesn't change list + ;; bottom point but will modify marker anyway + (setq bottom (marker-position bottom)) + (let ((col (current-column))) + (org-list-exchange-items + (org-get-item-beginning) (org-get-next-item (point) bottom) + bottom) + ;; recompute next-item: last sexp modified list + (goto-char (org-get-next-item (point) bottom)) + (org-move-to-column col))) + ;; checkbox update might modify bottom point, so use a + ;; marker here + (setq bottom (copy-marker bottom)) + (when checkbox (org-update-checkbox-count-maybe)) + (org-list-repair nil top bottom)))) + (goto-char true-pos) + (cond + (before-p (funcall insert-fun nil) t) + ;; Can't split item: insert bullet at the end of item. + ((not (org-get-alist-option org-M-RET-may-split-line 'item)) + (funcall insert-fun nil) t) + ;; else, insert a new bullet along with everything from point + ;; down to last non-blank line of item. + (t + (delete-horizontal-space) + ;; Get pos again in case previous command modified line. + (let* ((pos (point)) + (end-before-blank (org-end-of-item-before-blank bottom)) + (after-text + (when (< pos end-before-blank) + (prog1 + (delete-and-extract-region pos end-before-blank) + ;; delete any blank line at and before point. + (beginning-of-line) + (while (looking-at "^[ \t]*$") + (delete-region (point-at-bol) (1+ (point-at-eol))) + (beginning-of-line 0)))))) + (funcall insert-fun after-text) t))))) + +(defvar org-last-indent-begin-marker (make-marker)) +(defvar org-last-indent-end-marker (make-marker)) + +(defun org-list-indent-item-generic (arg no-subtree top bottom) + "Indent a local list item including its children. +When number ARG is a negative, item will be outdented, otherwise +it will be indented. -;;; Plain list items +If a region is active, all items inside will be moved. + +If NO-SUBTREE is non-nil, only indent the item itself, not its +children. + +TOP and BOTTOM are respectively position at item beginning and at +item ending. + +Return t if successful." + (let* ((regionp (org-region-active-p)) + (rbeg (and regionp (region-beginning))) + (rend (and regionp (region-end)))) + (cond + ((and regionp + (goto-char rbeg) + (not (org-search-forward-unenclosed org-item-beginning-re rend t))) + (error "No item in region")) + ((not (org-at-item-p)) + (error "Not on an item")) + (t + ;; Are we going to move the whole list? + (let* ((specialp (and (cdr (assq 'indent org-list-automatic-rules)) + (not no-subtree) + (= top (point-at-bol))))) + ;; Determine begin and end points of zone to indent. If moving + ;; more than one item, ensure we keep them on subsequent moves. + (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (if regionp + (progn + (set-marker org-last-indent-begin-marker rbeg) + (set-marker org-last-indent-end-marker rend)) + (set-marker org-last-indent-begin-marker (point-at-bol)) + (set-marker org-last-indent-end-marker + (save-excursion + (cond + (specialp bottom) + (no-subtree (org-end-of-item-or-at-child bottom)) + (t (org-get-end-of-item bottom))))))) + ;; Get everything ready + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker)) + (struct (org-list-struct + beg end top (if specialp end bottom) (< arg 0))) + (origins (org-list-struct-origins struct)) + (beg-item (assq beg struct))) + (cond + ;; Special case: moving top-item with indent rule + (specialp + (let* ((level-skip (org-level-increment)) + (offset (if (< arg 0) (- level-skip) level-skip)) + (top-ind (nth 1 beg-item))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary + (when (and (= (+ top-ind offset) 0) + (string-match "*" (nth 2 beg-item))) + (setcdr beg-item (list (nth 1 beg-item) + (org-list-bullet-string "-")))) + ;; Shift ancestor + (let ((anc (car struct))) + (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) + (org-list-struct-fix-struct struct origins) + (org-list-struct-apply-struct struct end)))) + ;; Forbidden move + ((and (< arg 0) + (or (and no-subtree + (not regionp) + (org-list-struct-get-child beg-item struct)) + (let ((last-item (save-excursion + (goto-char end) + (skip-chars-backward " \r\t\n") + (goto-char (org-get-item-beginning)) + (org-list-struct-assoc-at-point)))) + (org-list-struct-get-child last-item struct)))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((shifted-ori (if (< arg 0) + (org-list-struct-outdent beg end origins) + (org-list-struct-indent beg end origins struct)))) + (org-list-struct-fix-struct struct shifted-ori) + (org-list-struct-apply-struct struct bottom)))))))))) + +;;; Predicates + +(defun org-in-item-p () + "Is the cursor inside a plain list? +This checks `org-list-ending-method'." + (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) + (let* ((prev-head (save-excursion (outline-previous-heading))) + (bound (if prev-head + (or (save-excursion + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*:END:" prev-head t))) + prev-head) + (point-min)))) + (cond + ((eq org-list-ending-method 'regexp) + (org-list-in-item-p-with-regexp bound)) + ((eq org-list-ending-method 'indent) + (org-list-in-item-p-with-indent bound)) + (t (and (org-list-in-item-p-with-regexp bound) + (org-list-in-item-p-with-indent bound))))))) + +(defun org-list-first-item-p (top) + "Is this item the first item in a plain list? +Assume point is at an item. + +TOP is the position of list's top-item." + (save-excursion + (beginning-of-line) + (let ((ind (org-get-indentation))) + (or (not (org-search-backward-unenclosed org-item-beginning-re top t)) + (< (org-get-indentation) ind))))) (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" - (let ((llt org-plain-list-ordered-item-terminator)) - (save-excursion - (goto-char (point-at-bol)) - (looking-at - (cond - ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) + (save-excursion + (beginning-of-line) (looking-at org-item-beginning-re))) (defun org-at-item-bullet-p () "Is point at the bullet of a plain list item?" @@ -213,170 +822,18 @@ list, obtained by prompting the user." (not (member (char-after) '(?\ ?\t))) (< (point) (match-end 0)))) -(defun org-in-item-p () - "It the cursor inside a plain list item. -Does not have to be the first line." - (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - t) - (error nil)))) - -(defun org-insert-item (&optional checkbox) - "Insert a new item at the current level. -Return t when things worked, nil when we are not in an item." - (when (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - (if (org-invisible-p) (error "Invisible item")) - t) - (error nil))) - (let* ((bul (match-string 0)) - (descp (save-excursion (goto-char (match-beginning 0)) - (beginning-of-line 1) - (save-match-data - (and (looking-at "[ \t]*\\(.*?\\) ::") - (match-string 1))))) - (empty-line-p (save-excursion - (goto-char (match-beginning 0)) - (and (not (bobp)) - (or (beginning-of-line 0) t) - (save-match-data - (looking-at "[ \t]*$"))))) - (timerp (and descp - (save-match-data - (string-match "^[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+$" - descp)))) - (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") - (match-end 0))) - (blank-a (if org-empty-line-terminates-plain-lists - nil - (cdr (assq 'plain-list-item org-blank-before-new-entry)))) - (blank (if (eq blank-a 'auto) empty-line-p blank-a)) - pos) - (if descp (setq checkbox nil)) - (if timerp - (progn (org-timer-item) t) - (cond - ((and (org-at-item-p) (<= (point) eow)) - ;; before the bullet - (beginning-of-line 1) - (open-line (if blank 2 1))) - ((<= (point) eow) - (beginning-of-line 1)) - (t - (unless (org-get-alist-option org-M-RET-may-split-line 'item) - (end-of-line 1) - (delete-horizontal-space)) - (newline (if blank 2 1)))) - (insert bul - (if checkbox "[ ]" "") - (if descp (concat (if checkbox " " "") - (read-string "Term: ") " :: ") "")) - (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1))) - (org-maybe-renumber-ordered-list) - (and checkbox (org-update-checkbox-count-maybe)) - t))) +(defun org-at-item-timer-p () + "Is point at a line starting a plain list item with a timer?" + (org-list-at-regexp-after-bullet-p + "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")) -;;; Checkboxes +(defun org-at-item-description-p () + "Is point at a description list item?" + (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+")) (defun org-at-item-checkbox-p () "Is point at a line starting a plain-list item with a checklet?" - (and (org-at-item-p) - (save-excursion - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (looking-at "\\[[- X]\\]")))) - -(defun org-toggle-checkbox (&optional toggle-presence) - "Toggle the checkbox in the current line. -With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. -With double prefix, set checkbox to [-]. -When there is an active region, toggle status or presence of the checkbox -in the first line, and make every item in the region have the same -status or presence, respectively. -If the cursor is in a headline, apply this to all checkbox items in the -text below the heading." - (interactive "P") - (catch 'exit - (let (beg end status first-present first-status blocked) - (cond - ((org-region-active-p) - (setq beg (region-beginning) end (region-end))) - ((org-on-heading-p) - (setq beg (point) end (save-excursion (outline-next-heading) (point)))) - ((org-at-item-checkbox-p) - (save-excursion - (if (equal toggle-presence '(4)) - (progn - (replace-match "") - (goto-char (match-beginning 0)) - (just-one-space)) - (when (setq blocked (org-checkbox-blocked-p)) - (error "Checkbox blocked because of unchecked box in line %d" - blocked)) - (replace-match - (cond ((equal toggle-presence '(16)) "[-]") - ((member (match-string 0) '("[ ]" "[-]")) "[X]") - (t "[ ]")) - t t))) - (throw 'exit t)) - ((org-at-item-p) - ;; add a checkbox - (save-excursion - (goto-char (match-end 0)) - (insert "[ ] ")) - (throw 'exit t)) - (t (error "Not at a checkbox or heading, and no active region"))) - (setq end (move-marker (make-marker) end)) - (save-excursion - (goto-char beg) - (setq first-present (org-at-item-checkbox-p) - first-status - (save-excursion - (and (re-search-forward "[ \t]\\(\\[[ X]\\]\\)" end t) - (equal (match-string 1) "[X]")))) - (while (< (point) end) - (if toggle-presence - (cond - ((and first-present (org-at-item-checkbox-p)) - (save-excursion - (replace-match "") - (goto-char (match-beginning 0)) - (just-one-space))) - ((and (not first-present) (not (org-at-item-checkbox-p)) - (org-at-item-p)) - (save-excursion - (goto-char (match-end 0)) - (insert "[ ] ")))) - (when (org-at-item-checkbox-p) - (setq status (equal (match-string 0) "[X]")) - (replace-match - (if first-status "[ ]" "[X]") t t))) - (beginning-of-line 2))))) - (org-update-checkbox-count-maybe)) - -(defun org-reset-checkbox-state-subtree () - "Reset all checkboxes in an entry subtree." - (interactive "*") - (save-restriction - (save-excursion - (org-narrow-to-subtree) - (org-show-subtree) - (goto-char (point-min)) - (let ((end (point-max))) - (while (< (point) end) - (when (org-at-item-checkbox-p) - (replace-match "[ ]" t t)) - (beginning-of-line 2)))) - (org-update-checkbox-count-maybe))) + (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) (defun org-checkbox-blocked-p () "Is the current checkbox blocked from for being checked now? @@ -389,403 +846,621 @@ A checkbox is blocked if all of the following conditions are fulfilled: (save-match-data (save-excursion (unless (org-at-item-checkbox-p) (throw 'exit nil)) - (when (equal (match-string 0) "[X]") + (when (equal (match-string 1) "[X]") ;; the box is already checked! (throw 'exit nil)) (let ((end (point-at-bol))) (condition-case nil (org-back-to-heading t) (error (throw 'exit nil))) (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) - (if (re-search-forward "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t) - (org-current-line) - nil)))))) + (when (org-search-forward-unenclosed + "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t) + (org-current-line))))))) + +;;; Navigate + +;; Every interactive navigation function is derived from a +;; non-interactive one, which doesn't move point, assumes point is +;; already in a list and doesn't compute list boundaries. + +;; If you plan to use more than one org-list function is some code, +;; you should therefore first check if point is in a list with +;; `org-in-item-p' or `org-at-item-p', then compute list boundaries +;; with `org-list-top-point' and `org-list-bottom-point', and make use +;; of non-interactive forms. + +(defun org-list-top-point () + "Return point at the top level in a list. +Assume point is in a list." + (let* ((prev-head (save-excursion (outline-previous-heading))) + (bound (if prev-head + (or (save-excursion + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*:END:" prev-head t))) + prev-head) + (point-min)))) + (cond + ((eq org-list-ending-method 'regexp) + (org-list-top-point-with-regexp bound)) + ((eq org-list-ending-method 'indent) + (org-list-top-point-with-indent bound)) + (t (let ((top-re (org-list-top-point-with-regexp bound))) + (org-list-top-point-with-indent (or top-re bound))))))) + +(defun org-list-bottom-point () + "Return point just before list ending. +Assume point is in a list." + (let* ((next-head (save-excursion + (and (let ((outline-regexp org-outline-regexp)) + ;; Use default regexp because folding + ;; changes OUTLINE-REGEXP. + (outline-next-heading))))) + (limit (or (save-excursion + (and (re-search-forward "^[ \t]*:END:" next-head t) + (point-at-bol))) + next-head + (point-max)))) + (cond + ((eq org-list-ending-method 'regexp) + (org-list-bottom-point-with-regexp limit)) + ((eq org-list-ending-method 'indent) + (org-list-bottom-point-with-indent limit)) + (t (let ((bottom-re (org-list-bottom-point-with-regexp limit))) + (org-list-bottom-point-with-indent (or bottom-re limit))))))) + +(defun org-get-item-beginning () + "Return position of current item beginning." + (save-excursion + ;; possibly match current line + (end-of-line) + (org-search-backward-unenclosed org-item-beginning-re nil t) + (point-at-bol))) -(defvar org-checkbox-statistics-hook nil - "Hook that is run whenever Org thinks checkbox statistics should be updated. -This hook runs even if `org-provide-checkbox-statistics' is nil, to it can -be used to implement alternative ways of collecting statistics information.") +(defun org-beginning-of-item () + "Go to the beginning of the current hand-formatted item. +If the cursor is not in an item, throw an error." + (interactive) + (if (org-in-item-p) + (goto-char (org-get-item-beginning)) + (error "Not in an item"))) -(defun org-update-checkbox-count-maybe () - "Update checkbox statistics unless turned off by user." - (when org-provide-checkbox-statistics - (org-update-checkbox-count)) - (run-hooks 'org-checkbox-statistics-hook)) +(defun org-get-beginning-of-list (top) + "Return position of the first item of the current list or sublist. +TOP is the position at list beginning." + (save-excursion + (let (prev-p) + (while (setq prev-p (org-get-previous-item (point) top)) + (goto-char prev-p)) + (point-at-bol)))) -(defun org-update-checkbox-count (&optional all) - "Update the checkbox statistics in the current section. -This will find all statistic cookies like [57%] and [6/12] and update them -with the current numbers. With optional prefix argument ALL, do this for -the whole buffer." - (interactive "P") - (save-excursion - (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 - (beg (condition-case nil - (progn (org-back-to-heading) (point)) - (error (point-min)))) - (end (move-marker (make-marker) - (progn (outline-next-heading) (point)))) - (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") - (re-find (concat re "\\|" re-box)) - beg-cookie end-cookie is-percent c-on c-off lim new - eline curr-ind next-ind continue-from startsearch - (recursive - (or (not org-hierarchical-checkbox-statistics) - (string-match "\\<recursive\\>" - (or (org-entry-get nil "COOKIE_DATA") "")))) - (cstat 0) - ) - (when all - (goto-char (point-min)) - (outline-next-heading) - (setq beg (point) end (point-max))) - (goto-char end) - ;; find each statistics cookie - (while (and (re-search-backward re-find beg t) - (not (save-match-data - (and (org-on-heading-p) - (string-match "\\<todo\\>" - (downcase - (or (org-entry-get - nil "COOKIE_DATA") - ""))))))) - (setq beg-cookie (match-beginning 1) - end-cookie (match-end 1) - cstat (+ cstat (if end-cookie 1 0)) - startsearch (point-at-eol) - continue-from (match-beginning 0) - is-percent (match-beginning 2) - lim (cond - ((org-on-heading-p) (outline-next-heading) (point)) - ((org-at-item-p) (org-end-of-item) (point)) - (t nil)) - c-on 0 - c-off 0) - (when lim - ;; find first checkbox for this cookie and gather - ;; statistics from all that are at this indentation level - (goto-char startsearch) - (if (re-search-forward re-box lim t) - (progn - (org-beginning-of-item) - (setq curr-ind (org-get-indentation)) - (setq next-ind curr-ind) - (while (and (bolp) (org-at-item-p) - (if recursive - (<= curr-ind next-ind) - (= curr-ind next-ind))) - (save-excursion (end-of-line) (setq eline (point))) - (if (re-search-forward re-box eline t) - (if (member (match-string 2) '("[ ]" "[-]")) - (setq c-off (1+ c-off)) - (setq c-on (1+ c-on)))) - (if (not recursive) - (org-end-of-item) - (end-of-line) - (when (re-search-forward org-list-beginning-re lim t) - (beginning-of-line))) - (setq next-ind (org-get-indentation))))) - (goto-char continue-from) - ;; update cookie - (when end-cookie - (setq new (if is-percent - (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off)))) - (format "[%d/%d]" c-on (+ c-on c-off)))) - (goto-char beg-cookie) - (insert new) - (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) - ;; update items checkbox if it has one - (when (org-at-item-p) - (org-beginning-of-item) - (when (and (> (+ c-on c-off) 0) - (re-search-forward re-box (point-at-eol) t)) - (setq beg-cookie (match-beginning 2) - end-cookie (match-end 2)) - (delete-region beg-cookie end-cookie) - (goto-char beg-cookie) - (cond ((= c-off 0) (insert "[X]")) - ((= c-on 0) (insert "[ ]")) - (t (insert "[-]"))) - ))) - (goto-char continue-from)) - (when (interactive-p) - (message "Checkbox statistics updated %s (%d places)" - (if all "in entire file" "in current outline entry") cstat))))) +(defun org-beginning-of-item-list () + "Go to the beginning item of the current list or sublist. +Return an error if not in a list." + (interactive) + (if (org-in-item-p) + (goto-char (org-get-beginning-of-list (org-list-top-point))) + (error "Not in an item"))) -(defun org-get-checkbox-statistics-face () - "Select the face for checkbox statistics. -The face will be `org-done' when all relevant boxes are checked. Otherwise -it will be `org-todo'." - (if (match-end 1) - (if (equal (match-string 1) "100%") - 'org-checkbox-statistics-done - 'org-checkbox-statistics-todo) - (if (and (> (match-end 2) (match-beginning 2)) - (equal (match-string 2) (match-string 3))) - 'org-checkbox-statistics-done - 'org-checkbox-statistics-todo))) +(defun org-get-end-of-list (bottom) + "Return position at the end of the current list or sublist. +BOTTOM is the position at list ending." + (save-excursion + (goto-char (org-get-item-beginning)) + (let ((ind (org-get-indentation))) + (while (and (/= (point) bottom) + (>= (org-get-indentation) ind)) + (org-search-forward-unenclosed org-item-beginning-re bottom 'move)) + (if (= (point) bottom) bottom (point-at-bol))))) -(defun org-beginning-of-item () - "Go to the beginning of the current hand-formatted item. -If the cursor is not in an item, throw an error." +(defun org-end-of-item-list () + "Go to the end of the current list or sublist. +If the cursor in not in an item, throw an error." (interactive) - (let ((pos (point)) - (limit (save-excursion - (condition-case nil - (progn - (org-back-to-heading) - (beginning-of-line 2) (point)) - (error (point-min))))) - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - ind ind1) - (if (org-at-item-p) - (beginning-of-line 1) - (beginning-of-line 1) - (skip-chars-forward " \t") - (setq ind (current-column)) - (if (catch 'exit - (while t - (beginning-of-line 0) - (if (or (bobp) (< (point) limit)) (throw 'exit nil)) - - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (< ind1 ind) - (progn (beginning-of-line 1) (throw 'exit (org-at-item-p)))))) - nil - (goto-char pos) - (error "Not in an item"))))) + (if (org-in-item-p) + (goto-char (org-get-end-of-list (org-list-bottom-point))) + (error "Not in an item"))) + +(defun org-get-end-of-item (bottom) + "Return position at the end of the current item. +BOTTOM is the position at list ending." + (or (org-get-next-item (point) bottom) + (org-get-end-of-list bottom))) (defun org-end-of-item () "Go to the end of the current hand-formatted item. If the cursor is not in an item, throw an error." (interactive) - (let* ((pos (point)) - ind1 - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - (limit (save-excursion (outline-next-heading) (point))) - (ind (save-excursion - (org-beginning-of-item) - (skip-chars-forward " \t") - (current-column))) - (end (catch 'exit - (while t - (beginning-of-line 2) - (if (eobp) (throw 'exit (point))) - (if (>= (point) limit) (throw 'exit (point-at-bol))) - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (<= ind1 ind) - (throw 'exit (point-at-bol))))))) - (if end - (goto-char end) - (goto-char pos) - (error "Not in an item")))) + (if (org-in-item-p) + (goto-char (org-get-end-of-item (org-list-bottom-point))) + (error "Not in an item"))) + +(defun org-end-of-item-or-at-child (bottom) + "Move to the end of the item, stops before the first child if any. +BOTTOM is the position at list ending." + (end-of-line) + (goto-char + (if (org-search-forward-unenclosed org-item-beginning-re bottom t) + (point-at-bol) + (org-get-end-of-item bottom)))) + +(defun org-end-of-item-before-blank (bottom) + "Return point at end of item, before any blank line. +Point returned is at eol. + +BOTTOM is the position at list ending." + (save-excursion + (goto-char (org-get-end-of-item bottom)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) -(defun org-next-item () - "Move to the beginning of the next item in the current plain list. -Error if not at a plain list, or if this is the last item in the list." - (interactive) - (let (ind ind1 (pos (point))) - (org-beginning-of-item) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq ind1 (org-get-indentation)) - (unless (and (org-at-item-p) (= ind ind1)) - (goto-char pos) - (error "On last item")))) +(defun org-get-previous-item (pos limit) + "Return point of the previous item at the same level as POS. +Stop searching at LIMIT. Return nil if no item is found." + (org-list-get-item-same-level + #'org-search-backward-unenclosed pos limit #'beginning-of-line)) (defun org-previous-item () - "Move to the beginning of the previous item in the current plain list. -Error if not at a plain list, or if this is the first item in the list." + "Move to the beginning of the previous item. +Item is at the same level in the current plain list. Error if not +in a plain list, or if this is the first item in the list." (interactive) - (let (beg ind ind1 (pos (point))) - (org-beginning-of-item) - (setq beg (point)) - (setq ind (org-get-indentation)) - (goto-char beg) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - nil - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))))) - (condition-case nil - (if (or (not (org-at-item-p)) - (< ind1 (1- ind))) - (error "") - (org-beginning-of-item)) - (error (goto-char pos) - (error "On first item"))))) - -(defun org-first-list-item-p () - "Is this heading the first item in a plain list?" - (unless (org-at-item-p) - (error "Not at a plain list item")) + (if (not (org-in-item-p)) + (error "Not in an item") + (let ((prev-p (org-get-previous-item (point) (org-list-top-point)))) + (if prev-p (goto-char prev-p) (error "On first item"))))) + +(defun org-get-next-item (pos limit) + "Return point of the next item at the same level as POS. +Stop searching at LIMIT. Return nil if no item is found." + (org-list-get-item-same-level + #'org-search-forward-unenclosed pos limit #'end-of-line)) + +(defun org-next-item () + "Move to the beginning of the next item. +Item is at the same level in the current plain list. Error if not +in a plain list, or if this is the last item in the list." + (interactive) + (if (not (org-in-item-p)) + (error "Not in an item") + (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) + (if next-p (goto-char next-p) (error "On last item"))))) + +;;; Manipulate + +(defun org-list-exchange-items (beg-A beg-B bottom) + "Swap item starting at BEG-A with item starting at BEG-B. +Blank lines at the end of items are left in place. Assume BEG-A +is lesser than BEG-B. + +BOTTOM is the position at list ending." (save-excursion - (org-beginning-of-item) - (= (point) (save-excursion (org-beginning-of-item-list))))) + (let* ((end-of-item-no-blank + (lambda (pos) + (goto-char pos) + (goto-char (org-end-of-item-before-blank bottom)))) + (end-A-no-blank (funcall end-of-item-no-blank beg-A)) + (end-B-no-blank (funcall end-of-item-no-blank beg-B)) + (body-A (buffer-substring beg-A end-A-no-blank)) + (body-B (buffer-substring beg-B end-B-no-blank)) + (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))) + (goto-char beg-A) + (delete-region beg-A end-B-no-blank) + (insert (concat body-B between-A-no-blank-and-B body-A))))) (defun org-move-item-down () "Move the plain list item at point down, i.e. swap with following item. Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) - (let ((col (current-column)) - (pos (point)) - beg beg0 end end0 ind ind1 txt ne-end ne-beg) - (org-beginning-of-item) - (setq beg0 (point)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq end0 (point)) - (setq ind1 (org-get-indentation)) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (when (and (org-first-list-item-p) (< ne-end ne-beg)) - ;; include less whitespace - (save-excursion - (goto-char beg) - (forward-line (- ne-beg ne-end)) - (setq beg (point)))) - (goto-char end0) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (org-end-of-item) - (org-back-over-empty-lines) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (goto-char pos) (org-skip-whitespace) - (org-maybe-renumber-ordered-list) - (move-to-column col)) - (goto-char pos) - (move-to-column col) - (error "Cannot move this item further down")))) - -(defun org-move-item-up (arg) + (if (not (org-at-item-p)) + (error "Not at an item") + (let* ((pos (point)) + (col (current-column)) + (bottom (org-list-bottom-point)) + (actual-item (goto-char (org-get-item-beginning))) + (next-item (org-get-next-item (point) bottom))) + (if (not next-item) + (progn + (goto-char pos) + (error "Cannot move this item further down")) + (org-list-exchange-items actual-item next-item bottom) + (org-list-repair nil nil bottom) + (goto-char (org-get-next-item (point) bottom)) + (org-move-to-column col))))) + +(defun org-move-item-up () "Move the plain list item at point up, i.e. swap with previous item. Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." - (interactive "p") - (let ((col (current-column)) (pos (point)) - beg beg0 end ind ind1 txt - ne-beg ne-ins ins-end) - (org-beginning-of-item) - (setq beg0 (point)) - (setq ind (org-get-indentation)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (org-end-of-item) - (org-back-over-empty-lines) - (setq end (point)) - (goto-char beg0) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (if org-empty-line-terminates-plain-lists - (progn - (goto-char pos) - (error "Cannot move this item further up")) - nil) - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))))) - (condition-case nil - (org-beginning-of-item) - (error (goto-char beg0) - (move-to-column col) - (error "Cannot move this item further up"))) - (setq ind1 (org-get-indentation)) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (setq ne-ins (org-back-over-empty-lines)) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (setq ins-end (point)) - (goto-char pos) (org-skip-whitespace) - - (when (and (org-first-list-item-p) (> ne-ins ne-beg)) - ;; Move whitespace back to beginning - (save-excursion - (goto-char ins-end) - (let ((kill-whole-line t)) - (kill-line (- ne-ins ne-beg)) (point))) - (insert (make-string (- ne-ins ne-beg) ?\n))) - - (org-maybe-renumber-ordered-list) - (move-to-column col)) - (goto-char pos) - (move-to-column col) - (error "Cannot move this item further up")))) - -(defun org-maybe-renumber-ordered-list () - "Renumber the ordered list at point if setup allows it. -This tests the user option `org-auto-renumber-ordered-lists' before -doing the renumbering." (interactive) - (when (and org-auto-renumber-ordered-lists - (org-at-item-p)) - (if (match-beginning 3) - (org-renumber-ordered-list 1) - (org-fix-bullet-type)))) - -(defun org-maybe-renumber-ordered-list-safe () - (condition-case nil - (save-excursion - (org-maybe-renumber-ordered-list)) - (error nil))) + (if (not (org-at-item-p)) + (error "Not at an item") + (let* ((pos (point)) + (col (current-column)) + (top (org-list-top-point)) + (bottom (org-list-bottom-point)) + (actual-item (goto-char (org-get-item-beginning))) + (prev-item (org-get-previous-item (point) top))) + (if (not prev-item) + (progn + (goto-char pos) + (error "Cannot move this item further up")) + (org-list-exchange-items prev-item actual-item bottom) + (org-list-repair nil top bottom) + (org-move-to-column col))))) -(defun org-cycle-list-bullet (&optional which) - "Cycle through the different itemize/enumerate bullets. -This cycle the entire list level through the sequence: +(defun org-insert-item (&optional checkbox) + "Insert a new item at the current level. +If cursor is before first character after bullet of the item, the +new item will be created before the current one. - `-' -> `+' -> `*' -> `1.' -> `1)' +If CHECKBOX is non-nil, add a checkbox next to the bullet. -If WHICH is a string, use that as the new bullet. If WHICH is an integer, -0 means `-', 1 means `+' etc." - (interactive "P") - (org-preserve-lc - (org-beginning-of-item-list) - (org-at-item-p) - (beginning-of-line 1) - (let ((current (match-string 0)) - (prevp (eq which 'previous)) - new old) - (setq new (cond - ((and (numberp which) - (nth (1- which) '("-" "+" "*" "1." "1)")))) - ((string-match "-" current) (if prevp "1)" "+")) - ((string-match "\\+" current) - (if prevp "-" (if (looking-at "\\S-") "1." "*"))) - ((string-match "\\*" current) (if prevp "+" "1.")) - ((string-match "\\." current) - (if prevp (if (looking-at "\\S-") "+" "*") "1)")) - ((string-match ")" current) (if prevp "1." "-")) - (t (error "This should not happen")))) - (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)") - (setq old (match-string 2)) - (replace-match (concat "\\1" new))) - (org-shift-item-indentation (- (length new) (length old))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list)))) +Return t when things worked, nil when we are not in an item, or +item is invisible." + (unless (or (not (org-in-item-p)) + (save-excursion + (goto-char (org-get-item-beginning)) + (org-invisible-p))) + (if (save-excursion + (goto-char (org-get-item-beginning)) + (org-at-item-timer-p)) + ;; Timer list: delegate to `org-timer-item'. + (progn (org-timer-item) t) + ;; if we're in a description list, ask for the new term. + (let ((desc-text (when (save-excursion + (and (goto-char (org-get-item-beginning)) + (org-at-item-description-p))) + (concat (read-string "Term: ") " :: ")))) + ;; Don't insert a checkbox if checkbox rule is applied and it + ;; is a description item. + (org-list-insert-item-generic + (point) (and checkbox + (or (not desc-text) + (not (cdr (assq 'checkbox org-list-automatic-rules))))) + desc-text))))) + +;;; Structures + +;; The idea behind structures is to avoid moving back and forth in the +;; buffer on costly operations like indenting or fixing bullets. + +;; It achieves this by taking a snapshot of an interesting part of the +;; list, in the shape of an alist, using `org-list-struct'. + +;; It then proceeds to changes directly on the alist, with the help of +;; and `org-list-struct-origins'. When those are done, +;; `org-list-struct-apply-struct' applies the changes to the buffer. + +(defun org-list-struct-assoc-at-point () + "Return the structure association at point. +It is a cons-cell whose key is point and values are indentation, +bullet string and bullet counter, if any." + (save-excursion + (beginning-of-line) + (list (point-at-bol) + (org-get-indentation) + (progn + (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)") + (match-string 1)) + (progn + (goto-char (match-end 0)) + (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]") + (match-string 1)))))) + +(defun org-list-struct (begin end top bottom &optional outdent) + "Return the structure containing the list between BEGIN and END. +A structure is an alist where key is point of item and values +are, in that order, indentation, bullet string and value of +counter, if any. A structure contains every list and sublist that +has items between BEGIN and END along with their common ancestor. +If no such ancestor can be found, the function will add a virtual +ancestor at position 0. + +TOP and BOTTOM are respectively the position of list beginning +and list ending. + +If OUTDENT is non-nil, it will also grab all of the parent list +and the grand-parent. Setting OUTDENT to t is mandatory when next +change is an outdent." + (save-excursion + (let* (struct + (extend + (lambda (struct) + (let* ((ind-min (apply 'min (mapcar 'cadr struct))) + (begin (caar struct)) + (end (caar (last struct))) + pre-list post-list) + (goto-char begin) + ;; Find beginning of most outdented list (min list) + (while (and (org-search-backward-unenclosed + org-item-beginning-re top t) + (>= (org-get-indentation) ind-min)) + (setq pre-list (cons (org-list-struct-assoc-at-point) + pre-list))) + ;; Now get the parent. If none, add a virtual ancestor + (if (< (org-get-indentation) ind-min) + (setq pre-list (cons (org-list-struct-assoc-at-point) + pre-list)) + (setq pre-list (cons (list 0 (org-get-indentation) "" nil) + pre-list))) + ;; Find end of min list + (goto-char end) + (end-of-line) + (while (and (org-search-forward-unenclosed + org-item-beginning-re bottom 'move) + (>= (org-get-indentation) ind-min)) + (setq post-list (cons (org-list-struct-assoc-at-point) + post-list))) + ;; Is list is malformed? If some items are less + ;; indented that top-item, add them anyhow. + (when (and (= (caar pre-list) 0) (< (point) bottom)) + (beginning-of-line) + (while (org-search-forward-unenclosed + org-item-beginning-re bottom t) + (setq post-list (cons (org-list-struct-assoc-at-point) + post-list)))) + (append pre-list struct (reverse post-list)))))) + ;; Here we start: first get the core zone... + (goto-char end) + (while (org-search-backward-unenclosed org-item-beginning-re begin t) + (setq struct (cons (org-list-struct-assoc-at-point) struct))) + ;; ... then, extend it to make it a structure... + (let ((extended (funcall extend struct))) + ;; ... twice when OUTDENT is non-nil and struct still can be + ;; extended + (if (and outdent (> (caar extended) 0)) + (funcall extend extended) + extended))))) + +(defun org-list-struct-origins (struct) + "Return an alist where key is item's position and value parent's. +STRUCT is the list's structure looked up." + (let* ((struct-rev (reverse struct)) + (acc (list (cons (nth 1 (car struct)) 0))) + (prev-item (lambda (item) + (car (nth 1 (member (assq item struct) struct-rev))))) + (get-origins + (lambda (item) + (let* ((item-pos (car item)) + (ind (nth 1 item)) + (prev-ind (caar acc))) + (cond + ;; List closing. + ((> prev-ind ind) + (let ((current-origin (or (member (assq ind acc) acc) + ;; needed if top-point is + ;; not the most outdented + (last acc)))) + (setq acc current-origin) + (cons item-pos (cdar acc)))) + ;; New list + ((< prev-ind ind) + (let ((origin (funcall prev-item item-pos))) + (setq acc (cons (cons ind origin) acc)) + (cons item-pos origin))) + ;; Current list going on + (t (cons item-pos (cdar acc)))))))) + (cons '(0 . 0) (mapcar get-origins (cdr struct))))) + +(defun org-list-struct-get-parent (item struct origins) + "Return parent association of ITEM in STRUCT or nil. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (let* ((parent-pos (cdr (assq (car item) origins)))) + (when (> parent-pos 0) (assq parent-pos struct)))) + +(defun org-list-struct-get-child (item struct) + "Return child association of ITEM in STRUCT or nil." + (let ((ind (nth 1 item)) + (next-item (cadr (member item struct)))) + (when (and next-item (> (nth 1 next-item) ind)) next-item))) + +(defun org-list-struct-fix-bul (struct origins) + "Verify and correct bullets for every association in STRUCT. +ORIGINS is the alist of parents. See `org-list-struct-origins'. + +This function modifies STRUCT." + (let* (acc + (init-bul (lambda (item) + (let ((counter (nth 3 item)) + (bullet (org-list-bullet-string (nth 2 item)))) + (cond + ((and (string-match "[0-9]+" bullet) counter) + (replace-match counter nil nil bullet)) + ((string-match "[0-9]+" bullet) + (replace-match "1" nil nil bullet)) + (t bullet))))) + (set-bul (lambda (item bullet) + (setcdr item (list (nth 1 item) bullet (nth 3 item))))) + (get-bul (lambda (item bullet) + (let* ((counter (nth 3 item))) + (if (and counter (string-match "[0-9]+" bullet)) + (replace-match counter nil nil bullet) + bullet)))) + (fix-bul + (lambda (item) struct + (let* ((parent (cdr (assq (car item) origins))) + (orig-ref (assq parent acc))) + (if orig-ref + ;; Continuing previous list + (let* ((prev-bul (cdr orig-ref)) + (new-bul (funcall get-bul item prev-bul))) + (setcdr orig-ref (org-list-inc-bullet-maybe new-bul)) + (funcall set-bul item new-bul)) + ;; A new list is starting + (let ((new-bul (funcall init-bul item))) + (funcall set-bul item new-bul) + (setq acc (cons (cons parent + (org-list-inc-bullet-maybe new-bul)) + acc)))))))) + (mapc fix-bul (cdr struct)))) + +(defun org-list-struct-fix-ind (struct origins) + "Verify and correct indentation for every association in STRUCT. +ORIGINS is the alist of parents. See `org-list-struct-origins'. + +This function modifies STRUCT." + (let* ((headless (cdr struct)) + (ancestor (car struct)) + (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor)))) + (new-ind + (lambda (item) + (let* ((parent (org-list-struct-get-parent item headless origins))) + (if parent + ;; Indent like parent + length of parent's bullet + (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) + (cddr item))) + ;; If no parent, indent like top-point + (setcdr item (cons top-ind (cddr item)))))))) + (mapc new-ind headless))) + +(defun org-list-struct-fix-struct (struct origins) + "Return STRUCT with correct bullets and indentation. +ORIGINS is the alist of parents. See `org-list-struct-origins'. + +Only elements of STRUCT that have changed are returned." + (let ((old (copy-alist struct))) + (org-list-struct-fix-bul struct origins) + (org-list-struct-fix-ind struct origins) + (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct)))) + +(defun org-list-struct-outdent (start end origins) + "Outdent items in a structure. +Items are indented when their key is between START, included, and +END, excluded. + +ORIGINS is the alist of parents. See `org-list-struct-origins'. + +STRUCT is the concerned structure." + (let* (acc + (out (lambda (cell) + (let* ((item (car cell)) + (parent (cdr cell))) + (cond + ;; Item not yet in zone: keep association + ((< item start) cell) + ;; Item out of zone: follow associations in acc + ((>= item end) + (let ((convert (assq parent acc))) + (if convert (cons item (cdr convert)) cell))) + ;; Item has no parent: error + ((<= parent 0) + (error "Cannot outdent top-level items")) + ;; Parent is outdented: keep association + ((>= parent start) + (setq acc (cons (cons parent item) acc)) cell) + (t + ;; Parent isn't outdented: reparent to grand-parent + (let ((grand-parent (cdr (assq parent origins)))) + (setq acc (cons (cons parent item) acc)) + (cons item grand-parent)))))))) + (mapcar out origins))) + +(defun org-list-struct-indent (start end origins struct) + "Indent items in a structure. +Items are indented when their key is between START, included, and +END, excluded. + +ORIGINS is the alist of parents. See `org-list-struct-origins'. + +STRUCT is the concerned structure. It may be modified if +`org-list-demote-modify-bullet' matches bullets between START and +END." + (let* (acc + (orig-rev (reverse origins)) + (get-prev-item + (lambda (cell parent) + (car (rassq parent (cdr (memq cell orig-rev)))))) + (set-assoc + (lambda (cell) + (setq acc (cons cell acc)) cell)) + (change-bullet-maybe + (lambda (item) + (let* ((full-item (assq item struct)) + (item-bul (org-trim (nth 2 full-item))) + (new-bul-p (cdr (assoc item-bul org-list-demote-modify-bullet)))) + (when new-bul-p + ;; new bullet is stored without space to ensure item + ;; will be modified + (setcdr full-item + (list (nth 1 full-item) + new-bul-p + (nth 3 full-item))))))) + (ind + (lambda (cell) + (let* ((item (car cell)) + (parent (cdr cell))) + (cond + ;; Item not yet in zone: keep association + ((< item start) cell) + ((>= item end) + ;; Item out of zone: follow associations in acc + (let ((convert (assq parent acc))) + (if convert (cons item (cdr convert)) cell))) + (t + ;; Item is in zone... + (let ((prev (funcall get-prev-item cell parent))) + ;; Check if bullet needs to be changed + (funcall change-bullet-maybe item) + (cond + ;; First item indented but not parent: error + ((and (or (not prev) (= prev 0)) (< parent start)) + (error "Cannot indent the first item of a list")) + ;; First item and parent indented: keep same parent + ((or (not prev) (= prev 0)) + (funcall set-assoc cell)) + ;; Previous item not indented: reparent to it + ((< prev start) + (funcall set-assoc (cons item prev))) + ;; Previous item indented: reparent like it + (t + (funcall set-assoc (cons item + (cdr (assq prev acc))))))))))))) + (mapcar ind origins))) + +(defun org-list-struct-apply-struct (struct bottom) + "Apply modifications to list so it mirrors STRUCT. +BOTTOM is position at list ending. + +Initial position is restored after the changes." + (let* ((pos (copy-marker (point))) + (ancestor (caar struct)) + (modify + (lambda (item) + (goto-char (car item)) + (let* ((new-ind (nth 1 item)) + (new-bul (org-list-bullet-string (nth 2 item))) + (old-ind (org-get-indentation)) + (old-bul (progn + (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") + (match-string 1))) + (old-body-ind (+ (length old-bul) old-ind)) + (new-body-ind (+ (length new-bul) new-ind))) + ;; 1. Shift item's body + (unless (= old-body-ind new-body-ind) + (org-shift-item-indentation + (- new-body-ind old-body-ind) bottom)) + ;; 2. Replace bullet + (unless (equal new-bul old-bul) + (save-excursion + (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") + (replace-match new-bul nil nil nil 1))) + ;; 3. Indent item to appropriate column + (unless (= new-ind old-ind) + (delete-region (point-at-bol) + (progn + (skip-chars-forward " \t") + (point))) + (indent-to new-ind))))) + ;; Remove ancestor if it is left. + (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) + (cdr struct) + struct))) + ;; Apply changes from bottom to top + (mapc modify (nreverse struct-to-apply)) + (goto-char pos))) + +;;; Indentation (defun org-get-string-indentation (s) "What indentation has S due to SPACE and TAB at the beginning of the string?" @@ -798,280 +1473,556 @@ If WHICH is a string, use that as the new bullet. If WHICH is an integer, (t (throw 'exit t))))) i)) -(defun org-renumber-ordered-list (arg) - "Renumber an ordered plain list. -Cursor needs to be in the first line of an item, the line that starts -with something like \"1.\" or \"2)\"." - (interactive "p") - (unless (and (org-at-item-p) - (match-beginning 3)) - (error "This is not an ordered list")) - (let ((line (org-current-line)) - (col (current-column)) - (ind (org-get-string-indentation - (buffer-substring (point-at-bol) (match-beginning 3)))) - ;; (term (substring (match-string 3) -1)) - ind1 (n (1- arg)) - fmt bobp old new delta) - ;; find where this list begins - (org-beginning-of-item-list) - (setq bobp (bobp)) - (looking-at "[ \t]*[0-9]+\\([.)]\\)") - (setq fmt (concat "%d" (or (match-string 1) "."))) - (beginning-of-line 0) - ;; walk forward and replace these numbers - (catch 'exit - (while t - (catch 'next - (if bobp (setq bobp nil) (beginning-of-line 2)) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (setq old (match-string 2)) - (delete-region (match-beginning 2) (match-end 2)) - (goto-char (match-beginning 2)) - (insert (setq new (format fmt (setq n (1+ n))))) - (setq delta (- (length new) (length old))) - (org-shift-item-indentation delta) - (if (= (org-current-line) line) (setq col (+ col delta)))))) - (org-goto-line line) - (org-move-to-column col))) - -(defvar org-suppress-item-indentation) ; dynamically scoped parameter -(defun org-fix-bullet-type (&optional force-bullet) - "Make sure all items in this list have the same bullet as the first item. -Also, fix the indentation." +(defun org-shift-item-indentation (delta bottom) + "Shift the indentation in current item by DELTA. +Sub-items are not moved. + +BOTTOM is position at list ending." + (save-excursion + (let ((beg (point-at-bol)) + (end (org-end-of-item-or-at-child bottom))) + (beginning-of-line (unless (eolp) 0)) + (while (> (point) beg) + (when (looking-at "[ \t]*\\S-") + ;; this is not an empty line + (let ((i (org-get-indentation))) + (when (and (> i 0) (> (+ i delta) 0)) + (org-indent-line-to (+ i delta))))) + (beginning-of-line 0))))) + +(defun org-outdent-item () + "Outdent a local list item, but not its children. +If a region is active, all items inside will be moved." (interactive) - (unless (org-at-item-p) (error "This is not a list")) - (let ((line (org-current-line)) - (col (current-column)) - (ind (current-indentation)) - ind1 bullet oldbullet) - ;; find where this list begins - (org-beginning-of-item-list) - (beginning-of-line 1) - ;; find out what the bullet type is - (looking-at "[ \t]*\\(\\S-+\\)") - (setq bullet (concat (or force-bullet (match-string 1)) " ")) - (if (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp bullet)) - (setq bullet (concat bullet " "))) - ;; walk forward and replace these numbers - (beginning-of-line 0) - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (skip-chars-forward " \t") - (looking-at "\\S-+ *") - (setq oldbullet (match-string 0)) - (unless (equal bullet oldbullet) (replace-match bullet)) - (org-shift-item-indentation (- (length bullet) - (length oldbullet)))))) - (org-goto-line line) - (org-move-to-column col) - (if (string-match "[0-9]" bullet) - (org-renumber-ordered-list 1)))) - -(defun org-shift-item-indentation (delta) - "Shift the indentation in current item by DELTA." - (unless (org-bound-and-true-p org-suppress-item-indentation) - (save-excursion - (let ((beg (point-at-bol)) - (end (progn (org-end-of-item) (point))) - i) - (goto-char end) - (beginning-of-line 0) - (while (> (point) beg) - (when (looking-at "[ \t]*\\S-") - ;; this is not an empty line - (setq i (org-get-indentation)) - (if (and (> i 0) (> (setq i (+ i delta)) 0)) - (indent-line-to i))) - (beginning-of-line 0)))))) + (org-list-indent-item-generic + -1 t (org-list-top-point) (org-list-bottom-point))) -(defun org-beginning-of-item-list () - "Go to the beginning of the current item list. -I.e. to the first item in this list." +(defun org-indent-item () + "Indent a local list item, but not its children. +If a region is active, all items inside will be moved." (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (throw (if (bobp) 'exit 'next) t)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (and (= (point-at-bol) (point-min)) - (setq pos (point-min)))) - (throw 'exit t) - (when (org-at-item-p) (setq pos (point-at-bol))))))) - (goto-char pos))) + (org-list-indent-item-generic + 1 t (org-list-top-point) (org-list-bottom-point))) -(defun org-end-of-item-list () - "Go to the end of the current item list. -I.e. to the text after the last item." +(defun org-outdent-item-tree () + "Outdent a local list item including its children. +If a region is active, all items inside will be moved." (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) + (org-list-indent-item-generic + -1 nil (org-list-top-point) (org-list-bottom-point))) + +(defun org-indent-item-tree () + "Indent a local list item including its children. +If a region is active, all items inside will be moved." + (interactive) + (org-list-indent-item-generic + 1 nil (org-list-top-point) (org-list-bottom-point))) + +(defvar org-tab-ind-state) +(defun org-cycle-item-indentation () + "Cycle levels of indentation of an empty item. +The first run indent the item, if applicable. Subsequents runs +outdent it at meaningful levels in the list. When done, item is +put back at its original position with its original bullet. + +Return t at each successful move." + (let ((org-adapt-indentation nil) (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (looking-at "[ \t]*$") - (if (eobp) - (progn (setq pos (point)) (throw 'exit t)) - (throw 'next t))) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (eobp)) - (progn - (setq pos (point-at-bol)) - (throw 'exit t)))))) - (goto-char pos))) + (bottom (and (org-at-item-p) (org-list-bottom-point)))) + (when (and (or (org-at-item-description-p) + (org-at-item-checkbox-p) + (org-at-item-p)) + ;; Check that item is really empty + (>= (match-end 0) (save-excursion + (org-end-of-item-or-at-child bottom) + (skip-chars-backward " \r\t\n") + (point)))) + (setq this-command 'org-cycle-item-indentation) + (let ((top (org-list-top-point))) + ;; When in the middle of the cycle, try to outdent first. If it + ;; fails, and point is still at initial position, indent. Else, + ;; go back to original position. + (if (eq last-command 'org-cycle-item-indentation) + (cond + ((ignore-errors (org-list-indent-item-generic -1 t top bottom))) + ((and (= (org-get-indentation) (car org-tab-ind-state)) + (ignore-errors + (org-list-indent-item-generic 1 t top bottom)))) + (t (back-to-indentation) + (org-indent-to-column (car org-tab-ind-state)) + (end-of-line) + (org-list-repair (cdr org-tab-ind-state)) + ;; Break cycle + (setq this-command 'identity))) + ;; If a cycle is starting, remember indentation and bullet, + ;; then try to indent. If it fails, try to outdent. + (setq org-tab-ind-state (cons ind (org-get-bullet))) + (cond + ((ignore-errors (org-list-indent-item-generic 1 t top bottom))) + ((ignore-errors (org-list-indent-item-generic -1 t top bottom))) + (t (error "Cannot move item"))))) + t))) +;;; Bullets -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) +(defun org-get-bullet () + "Return the bullet of the item at point. +Assume cursor is at an item." + (save-excursion + (beginning-of-line) + (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1)))) + +(defun org-list-bullet-string (bullet) + "Return BULLET with the correct number of whitespaces. +It determines the number of whitespaces to append by looking at +`org-list-two-spaces-after-bullet-regexp'." + (save-match-data + (string-match "\\S-+\\([ \t]*\\)" bullet) + (replace-match + (save-match-data + (concat + " " + ;; Do we need to concat another white space ? + (when (and org-list-two-spaces-after-bullet-regexp + (string-match org-list-two-spaces-after-bullet-regexp bullet)) + " "))) + nil nil bullet 1))) + +(defun org-list-inc-bullet-maybe (bullet) + "Increment BULLET if applicable." + (if (string-match "[0-9]+" bullet) + (replace-match + (number-to-string (1+ (string-to-number (match-string 0 bullet)))) + nil nil bullet) + bullet)) + +(defun org-list-repair (&optional force-bullet top bottom) + "Make sure all items are correctly indented, with the right bullet. +This function scans the list at point, along with any sublist. + +If FORCE-BULLET is a string, ensure all items in list share this +bullet, or a logical successor in the case of an ordered list. + +When non-nil, TOP and BOTTOM specify respectively position of +list beginning and list ending. + +Item's body is not indented, only shifted with the bullet." + (interactive) + (unless (org-at-item-p) (error "This is not a list")) + (let* ((bottom (or bottom (org-list-bottom-point))) + (struct (org-list-struct + (point-at-bol) (point-at-eol) + (or top (org-list-top-point)) bottom)) + (origins (org-list-struct-origins struct)) + fixed-struct) + (if (stringp force-bullet) + (let ((begin (nth 1 struct))) + (setcdr begin (list (nth 1 begin) + (org-list-bullet-string force-bullet) + (nth 3 begin))) + (setq fixed-struct + (cons begin (org-list-struct-fix-struct struct origins)))) + (setq fixed-struct (org-list-struct-fix-struct struct origins))) + (org-list-struct-apply-struct fixed-struct bottom))) + +(defun org-cycle-list-bullet (&optional which) + "Cycle through the different itemize/enumerate bullets. +This cycle the entire list level through the sequence: -(defun org-outdent-item (arg) - "Outdent a local list item." - (interactive "p") - (org-indent-item (- arg))) - -(defun org-indent-item (arg) - "Indent a local list item." - (interactive "p") - (and (org-region-active-p) (org-cursor-to-region-beginning)) - (unless (org-at-item-p) - (error "Not on an item")) - (let (beg end ind ind1 ind-bul delta ind-down ind-up firstp) - (setq firstp (org-first-list-item-p)) + `-' -> `+' -> `*' -> `1.' -> `1)' + +If WHICH is a valid string, use that as the new bullet. If WHICH +is an integer, 0 means `-', 1 means `+' etc. If WHICH is +'previous, cycle backwards." + (interactive "P") + (save-excursion + (let* ((top (org-list-top-point)) + (bullet (progn + (goto-char (org-get-beginning-of-list top)) + (org-get-bullet))) + (current (cond + ((string-match "\\." bullet) "1.") + ((string-match ")" bullet) "1)") + (t bullet))) + (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) + (bullet-list (append '("-" "+" ) + ;; *-bullets are not allowed at column 0 + (unless (and bullet-rule-p + (looking-at "\\S-")) '("*")) + ;; Description items cannot be numbered + (unless (and bullet-rule-p + (or (eq org-plain-list-ordered-item-terminator ?\)) + (org-at-item-description-p))) '("1.")) + (unless (and bullet-rule-p + (or (eq org-plain-list-ordered-item-terminator ?.) + (org-at-item-description-p))) '("1)")))) + (len (length bullet-list)) + (item-index (- len (length (member current bullet-list)))) + (get-value (lambda (index) (nth (mod index len) bullet-list))) + (new (cond + ((member which bullet-list) which) + ((numberp which) (funcall get-value which)) + ((eq 'previous which) (funcall get-value (1- item-index))) + (t (funcall get-value (1+ item-index)))))) + (org-list-repair new top)))) + +;;; Checkboxes + +(defun org-toggle-checkbox (&optional toggle-presence) + "Toggle the checkbox in the current line. +With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With +double prefix, set checkbox to [-]. + +When there is an active region, toggle status or presence of the +first checkbox there, and make every item inside have the +same status or presence, respectively. + +If the cursor is in a headline, apply this to all checkbox items +in the text below the heading, taking as reference the first item +in subtree, ignoring drawers." + (interactive "P") + ;; Bounds is a list of type (beg end single-p) where single-p is t + ;; when `org-toggle-checkbox' is applied to a single item. Only + ;; toggles on single items will return errors. + (let* ((bounds + (cond + ((org-region-active-p) + (let ((rbeg (region-beginning)) + (rend (region-end))) + (save-excursion + (goto-char rbeg) + (if (org-search-forward-unenclosed org-item-beginning-re rend 'move) + (list (point-at-bol) rend nil) + (error "No item in region"))))) + ((org-on-heading-p) + ;; In this case, reference line is the first item in + ;; subtree outside drawers + (let ((pos (point)) + (limit (save-excursion (outline-next-heading) (point)))) + (save-excursion + (goto-char limit) + (org-search-backward-unenclosed ":END:" pos 'move) + (org-search-forward-unenclosed + org-item-beginning-re limit 'move) + (list (point) limit nil)))) + ((org-at-item-p) + (list (point-at-bol) (1+ (point-at-eol)) t)) + (t (error "Not at an item or heading, and no active region")))) + (beg (car bounds)) + ;; marker is needed because deleting or inserting checkboxes + ;; will change bottom point + (end (copy-marker (nth 1 bounds))) + (single-p (nth 2 bounds)) + (ref-presence (save-excursion + (goto-char beg) + (org-at-item-checkbox-p))) + (ref-status (equal (match-string 1) "[X]")) + (act-on-item + (lambda (ref-pres ref-stat) + (if (equal toggle-presence '(4)) + (cond + ((and ref-pres (org-at-item-checkbox-p)) + (replace-match "")) + ((and (not ref-pres) + (not (org-at-item-checkbox-p)) + (org-at-item-p)) + (goto-char (match-end 0)) + ;; Ignore counter, if any + (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") + (goto-char (match-end 0))) + (let ((desc-p (and (org-at-item-description-p) + (cdr (assq 'checkbox org-list-automatic-rules))))) + (cond + ((and single-p desc-p) + (error "Cannot add a checkbox in a description list")) + ((not desc-p) (insert "[ ] ")))))) + (let ((blocked (org-checkbox-blocked-p))) + (cond + ((and blocked single-p) + (error "Checkbox blocked because of unchecked box in line %d" blocked)) + (blocked nil) + ((org-at-item-checkbox-p) + (replace-match + (cond ((equal toggle-presence '(16)) "[-]") + (ref-stat "[ ]") + (t "[X]")) + t t nil 1)))))))) (save-excursion - (setq end (and (org-region-active-p) (region-end))) - (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (setq beg org-last-indent-begin-marker - end org-last-indent-end-marker) - (org-beginning-of-item) - (setq beg (move-marker org-last-indent-begin-marker (point))) - (org-end-of-item) - (setq end (move-marker org-last-indent-end-marker (or end (point))))) (goto-char beg) - (setq ind-bul (org-item-indent-positions) - ind (caar ind-bul) - ind-down (car (nth 2 ind-bul)) - ind-up (car (nth 1 ind-bul)) - delta (if (> arg 0) - (if ind-down (- ind-down ind) 2) - (if ind-up (- ind-up ind) -2))) - (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin")) (while (< (point) end) - (beginning-of-line 1) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (delete-region (point-at-bol) (point)) - (or (eolp) (org-indent-to-column (+ ind1 delta))) - (beginning-of-line 2))) - (org-fix-bullet-type - (and (> arg 0) - (not firstp) - (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet)))) - (org-maybe-renumber-ordered-list-safe) - (save-excursion - (beginning-of-line 0) - (condition-case nil (org-beginning-of-item) (error nil)) - (org-maybe-renumber-ordered-list-safe)))) - -(defun org-item-indent-positions () - "Return indentation for plain list items. -This returns a list with three values: The current indentation, the -parent indentation and the indentation a child should have. -Assumes cursor in item line." - (let* ((bolpos (point-at-bol)) - (ind (org-get-indentation)) - (bullet (org-get-bullet)) - ind-down ind-up bullet-up bullet-down pos) - (save-excursion - (org-beginning-of-item-list) - (skip-chars-backward "\n\r \t") - (when (org-in-item-p) - (org-beginning-of-item) - (setq ind-up (org-get-indentation)) - (setq bullet-up (org-get-bullet)))) - (setq pos (point)) + (funcall act-on-item ref-presence ref-status) + (org-search-forward-unenclosed org-item-beginning-re end 'move))) + (org-update-checkbox-count-maybe))) + +(defun org-reset-checkbox-state-subtree () + "Reset all checkboxes in an entry subtree." + (interactive "*") + (save-restriction (save-excursion - (cond - ((and (condition-case nil (progn (org-previous-item) t) - (error nil)) - (or (forward-char 1) t) - (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t)) - (setq ind-down (org-get-indentation) - bullet-down (org-get-bullet))) - ((and (goto-char pos) - (org-at-item-p)) - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (setq ind-down (current-column) - bullet-down (org-get-bullet))))) - (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down)) - (setq bullet-down (concat "1" (match-string 1 bullet-down)))) - (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up)) - (setq bullet-up (concat "1" (match-string 1 bullet-up)))) - (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet)) - (setq bullet (concat "1" (match-string 1 bullet)))) - (list (cons ind bullet) - (cons ind-up bullet-up) - (cons ind-down bullet-down)))) - -(defvar org-tab-ind-state) ; defined in org.el -(defun org-cycle-item-indentation () - (let ((org-suppress-item-indentation t) - (org-adapt-indentation nil)) - (cond - ((and (looking-at "[ \t]*$") - (looking-back "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[).]\\)[ \t]+")) - (setq this-command 'org-cycle-item-indentation) - (if (eq last-command 'org-cycle-item-indentation) - (condition-case nil - (progn (org-outdent-item 1) - (if (equal org-tab-ind-state (org-get-indentation)) - (org-outdent-item 1)) - (end-of-line 1)) - (error - (progn - (while (< (org-get-indentation) org-tab-ind-state) - (progn (org-indent-item 1) (end-of-line 1))) - (setq this-command 'org-cycle)))) - (setq org-tab-ind-state (org-get-indentation)) - (org-indent-item 1)) - t)))) + (org-narrow-to-subtree) + (org-show-subtree) + (goto-char (point-min)) + (let ((end (point-max))) + (while (< (point) end) + (when (org-at-item-checkbox-p) + (replace-match "[ ]" t t nil 1)) + (beginning-of-line 2)))) + (org-update-checkbox-count-maybe))) -(defun org-get-bullet () +(defvar org-checkbox-statistics-hook nil + "Hook that is run whenever Org thinks checkbox statistics should be updated. +This hook runs even if checkbox rule in +`org-list-automatic-rules' does not apply, so it can be used to +implement alternative ways of collecting statistics +information.") + +(defun org-update-checkbox-count-maybe () + "Update checkbox statistics unless turned off by user." + (when (cdr (assq 'checkbox org-list-automatic-rules)) + (org-update-checkbox-count)) + (run-hooks 'org-checkbox-statistics-hook)) + +(defun org-update-checkbox-count (&optional all) + "Update the checkbox statistics in the current section. +This will find all statistic cookies like [57%] and [6/12] and update them +with the current numbers. With optional prefix argument ALL, do this for +the whole buffer." + (interactive "P") (save-excursion - (goto-char (point-at-bol)) - (and (looking-at - "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)") - (or (match-string 2) (match-string 4))))) + (let ((cstat 0)) + (catch 'exit + (while t + (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 + (beg (condition-case nil + (progn (org-back-to-heading) (point)) + (error (point-min)))) + (end (copy-marker (save-excursion + (outline-next-heading) (point)))) + (re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)") + beg-cookie end-cookie is-percent c-on c-off lim new + curr-ind next-ind continue-from startsearch list-beg list-end + (recursive + (or (not org-hierarchical-checkbox-statistics) + (string-match "\\<recursive\\>" + (or (ignore-errors + (org-entry-get nil "COOKIE_DATA")) + ""))))) + (goto-char end) + ;; find each statistics cookie + (while (and (org-search-backward-unenclosed re-cookie beg 'move) + (not (save-match-data + (and (org-on-heading-p) + (string-match "\\<todo\\>" + (downcase + (or (org-entry-get + nil "COOKIE_DATA") + ""))))))) + (setq beg-cookie (match-beginning 1) + end-cookie (match-end 1) + cstat (+ cstat (if end-cookie 1 0)) + startsearch (point-at-eol) + continue-from (match-beginning 0) + is-percent (match-beginning 2) + lim (cond + ((org-on-heading-p) (outline-next-heading) (point)) + ;; Ensure many cookies in the same list won't imply + ;; computing list boundaries as many times. + ((org-at-item-p) + (unless (and list-beg (>= (point) list-beg)) + (setq list-beg (org-list-top-point) + list-end (copy-marker + (org-list-bottom-point)))) + (org-get-end-of-item list-end)) + (t nil)) + c-on 0 + c-off 0) + (when lim + ;; find first checkbox for this cookie and gather + ;; statistics from all that are at this indentation level + (goto-char startsearch) + (if (org-search-forward-unenclosed re-box lim t) + (progn + (beginning-of-line) + (setq curr-ind (org-get-indentation)) + (setq next-ind curr-ind) + (while (and (bolp) (org-at-item-p) + (if recursive + (<= curr-ind next-ind) + (= curr-ind next-ind))) + (when (org-at-item-checkbox-p) + (if (member (match-string 1) '("[ ]" "[-]")) + (setq c-off (1+ c-off)) + (setq c-on (1+ c-on)))) + (if (not recursive) + ;; org-get-next-item goes through list-enders + ;; with proper limit. + (goto-char (or (org-get-next-item (point) lim) lim)) + (end-of-line) + (when (org-search-forward-unenclosed + org-item-beginning-re lim t) + (beginning-of-line))) + (setq next-ind (org-get-indentation))))) + (goto-char continue-from) + ;; update cookie + (when end-cookie + (setq new (if is-percent + (format "[%d%%]" (/ (* 100 c-on) + (max 1 (+ c-on c-off)))) + (format "[%d/%d]" c-on (+ c-on c-off)))) + (goto-char beg-cookie) + (insert new) + (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) + ;; update items checkbox if it has one + (when (and (org-at-item-checkbox-p) + (> (+ c-on c-off) 0)) + (setq beg-cookie (match-beginning 1) + end-cookie (match-end 1)) + (delete-region beg-cookie end-cookie) + (goto-char beg-cookie) + (cond ((= c-off 0) (insert "[X]")) + ((= c-on 0) (insert "[ ]")) + (t (insert "[-]"))))) + (goto-char continue-from))) + (unless (and all (outline-next-heading)) (throw 'exit nil)))) + (when (interactive-p) + (message "Checkbox statistics updated %s (%d places)" + (if all "in entire file" "in current outline entry") cstat))))) + +(defun org-get-checkbox-statistics-face () + "Select the face for checkbox statistics. +The face will be `org-done' when all relevant boxes are checked. +Otherwise it will be `org-todo'." + (if (match-end 1) + (if (equal (match-string 1) "100%") + 'org-checkbox-statistics-done + 'org-checkbox-statistics-todo) + (if (and (> (match-end 2) (match-beginning 2)) + (equal (match-string 2) (match-string 3))) + 'org-checkbox-statistics-done + 'org-checkbox-statistics-todo))) + +;;; Misc Tools + +(defun org-apply-on-list (function init-value &rest args) + "Call FUNCTION on each item of the list at point. +FUNCTION must be called with at least one argument: INIT-VALUE, +that will contain the value returned by the function at the +previous item, plus ARGS extra arguments. + +As an example, (org-apply-on-list (lambda (result) (1+ result)) 0) +will return the number of items in the current list. + +Sublists of the list are skipped. Cursor is always at the +beginning of the item." + (let* ((pos (copy-marker (point))) + (end (copy-marker (org-list-bottom-point))) + (next-p (copy-marker (org-get-beginning-of-list (org-list-top-point)))) + (value init-value)) + (while (< next-p end) + (goto-char next-p) + (set-marker next-p (or (org-get-next-item (point) end) end)) + (setq value (apply function value args))) + (goto-char pos) + value)) + +(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) + "Sort plain list items. +The cursor may be at any item of the list that should be sorted. +Sublists are not sorted. Checkboxes, if any, are ignored. + +Sorting can be alphabetically, numerically, by date/time as given by +a time stamp, by a property or by priority. + +Comparing entries ignores case by default. However, with an +optional argument WITH-CASE, the sorting considers case as well. + +The command prompts for the sorting type unless it has been given +to the function through the SORTING-TYPE argument, which needs to +be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise +meaning of each character: + +n Numerically, by converting the beginning of the item to a number. +a Alphabetically. Only the first line of item is checked. +t By date/time, either the first active time stamp in the entry, if + any, or by the first inactive one. In a timer list, sort the timers. + +Capital letters will reverse the sort order. + +If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a +function to be called with point at the beginning of the record. +It must return either a string or a number that should serve as +the sorting key for that record. It will then use COMPARE-FUNC to +compare entries." + (interactive "P") + (let* ((case-func (if with-case 'identity 'downcase)) + (top (org-list-top-point)) + (bottom (org-list-bottom-point)) + (start (org-get-beginning-of-list top)) + (end (org-get-end-of-list bottom)) + (sorting-type + (progn + (message + "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") + (read-char-exclusive))) + (getkey-func (and (= (downcase sorting-type) ?f) + (org-icompleting-read "Sort using function: " + obarray 'fboundp t nil nil) + (intern getkey-func)))) + (message "Sorting items...") + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (let* ((dcst (downcase sorting-type)) + (case-fold-search nil) + (now (current-time)) + (sort-func (cond + ((= dcst ?a) 'string<) + ((= dcst ?f) compare-func) + ((= dcst ?t) '<) + (t nil))) + (begin-record (lambda () + (skip-chars-forward " \r\t\n") + (beginning-of-line))) + (end-record (lambda () + (goto-char (org-end-of-item-before-blank end)))) + (value-to-sort + (lambda () + (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") + (cond + ((= dcst ?n) + (string-to-number (buffer-substring (match-end 0) + (point-at-eol)))) + ((= dcst ?a) + (buffer-substring (match-end 0) (point-at-eol))) + ((= dcst ?t) + (cond + ;; If it is a timer list, convert timer to seconds + ((org-at-item-timer-p) + (org-timer-hms-to-secs (match-string 1))) + ((or (org-search-forward-unenclosed org-ts-regexp + (point-at-eol) t) + (org-search-forward-unenclosed org-ts-regexp-both + (point-at-eol) t)) + (org-time-string-to-seconds (match-string 0))) + (t (org-float-time now)))) + ((= dcst ?f) + (if getkey-func + (let ((value (funcall getkey-func))) + (if (stringp value) + (funcall case-func value) + value)) + (error "Invalid key function `%s'" getkey-func))) + (t (error "Invalid sorting type `%c'" sorting-type))))))) + (sort-subr (/= dcst sorting-type) + begin-record + end-record + value-to-sort + nil + sort-func) + (org-list-repair nil top bottom) + (run-hooks 'org-after-sorting-entries-or-items-hook) + (message "Sorting items...done"))))) ;;; Send and receive lists @@ -1079,82 +2030,55 @@ Assumes cursor in item line." "Parse the list at point and maybe DELETE it. Return a list containing first level items as strings and sublevels as a list of strings." - (let* ((item-beginning (org-list-item-beginning)) - (start (car item-beginning)) - (end (org-list-end (cdr item-beginning))) + (let* ((start (goto-char (org-list-top-point))) + (end (org-list-bottom-point)) output itemsep ltype) - (while (re-search-forward org-list-beginning-re end t) - (goto-char (match-beginning 3)) - (save-match-data - (cond ((string-match "[0-9]" (match-string 2)) - (setq itemsep "[0-9]+\\(?:\\.\\|)\\)" - ltype 'ordered)) - ((string-match "^.*::" (match-string 0)) - (setq itemsep "[-+]" ltype 'descriptive)) - (t (setq itemsep "[-+]" ltype 'unordered)))) - (let* ((indent1 (match-string 1)) - (nextitem (save-excursion - (save-match-data - (or (and (re-search-forward - (concat "^" indent1 itemsep " *?") end t) - (match-beginning 0)) end)))) - (item (buffer-substring - (point) - (or (and (re-search-forward - org-list-beginning-re end t) - (goto-char (match-beginning 0))) - (goto-char end)))) - (nextindent (match-string 1)) - (item (org-trim item)) - (item (if (string-match "^\\[\\([xX ]\\)\\]" item) + (while (org-search-forward-unenclosed org-item-beginning-re end t) + (save-excursion + (beginning-of-line) + (setq ltype (cond ((org-looking-at-p "^[ \t]*[0-9]") 'ordered) + ((org-at-item-description-p) 'descriptive) + (t 'unordered)))) + (let* ((indent1 (org-get-indentation)) + (nextitem (or (org-get-next-item (point) end) end)) + (item (org-trim (buffer-substring (point) + (org-end-of-item-or-at-child end)))) + (nextindent (if (= (point) end) 0 (org-get-indentation))) + (item (if (string-match + "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" + item) (replace-match (if (equal (match-string 1 item) " ") - "[CBOFF]" - "[CBON]") - t nil item) + "CBOFF" + "CBON") + t nil item 1) item))) (push item output) - (when (> (length nextindent) - (length indent1)) - (narrow-to-region (point) nextitem) - (push (org-list-parse-list) output) - (widen)))) - (when delete (delete-region start end)) + (when (> nextindent indent1) + (save-restriction + (narrow-to-region (point) nextitem) + (push (org-list-parse-list) output))))) + (when delete + (delete-region start end) + (save-match-data + (when (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) + (replace-match "\n")))) (setq output (nreverse output)) (push ltype output))) -(defun org-list-item-beginning () - "Find the beginning of the list item. -Return a cons which car is the beginning position of the item and -cdr is the indentation string." - (save-excursion - (if (not (or (looking-at org-list-beginning-re) - (re-search-backward - org-list-beginning-re nil t))) - (progn (goto-char (point-min)) (point)) - (cons (match-beginning 0) (match-string 1))))) - -(defun org-list-goto-true-beginning () - "Go to the beginning of the list at point." - (beginning-of-line 1) - (while (looking-at org-list-beginning-re) - (beginning-of-line 0)) - (progn - (re-search-forward org-list-beginning-re nil t) - (goto-char (match-beginning 0)))) - (defun org-list-make-subtree () "Convert the plain list at point into a subtree." (interactive) - (org-list-goto-true-beginning) - (let ((list (org-list-parse-list t)) nstars) - (save-excursion - (if (condition-case nil - (org-back-to-heading) - (error nil)) - (progn (re-search-forward org-complex-heading-regexp nil t) - (setq nstars (length (match-string 1)))) - (setq nstars 0))) - (org-list-make-subtrees list (1+ nstars)))) + (if (not (org-in-item-p)) + (error "Not in a list") + (let ((list (org-list-parse-list t)) nstars) + (save-excursion + (if (ignore-errors + (org-back-to-heading)) + (progn (looking-at org-complex-heading-regexp) + (setq nstars (length (match-string 1)))) + (setq nstars 0))) + (org-list-make-subtrees list (1+ nstars))))) (defun org-list-make-subtrees (list level) "Convert LIST into subtrees starting at LEVEL." @@ -1168,20 +2092,6 @@ cdr is the indentation string." (org-list-make-subtrees item (1+ level)))) list))) -(defun org-list-end (indent) - "Return the position of the end of the list. -INDENT is the indentation of the list, as a string." - (save-excursion - (catch 'exit - (while (or (looking-at org-list-beginning-re) - (looking-at (concat "^" indent "[ \t]+\\|^$")) - (> (or (get-text-property (point) 'original-indentation) -1) - (length indent))) - (if (eq (point) (point-max)) - (throw 'exit (point-max))) - (forward-line 1))) - (point))) - (defun org-list-insert-radio-list () "Insert a radio list template appropriate for this major mode." (interactive) @@ -1203,45 +2113,52 @@ With argument MAYBE, fail quietly if no transformation is defined for this list." (interactive) (catch 'exit - (unless (org-at-item-p) (error "Not at a list")) + (unless (org-at-item-p) (error "Not at a list item")) (save-excursion - (org-list-goto-true-beginning) - (beginning-of-line 0) - (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") + (re-search-backward "#\\+ORGLST" nil t) + (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") (if maybe (throw 'exit nil) (error "Don't know how to transform this list")))) (let* ((name (match-string 1)) (transform (intern (match-string 2))) - (item-beginning (org-list-item-beginning)) - (txt (buffer-substring-no-properties - (car item-beginning) - (org-list-end (cdr item-beginning)))) - (list (org-list-parse-list)) - beg) + (bottom-point + (save-excursion + (re-search-forward + "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t) + (match-beginning 0))) + (top-point + (progn + (re-search-backward "#\\+ORGLST" nil t) + (re-search-forward org-item-beginning-re bottom-point t) + (match-beginning 0))) + (list (save-restriction + (narrow-to-region top-point bottom-point) + (org-list-parse-list))) + beg txt) (unless (fboundp transform) (error "No such transformation function %s" transform)) - (setq txt (funcall transform list)) - ;; Find the insertion place - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t) - (error "Don't know where to insert translated list")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (setq beg (point)) - (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) - (error "Cannot find end of insertion region")) - (beginning-of-line 1) - (delete-region beg (point)) - (goto-char beg) - (insert txt "\n")) + (let ((txt (funcall transform list))) + ;; Find the insertion place + (save-excursion + (goto-char (point-min)) + (unless (re-search-forward + (concat "BEGIN RECEIVE ORGLST +" + name + "\\([ \t]\\|$\\)") nil t) + (error "Don't know where to insert translated list")) + (goto-char (match-beginning 0)) + (beginning-of-line 2) + (setq beg (point)) + (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) + (error "Cannot find end of insertion region")) + (delete-region beg (point-at-bol)) + (goto-char beg) + (insert txt "\n"))) (message "List converted and installed at receiver location")))) (defun org-list-to-generic (list params) "Convert a LIST parsed through `org-list-parse-list' to other formats. - Valid parameters PARAMS are :ustart String to start an unordered list @@ -1270,21 +2187,21 @@ Valid parameters PARAMS are (interactive) (let* ((p params) sublist (splicep (plist-get p :splice)) - (ostart (plist-get p :ostart)) - (oend (plist-get p :oend)) - (ustart (plist-get p :ustart)) - (uend (plist-get p :uend)) - (dstart (plist-get p :dstart)) - (dend (plist-get p :dend)) - (dtstart (plist-get p :dtstart)) - (dtend (plist-get p :dtend)) - (ddstart (plist-get p :ddstart)) - (ddend (plist-get p :ddend)) - (istart (plist-get p :istart)) - (iend (plist-get p :iend)) - (isep (plist-get p :isep)) - (lsep (plist-get p :lsep)) - (cbon (plist-get p :cbon)) + (ostart (plist-get p :ostart)) + (oend (plist-get p :oend)) + (ustart (plist-get p :ustart)) + (uend (plist-get p :uend)) + (dstart (plist-get p :dstart)) + (dend (plist-get p :dend)) + (dtstart (plist-get p :dtstart)) + (dtend (plist-get p :dtend)) + (ddstart (plist-get p :ddstart)) + (ddend (plist-get p :ddend)) + (istart (plist-get p :istart)) + (iend (plist-get p :iend)) + (isep (plist-get p :isep)) + (lsep (plist-get p :lsep)) + (cbon (plist-get p :cbon)) (cboff (plist-get p :cboff))) (let ((wrapper (cond ((eq (car list) 'ordered) @@ -1297,28 +2214,30 @@ Valid parameters PARAMS are (while (setq sublist (pop list)) (cond ((symbolp sublist) nil) ((stringp sublist) - (when (string-match "^\\(.*\\) ::" sublist) + (when (string-match "^\\(.*\\)[ \t]+::" sublist) (setq term (org-trim (format (concat dtstart "%s" dtend) (match-string 1 sublist)))) - (setq sublist (substring sublist (1+ (length term))))) + (setq sublist (concat ddstart + (org-trim (substring sublist + (match-end 0))) + ddend))) (if (string-match "\\[CBON\\]" sublist) (setq sublist (replace-match cbon t t sublist))) (if (string-match "\\[CBOFF\\]" sublist) (setq sublist (replace-match cboff t t sublist))) (if (string-match "\\[-\\]" sublist) (setq sublist (replace-match "$\\boxminus$" t t sublist))) - (setq rtn (concat rtn istart term ddstart - sublist ddend iend isep))) - (t (setq rtn (concat rtn ;; previous list - lsep ;; list separator + (setq rtn (concat rtn istart term sublist iend isep))) + (t (setq rtn (concat rtn ;; previous list + lsep ;; list separator (org-list-to-generic sublist p) - lsep ;; list separator + lsep ;; list separator ))))) (format wrapper rtn)))) (defun org-list-to-latex (list &optional params) "Convert LIST into a LaTeX list. -LIST is as returnd by `org-list-parse-list'. PARAMS is a property list +LIST is as returned by `org-list-parse-list'. PARAMS is a property list with overruling parameters for `org-list-to-generic'." (org-list-to-generic list @@ -1335,7 +2254,7 @@ with overruling parameters for `org-list-to-generic'." (defun org-list-to-html (list &optional params) "Convert LIST into a HTML list. -LIST is as returnd by `org-list-parse-list'. PARAMS is a property list +LIST is as returned by `org-list-parse-list'. PARAMS is a property list with overruling parameters for `org-list-to-generic'." (org-list-to-generic list @@ -1352,7 +2271,7 @@ with overruling parameters for `org-list-to-generic'." (defun org-list-to-texinfo (list &optional params) "Convert LIST into a Texinfo list. -LIST is as returnd by `org-list-parse-list'. PARAMS is a property list +LIST is as returned by `org-list-parse-list'. PARAMS is a property list with overruling parameters for `org-list-to-generic'." (org-list-to-generic list diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el index 563c0edc0ca..6190fe7938a 100644 --- a/lisp/org/org-mac-message.el +++ b/lisp/org/org-mac-message.el @@ -5,7 +5,7 @@ ;; Author: John Wiegley <johnw@gnu.org> ;; Christopher Suckling <suckling at gmail dot com> -;; Version: 6.33x +;; Version: 7.4 ;; Keywords: outlines, hypermedia, calendar, wp ;; This file is part of GNU Emacs. @@ -39,7 +39,7 @@ ;; messages selected in Mail.app. ;; (org-mac-message-insert-flagged) searches within an org-mode buffer -;; for a specific heading, creating it if it doesn't exist. Any +;; for a specific heading, creating it if it doesn't exist. Any ;; message:// links within the first level of the heading are deleted ;; and replaced with links to flagged messages. @@ -53,7 +53,7 @@ :group 'org-link) (defcustom org-mac-mail-account "customize" - "The Mail.app account in which to search for flagged messages" + "The Mail.app account in which to search for flagged messages." :group 'org-mac-flagged-mail :type 'string) @@ -81,7 +81,7 @@ This will use the command `open' with the message URL." "open" (concat "message://<" (substring message-id 2) ">"))) (defun as-get-selected-mail () - "AppleScript to create links to selected messages in Mail.app" + "AppleScript to create links to selected messages in Mail.app." (do-applescript (concat "tell application \"Mail\"\n" @@ -97,7 +97,7 @@ This will use the command `open' with the message URL." "end tell"))) (defun as-get-flagged-mail () - "AppleScript to create links to flagged messages in Mail.app" + "AppleScript to create links to flagged messages in Mail.app." (do-applescript (concat ;; Is Growl installed? @@ -179,7 +179,7 @@ The Org-syntax text will be pushed to the kill ring, and also returned." (defun org-mac-message-insert-selected () "Insert a link to the messages currently selected in Mail.app. -This will use applescript to get the message-id and the subject of the +This will use AppleScript to get the message-id and the subject of the active mail in Mail.app and make a link out of it." (interactive) (insert (org-mac-message-get-links "s"))) @@ -209,7 +209,7 @@ list of message:// links to flagged mail after heading." (insert "\n" (org-mac-message-get-links "f"))) (goto-char (point-max)) (insert "\n") - (org-insert-heading) + (org-insert-heading nil t) (insert org-heading "\n" (org-mac-message-get-links "f")))))) (provide 'org-mac-message) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 6782d39c412..2af2deb61b3 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -38,11 +38,39 @@ (defmacro declare-function (fn file &optional arglist fileonly)))) (declare-function org-add-props "org-compat" (string plist &rest props)) +(declare-function org-string-match-p "org-compat" (&rest args)) + +(defmacro org-called-interactively-p (&optional kind) + `(if (featurep 'xemacs) + (interactive-p) + (if (or (> emacs-major-version 23) + (and (>= emacs-major-version 23) + (>= emacs-minor-version 2))) + (with-no-warnings (called-interactively-p ,kind)) ;; defined with no argument in <=23.1 + (interactive-p)))) + +(if (and (not (fboundp 'with-silent-modifications)) + (or (< emacs-major-version 23) + (and (= emacs-major-version 23) + (< emacs-minor-version 2)))) + (defmacro with-silent-modifications (&rest body) + `(org-unmodified ,@body))) (defmacro org-bound-and-true-p (var) "Return the value of symbol VAR if it is bound, else nil." `(and (boundp (quote ,var)) ,var)) +(defun org-string-nw-p (s) + "Is S a string with a non-white character?" + (and (stringp s) + (org-string-match-p "\\S-" s) + s)) + +(defun org-not-nil (v) + "If V not nil, and also not the string \"nil\", then return V. +Otherwise return nil." + (and v (not (equal v "nil")) v)) + (defmacro org-unmodified (&rest body) "Execute body without changing `buffer-modified-p'. Also, do not record undo information." @@ -63,6 +91,8 @@ Also, do not record undo information." (setq ss (replace-match "a-zA-Z0-9" t t ss))) (while (string-match "\\[:alpha:\\]" ss) (setq ss (replace-match "a-zA-Z" t t ss))) + (while (string-match "\\[:punct:\\]" ss) + (setq ss (replace-match "\001-@[-`{-~" t t ss))) ss)) s)) @@ -85,7 +115,7 @@ Also, do not record undo information." (defmacro org-maybe-intangible (props) "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22. -In emacs 21, invisible text is not avoided by the command loop, so the +In Emacs 21, invisible text is not avoided by the command loop, so the intangible property is needed to make sure point skips this text. In Emacs 22, this is not necessary. The intangible text property has led to problems with flyspell. These problems are fixed in flyspell.el, @@ -123,6 +153,14 @@ We use a macro so that the test can happen at compilation time." ,@body)) (put 'org-if-unprotected-at 'lisp-indent-function 1) +(defun org-re-search-forward-unprotected (&rest args) + "Like re-search-forward, but stop only in unprotected places." + (catch 'exit + (while t + (unless (apply 're-search-forward args) + (throw 'exit nil)) + (unless (get-text-property (match-beginning 0) 'org-protected) + (throw 'exit (point)))))) (defmacro org-with-remote-undo (_buffer &rest _body) "Execute BODY while recording undo information in two buffers." @@ -152,7 +190,8 @@ We use a macro so that the test can happen at compilation time." `(let ((inhibit-read-only t)) ,@body)) (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t - rear-nonsticky t mouse-map t fontified t) + rear-nonsticky t mouse-map t fontified t + org-emphasis t) "Properties to remove when a string without properties is wanted.") (defsubst org-match-string-no-properties (num &optional string) @@ -260,7 +299,6 @@ This is in contrast to merely setting it to 0." (setq plist (cddr plist))) p)) - (defun org-replace-match-keep-properties (newtext &optional fixedcase literal string) "Like `replace-match', but add the text properties found original text." @@ -268,6 +306,25 @@ This is in contrast to merely setting it to 0." (match-beginning 0) string))) (replace-match newtext fixedcase literal string)) +(defmacro org-save-outline-visibility (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. +This means that the buffer may change while running BODY, +but it also means that the buffer should stay alive +during the operation, because otherwise all these markers will +point nowhere." + (declare (indent 1)) + `(let ((data (org-outline-overlay-data ,use-markers))) + (unwind-protect + (progn + ,@body + (org-set-outline-overlay-data data)) + (when ,use-markers + (mapc (lambda (c) + (and (markerp (car c)) (move-marker (car c) nil)) + (and (markerp (cdr c)) (move-marker (cdr c) nil))) + data))))) + (defmacro org-with-limited-levels (&rest body) "Execute BODY with limited number of outline levels." `(let* ((outline-regexp (org-get-limited-outline-regexp))) @@ -277,7 +334,7 @@ This is in contrast to merely setting it to 0." (defvar org-inlinetask-min-level) ; defined in org-inlinetask.el (defun org-get-limited-outline-regexp () "Return outline-regexp with limited number of levels. -The number of levels is controlled by " +The number of levels is controlled by `org-inlinetask-min-level'" (if (or (not (org-mode-p)) (not (featurep 'org-inlinetask))) outline-regexp diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el index 37a75fde774..d1800093d06 100644 --- a/lisp/org/org-mew.el +++ b/lisp/org/org-mew.el @@ -5,7 +5,7 @@ ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -81,7 +81,7 @@ (mew-case-folder (mew-sinfo-get-case) (nth 1 (mew-refile-get msgnum))) (mew-summary-folder-name))) - message-id from to subject desc link) + message-id from to subject desc link date date-ts date-ts-ia) (save-window-excursion (if (fboundp 'mew-summary-set-message-buffer) (mew-summary-set-message-buffer folder-name msgnum) @@ -89,9 +89,19 @@ (setq message-id (mew-header-get-value "Message-Id:")) (setq from (mew-header-get-value "From:")) (setq to (mew-header-get-value "To:")) + (setq date (mew-header-get-value "Date:")) + (setq date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (setq date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) (setq subject (mew-header-get-value "Subject:"))) (org-store-link-props :type "mew" :from from :to to :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (setq message-id (org-remove-angle-brackets message-id)) (setq desc (org-email-link-description)) (setq link (org-make-link "mew:" folder-name diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index 9798d50c931..d3314ce3f51 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -6,7 +6,7 @@ ;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -83,13 +83,22 @@ supported by MH-E." "Store a link to an MH-E folder or message." (when (or (equal major-mode 'mh-folder-mode) (equal major-mode 'mh-show-mode)) - (let ((from (org-mhe-get-header "From:")) - (to (org-mhe-get-header "To:")) - (message-id (org-mhe-get-header "Message-Id:")) - (subject (org-mhe-get-header "Subject:")) - link desc) + (let* ((from (org-mhe-get-header "From:")) + (to (org-mhe-get-header "To:")) + (message-id (org-mhe-get-header "Message-Id:")) + (subject (org-mhe-get-header "Subject:")) + (date (org-mhe-get-header "Date:")) + (date-ts (and date (format-time-string + (org-time-stamp-format t) (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) + link desc) (org-store-link-props :type "mh" :from from :to to :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (setq desc (org-email-link-description)) (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" (org-remove-angle-brackets message-id))) @@ -181,7 +190,7 @@ you have a better idea of how to do this then please let us know." (if (equal major-mode 'mh-folder-mode) (mh-show) (mh-show-show)) - header-field))) + (org-trim header-field)))) (defun org-mhe-follow-link (folder article) "Follow an MH-E link to FOLDER and ARTICLE. diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el new file mode 100644 index 00000000000..df4ab3e2e75 --- /dev/null +++ b/lisp/org/org-mks.el @@ -0,0 +1,137 @@ +;;; org-mks.el --- Multi-key-selection for Org-mode + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 7.4 +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;; Commentary: +;; + +;;; Code: + +(require 'org) +(eval-when-compile + (require 'cl)) + +(defun org-mks (table title &optional prompt specials) + "Select a member of an alist with multiple keys. +TABLE is the alist which should contain entries where the car is a string. +There should be two types of entries. + +1. prefix descriptions like (\"a\" \"Description\") + This indicates that `a' is a prefix key for multi-letter selection, and + that there are entries following with keys like \"ab\", \"ax\"... + +2. Selectable members must have more than two elements, with the first + being the string of keys that lead to selecting it, and the second a + short description string of the item. + +The command will then make a temporary buffer listing all entries +that can be selected with a single key, and all the single key +prefixes. When you press the key for a single-letter entry, it is selected. +When you press a prefix key, the commands (and maybe further prefixes) +under this key will be shown and offered for selection. + +TITLE will be placed over the selection in the temporary buffer, +PROMPT will be used when prompting for a key. SPECIAL is an alist with +also (\"key\" \"description\") entries. When one of these is selection, +only the bare key is returned." + (setq prompt (or prompt "Select: ")) + (let (tbl orig-table dkey ddesc des-keys allowed-keys + current prefix rtn re pressed buffer (inhibit-quit t)) + (save-window-excursion + (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) + (setq orig-table table) + (catch 'exit + (while t + (erase-buffer) + (insert title "\n\n") + (setq tbl table + des-keys nil + allowed-keys nil) + (setq prefix (if current (concat current " ") "")) + (while tbl + (cond + ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) + ;; This is a description on this level + (setq dkey (caar tbl) ddesc (cadar tbl)) + (pop tbl) + (push dkey des-keys) + (push dkey allowed-keys) + (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") + ;; Skip keys which are below this prefix + (setq re (concat "\\`" (regexp-quote dkey))) + (while (and tbl (string-match re (caar tbl))) (pop tbl))) + ((= 2 (length (car tbl))) + ;; Not yet a usable description, skip it + ) + (t + ;; usable entry on this level + (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") + (push (caar tbl) allowed-keys) + (pop tbl)))) + (when specials + (insert "-------------------------------------------------------------------------------\n") + (let ((sp specials)) + (while sp + (insert (format "[%s] %s\n" + (caar sp) (nth 1 (car sp)))) + (push (caar sp) allowed-keys) + (pop sp)))) + (push "\C-g" allowed-keys) + (goto-char (point-min)) + (if (not (pos-visible-in-window-p (point-max))) + (org-fit-window-to-buffer)) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive))) + (while (not (member pressed allowed-keys)) + (message "Invalid key `%s'" pressed) (sit-for 1) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive)))) + (when (equal pressed "\C-g") + (kill-buffer buffer) + (error "Abort")) + (when (and (not (assoc pressed table)) + (not (member pressed des-keys)) + (assoc pressed specials)) + (throw 'exit (setq rtn pressed))) + (unless (member pressed des-keys) + (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) + orig-table)))) + (setq current (concat current pressed)) + (setq table (mapcar + (lambda (x) + (if (and (> (length (car x)) 1) + (equal (substring (car x) 0 1) pressed)) + (cons (substring (car x) 1) (cdr x)) + nil)) + table)) + (setq table (remove nil table))))) + (when buffer (kill-buffer buffer)) + rtn)) + +(provide 'org-mks) + +;; arch-tag: 4ea90d0e-c6e4-4684-bd61-baf878712f9f + +;;; org-mks.el ends here diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index cc458599874..86c2e34639a 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -26,13 +26,16 @@ ;;; Commentary: ;; ;; This file contains the code to interact with Richard Moreland's iPhone -;; application MobileOrg. This code is documented in Appendix B of the -;; Org-mode manual. The code is not specific for the iPhone, however. -;; Any external viewer/flagging/editing application that uses the same -;; conventions could be used. +;; application MobileOrg, as well as with the Android version by Matthew Jones. +;; This code is documented in Appendix B of the Org-mode manual. The code is +;; not specific for the iPhone and Android - any external +;; viewer/flagging/editing application that uses the same conventions could +;; be used. (require 'org) (require 'org-agenda) +;;; Code: + (eval-when-compile (require 'cl)) (defgroup org-mobile nil @@ -47,7 +50,7 @@ directly. Directories will be search for files with the extension `.org'. In addition to this, the list may also contain the following symbols: org-agenda-files - This means, include the complete, unrestricted list of files given in + This means include the complete, unrestricted list of files given in the variable `org-agenda-files'. org-agenda-text-search-extra-files Include the files given in the variable @@ -65,6 +68,52 @@ org-agenda-text-search-extra-files :group 'org-mobile :type 'directory) +(defcustom org-mobile-use-encryption nil + "Non-nil means keep only encrypted files on the WebDAV server. +Encryption uses AES-256, with a password given in +`org-mobile-encryption-password'. +When nil, plain files are kept on the server. +Turning on encryption requires to set the same password in the MobileOrg +application. Before turning this on, check of MobileOrg does already +support it - at the time of this writing it did not yet." + :group 'org-mobile + :type 'boolean) + +(defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt" + "File that is being used as a temporary file for encryption. +This must be local file on your local machine (not on the WebDAV server). +You might want to put this file into a directory where only you have access." + :group 'org-mobile + :type 'directory) + +(defcustom org-mobile-encryption-password "" + "Password for encrypting files uploaded to the server. +This is a single password which is used for AES-256 encryption. The same +password must also be set in the MobileOrg application. All Org files, +including mobileorg.org will be encrypted using this password. + +SECURITY CONSIDERATIONS: + +Note that, when Org runs the encryption commands, the password could +be visible briefly on your system with the `ps' command. So this method is +only intended to keep the files secure on the server, not on your own machine. + +Also, if you set this variable in an init file (.emacs or .emacs.d/init.el +or custom.el...) and if that file is stored in a way so that other can read +it, this also limits the security of this approach. You can also leave +this variable empty - Org will then ask for the password once per Emacs +session." + :group 'org-mobile + :type '(string :tag "Password")) + +(defvar org-mobile-encryption-password-session nil) + +(defun org-mobile-encryption-password () + (or (org-string-nw-p org-mobile-encryption-password) + (org-string-nw-p org-mobile-encryption-password-session) + (setq org-mobile-encryption-password-session + (read-passwd "Password for MobileOrg: " t)))) + (defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org" "The file where captured notes and flags will be appended to. During the execution of `org-mobile-pull', the file @@ -85,13 +134,29 @@ should point to this file." :group 'org-mobile :type 'file) +(defcustom org-mobile-agendas 'all + "The agendas that should be pushed to MobileOrg. +Allowed values: + +default the weekly agenda and the global TODO list +custom all custom agendas defined by the user +all the custom agendas and the default ones +list a list of selection key(s) as string." + :group 'org-mobile + :type '(choice + (const :tag "Default Agendas" default) + (const :tag "Custom Agendas" custom) + (const :tag "Default and Custom Agendas" all) + (repeat :tag "Selected" + (string :tag "Selection Keys")))) + (defcustom org-mobile-force-id-on-agenda-items t - "Non-nil means make all agenda items carry and ID." + "Non-nil means make all agenda items carry an ID." :group 'org-mobile :type 'boolean) (defcustom org-mobile-force-mobile-change nil - "Non-nil means, force the change made on the mobile device. + "Non-nil means force the change made on the mobile device. So even if there have been changes to the computer version of the entry, force the new value set on the mobile. When nil, mark the entry from the mobile with an error message. @@ -247,15 +312,14 @@ create all custom agenda views, for upload to the mobile phone." (kill-buffer a-buffer) (let ((cw (selected-window))) (select-window (get-buffer-window a-buffer)) - (org-agenda-redo) (select-window cw))))) (message "Files for mobile viewer staged")) - + (defvar org-mobile-before-process-capture-hook nil "Hook that is run after content was moved to `org-mobile-inbox-for-pull'. -The inbox file is in the current buffer, and the buffer is arrowed to the -new captured data.") +The inbox file is visited by the current buffer, and the buffer is +narrowed to the newly captured data.") ;;;###autoload (defun org-mobile-pull () @@ -285,6 +349,7 @@ agenda view showing the flagged items." (defun org-mobile-check-setup () "Check if org-mobile-directory has been set up." + (org-mobile-cleanup-encryption-tempfile) (unless (and org-directory (stringp org-directory) (string-match "\\S-" org-directory) @@ -305,7 +370,19 @@ agenda view showing the flagged items." (file-exists-p (file-name-directory org-mobile-inbox-for-pull))) (error - "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory"))) + "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory")) + (unless (and org-mobile-checksum-binary + (string-match "\\S-" org-mobile-checksum-binary)) + (error "No executable found to compute checksums")) + (when org-mobile-use-encryption + (unless (string-match "\\S-" (org-mobile-encryption-password)) + (error + "To use encryption, you must set `org-mobile-encryption-password'")) + (unless (file-writable-p org-mobile-encryption-tempfile) + (error "Cannot write to encryption tempfile %s" + org-mobile-encryption-tempfile)) + (unless (executable-find "openssl") + (error "openssl is needed to encrypt files")))) (defun org-mobile-create-index-file () "Write the index file in the WebDAV directory." @@ -313,8 +390,10 @@ agenda view showing the flagged items." (lambda (a b) (string< (cdr a) (cdr b))))) (def-todo (default-value 'org-todo-keywords)) (def-tags (default-value 'org-tag-alist)) + (target-file (expand-file-name org-mobile-index-file + org-mobile-directory)) file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds) - + (org-prepare-agenda-buffers (mapcar 'car files-alist)) (setq done-kwds (org-uniquify org-done-keywords-for-agenda)) (setq todo-kwds (org-delete-all @@ -331,7 +410,9 @@ agenda view showing the flagged items." (t nil))) org-tag-alist-for-agenda)))) (with-temp-file - (expand-file-name org-mobile-index-file org-mobile-directory) + (if org-mobile-use-encryption + org-mobile-encryption-tempfile + target-file) (while (setq entry (pop def-todo)) (insert "#+READONLY\n") (setq kwds (mapcar (lambda (x) (if (string-match "(" x) @@ -372,7 +453,11 @@ agenda view showing the flagged items." (insert (format "* [[file:%s][%s]]\n" link-name link-name))) (push (cons org-mobile-index-file (md5 (buffer-string))) - org-mobile-checksum-files)))) + org-mobile-checksum-files)) + (when org-mobile-use-encryption + (org-mobile-encrypt-and-move org-mobile-encryption-tempfile + target-file) + (org-mobile-cleanup-encryption-tempfile)))) (defun org-mobile-copy-agenda-files () "Copy all agenda files to the stage or WebDAV directory." @@ -385,21 +470,29 @@ agenda view showing the flagged items." target-dir (file-name-directory target-path)) (unless (file-directory-p target-dir) (make-directory target-dir 'parents)) - (copy-file file target-path 'ok-if-exists) + (if org-mobile-use-encryption + (org-mobile-encrypt-and-move file target-path) + (copy-file file target-path 'ok-if-exists)) (setq check (shell-command-to-string (concat org-mobile-checksum-binary " " (shell-quote-argument (expand-file-name file))))) (when (string-match "[a-fA-F0-9]\\{30,40\\}" check) (push (cons link-name (match-string 0 check)) org-mobile-checksum-files)))) + (setq file (expand-file-name org-mobile-capture-file org-mobile-directory)) (save-excursion (setq buf (find-file file)) - (and (= (point-min) (point-max)) (insert "\n")) - (save-buffer) + (when (and (= (point-min) (point-max))) + (insert "\n") + (save-buffer) + (when org-mobile-use-encryption + (write-file org-mobile-encryption-tempfile) + (org-mobile-encrypt-and-move org-mobile-encryption-tempfile file))) (push (cons org-mobile-capture-file (md5 (buffer-string))) org-mobile-checksum-files)) + (org-mobile-cleanup-encryption-tempfile) (kill-buffer buf))) (defun org-mobile-write-checksums () @@ -426,8 +519,22 @@ The table of checksums is written to the file mobile-checksums." ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) (t (cons (car x) (cons "" (cdr x)))))) org-agenda-custom-commands))) - new e key desc type match settings cmds gkey gdesc gsettings cnt) - (while (setq e (pop custom-list)) + (default-list '(("a" "Agenda" agenda) ("t" "All TODO" alltodo))) + thelist new e key desc type match settings cmds gkey gdesc gsettings cnt) + (cond + ((eq org-mobile-agendas 'custom) + (setq thelist custom-list)) + ((eq org-mobile-agendas 'default) + (setq thelist default-list)) + ((eq org-mobile-agendas 'all) + (setq thelist custom-list) + (unless (assoc "t" thelist) (push '("t" "ALL TODO" alltodo) thelist)) + (unless (assoc "a" thelist) (push '("a" "Agenda" agenda) thelist))) + ((listp org-mobile-agendas) + (setq thelist (append custom-list default-list)) + (setq thelist (delq nil (mapcar (lambda (k) (assoc k thelist)) + org-mobile-agendas))))) + (while (setq e (pop thelist)) (cond ((stringp (cdr e)) ;; this is a description entry - skip it @@ -438,7 +545,12 @@ The table of checksums is written to the file mobile-checksums." ((memq (nth 2 e) '(todo-tree tags-tree occur-tree)) ;; These are trees, not really agenda commands ) - ((memq (nth 2 e) '(agenda todo tags)) + ((and (memq (nth 2 e) '(todo tags tags-todo)) + (or (null (nth 3 e)) + (not (string-match "\\S-" (nth 3 e))))) + ;; These would be interactive because the match string is empty + ) + ((memq (nth 2 e) '(agenda alltodo todo tags tags-todo)) ;; a normal command (setq key (car e) desc (nth 1 e) type (nth 2 e) match (nth 3 e) settings (nth 4 e)) @@ -527,40 +639,105 @@ The table of checksums is written to the file mobile-checksums." (if (org-bound-and-true-p org-mobile-force-id-on-agenda-items) (org-id-get m 'create) - (org-entry-get m "ID"))) + (or (org-entry-get m "ID") + (org-mobile-get-outline-path-link m)))) (insert " :PROPERTIES:\n :ORIGINAL_ID: " id "\n :END:\n"))))) (beginning-of-line 2)) - (push (cons (file-name-nondirectory file) (md5 (buffer-string))) + (push (cons "agendas.org" (md5 (buffer-string))) org-mobile-checksum-files)) (message "Agenda written to Org file %s" file))) +(defun org-mobile-get-outline-path-link (pom) + (org-with-point-at pom + (concat "olp:" + (org-mobile-escape-olp (file-name-nondirectory buffer-file-name)) + "/" + (mapconcat 'org-mobile-escape-olp + (org-get-outline-path) + "/") + "/" + (org-mobile-escape-olp (nth 4 (org-heading-components)))))) + +(defun org-mobile-escape-olp (s) + (let ((table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f")))) + (org-link-escape s table))) + ;;;###autoload (defun org-mobile-create-sumo-agenda () "Create a file that contains all custom agenda views." (interactive) (let* ((file (expand-file-name "agendas.org" org-mobile-directory)) + (file1 (if org-mobile-use-encryption + org-mobile-encryption-tempfile + file)) (sumo (org-mobile-sumo-agenda-command)) (org-agenda-custom-commands - (list (append sumo (list (list file))))) + (list (append sumo (list (list file1))))) (org-mobile-creating-agendas t)) - (unless (file-writable-p file) - (error "Cannot write to file %s" file)) + (unless (file-writable-p file1) + (error "Cannot write to file %s" file1)) (when sumo - (org-store-agenda-views)))) + (org-store-agenda-views)) + (when org-mobile-use-encryption + (org-mobile-encrypt-and-move file1 file) + (delete-file file1) + (org-mobile-cleanup-encryption-tempfile)))) + +(defun org-mobile-encrypt-and-move (infile outfile) + "Encrypt INFILE locally to INFILE_enc, then move it to OUTFILE. +We do this in two steps so that remote paths will work, even if the +encryption program does not understand them." + (let ((encfile (concat infile "_enc"))) + (org-mobile-encrypt-file infile encfile) + (when outfile + (copy-file encfile outfile 'ok-if-exists) + (delete-file encfile)))) + +(defun org-mobile-encrypt-file (infile outfile) + "Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." + (shell-command + (format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s" + (shell-quote-argument (concat "pass:" + (org-mobile-encryption-password))) + (shell-quote-argument (expand-file-name infile)) + (shell-quote-argument (expand-file-name outfile))))) + +(defun org-mobile-decrypt-file (infile outfile) + "Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." + (shell-command + (format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s" + (shell-quote-argument (concat "pass:" + (org-mobile-encryption-password))) + (shell-quote-argument (expand-file-name infile)) + (shell-quote-argument (expand-file-name outfile))))) + +(defun org-mobile-cleanup-encryption-tempfile () + "Remove the encryption tempfile if it exists." + (and (stringp org-mobile-encryption-tempfile) + (file-exists-p org-mobile-encryption-tempfile) + (delete-file org-mobile-encryption-tempfile))) (defun org-mobile-move-capture () "Move the contents of the capture file to the inbox file. Return a marker to the location where the new content has been added. If nothing new has been added, return nil." (interactive) - (let ((inbox-buffer (find-file-noselect org-mobile-inbox-for-pull)) - (capture-buffer (find-file-noselect - (expand-file-name org-mobile-capture-file - org-mobile-directory))) - (insertion-point (make-marker)) - not-empty content) + (let* ((encfile nil) + (capture-file (expand-file-name org-mobile-capture-file + org-mobile-directory)) + (inbox-buffer (find-file-noselect org-mobile-inbox-for-pull)) + (capture-buffer + (if (not org-mobile-use-encryption) + (find-file-noselect capture-file) + (org-mobile-cleanup-encryption-tempfile) + (setq encfile (concat org-mobile-encryption-tempfile "_enc")) + (copy-file capture-file encfile) + (org-mobile-decrypt-file encfile org-mobile-encryption-tempfile) + (find-file-noselect org-mobile-encryption-tempfile))) + (insertion-point (make-marker)) + not-empty content) (with-current-buffer capture-buffer (setq content (buffer-string)) (setq not-empty (string-match "\\S-" content)) @@ -577,9 +754,14 @@ If nothing new has been added, return nil." (save-buffer) (org-mobile-update-checksum-for-capture-file (buffer-string)))) (kill-buffer capture-buffer) + (when org-mobile-use-encryption + (org-mobile-encrypt-and-move org-mobile-encryption-tempfile + capture-file) + (org-mobile-cleanup-encryption-tempfile)) (if not-empty insertion-point))) (defun org-mobile-update-checksum-for-capture-file (buffer-string) + "Find the checksum line and modify it to match BUFFER-STRING." (let* ((file (expand-file-name "checksums.dat" org-mobile-directory)) (buffer (find-file-noselect file))) (when buffer @@ -781,42 +963,6 @@ FIXME: Hmmm, not sure if we can make his work against the auto-correction feature. Needs a bit more thinking. So this function is currently a noop.") - -(defun org-find-olp (path) - "Return a marker pointing to the entry at outline path OLP. -If anything goes wrong, the return value will instead an error message, -as a string." - (let* ((file (pop path)) - (buffer (find-file-noselect file)) - (level 1) - (lmin 1) - (lmax 1) - limit re end found pos heading cnt) - (unless buffer (error "File not found :%s" file)) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (setq limit (point-max)) - (goto-char (point-min)) - (while (setq heading (pop path)) - (setq re (format org-complex-heading-regexp-format - (regexp-quote heading))) - (setq cnt 0 pos (point)) - (while (re-search-forward re end t) - (setq level (- (match-end 1) (match-beginning 1))) - (if (and (>= level lmin) (<= level lmax)) - (setq found (match-beginning 0) cnt (1+ cnt)))) - (when (= cnt 0) (error "Heading not found on level %d: %s" - lmax heading)) - (when (> cnt 1) (error "Heading not unique on level %d: %s" - lmax heading)) - (goto-char found) - (setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0))) - (setq end (save-excursion (org-end-of-subtree t t)))) - (when (org-on-heading-p) - (move-marker (make-marker) (point)))))))) - (defun org-mobile-locate-entry (link) (if (string-match "\\`id:\\(.*\\)$" link) (org-id-find (match-string 1 link) 'marker) @@ -856,7 +1002,7 @@ be returned that indicates what went wrong." (org-todo (or new 'none)) t) (t (error "State before change was expected as \"%s\", but is \"%s\"" old current)))) - + ((eq what 'tags) (setq current (org-get-tags) new1 (and new (org-split-string new ":+")) @@ -869,7 +1015,7 @@ be returned that indicates what went wrong." (org-set-tags-to new1) t) (t (error "Tags before change were expected as \"%s\", but are \"%s\"" (or old "") (or current ""))))) - + ((eq what 'priority) (when (looking-at org-complex-heading-regexp) (setq current (and (match-end 3) (substring (match-string 3) 2 3))) @@ -895,7 +1041,7 @@ be returned that indicates what went wrong." (delete-region (point) (+ (point) (length current))) (org-set-tags nil 'align)) (t (error "Heading changed in MobileOrg and on the computer"))))) - + ((eq what 'body) (setq current (buffer-substring (min (1+ (point-at-eol)) (point-max)) (save-excursion (outline-next-heading) @@ -915,7 +1061,6 @@ be returned that indicates what went wrong." (point)))) t) (t (error "Body was changed in MobileOrg and on the computer"))))))) - (defun org-mobile-tags-same-p (list1 list2) "Are the two tag lists the same?" diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index a571bec4776..b26fcc7db6e 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -4,7 +4,7 @@ ;; ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -137,6 +137,8 @@ ;; ;; Versions 0.01 -- 0.07: (I don't remember) +;;; Code: + (eval-when-compile (require 'cl)) (require 'org) @@ -146,6 +148,7 @@ (declare-function org-agenda-change-all-lines "org-agenda" (newhead hdmarker &optional fixface just-this)) (declare-function org-verify-change-for-undo "org-agenda" (l1 l2)) +(declare-function org-apply-on-list "org-list" (function init-value &rest args)) (defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " "Regular expression that matches a plain list.") @@ -189,7 +192,7 @@ Changing this variable requires a restart of Emacs to get activated." (interactive) (end-of-line) (skip-chars-backward "\t ") - (when (looking-back ":[A-Za-z]+:") + (when (org-looking-back ":[A-Za-z]+:") (skip-chars-backward ":A-Za-z") (skip-chars-backward "\t "))) @@ -225,7 +228,7 @@ this function is called. Otherwise, the current major mode menu is used." (mouse-save-then-kill event))) (defun org-mouse-line-position () - "Returns `:beginning' or `:middle' or `:end', depending on the point position. + "Return `:beginning' or `:middle' or `:end', depending on the point position. If the point is at the end of the line, return `:end'. If the point is separated from the beginning of the line only by white @@ -290,7 +293,7 @@ ITEMFORMAT governs formatting of the elements of KEYWORDS. If it is a function, it is invoked with the keyword as the only argument. If it is a string, it is interpreted as the format string to (format ITEMFORMAT keyword). If it is neither a string -nor a function, elements of KEYWORDS are used directly. " +nor a function, elements of KEYWORDS are used directly." (mapcar `(lambda (keyword) (vector (cond @@ -342,8 +345,7 @@ ITEMFORMAT governs formatting of the elements of KEYWORDS. If it is a function, it is invoked with the keyword as the only argument. If it is a string, it is interpreted as the format string to (format ITEMFORMAT keyword). If it is neither a string -nor a function, elements of KEYWORDS are used directly. -" +nor a function, elements of KEYWORDS are used directly." (setq group (or group 0)) (let ((replace (org-mouse-match-closure (if nosurround 'replace-match @@ -432,7 +434,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (lambda (kwd) (equal state kwd)))))) (defun org-mouse-tag-menu () ;todo - "Create the tags menu" + "Create the tags menu." (append (let ((tags (org-get-tags))) (org-mouse-keyword-menu @@ -575,17 +577,15 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (goto-char (second contextdata)) (re-search-forward ".*" (third contextdata)))))) -(defun org-mouse-for-each-item (function) - (save-excursion - (ignore-errors - (while t (org-previous-item))) - (ignore-errors - (while t - (funcall function) - (org-next-item))))) +(defun org-mouse-for-each-item (funct) + ;; Functions called by `org-apply-on-list' need an argument + (let ((wrap-fun (lambda (c) (funcall funct)))) + (when (org-in-item-p) + (org-apply-on-list wrap-fun nil)))) (defun org-mouse-bolp () - "Returns true if there only spaces, tabs, and '*', between the beginning of line and the point" + "Return true if there only spaces, tabs, and '*' before point. +This means, between the beginning of line and the point." (save-excursion (skip-chars-backward " \t*") (bolp))) @@ -607,7 +607,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (:end ; insert text here (skip-chars-backward " \t") (kill-region (point) (point-at-eol)) - (unless (looking-back org-mouse-punctuation) + (unless (org-looking-back org-mouse-punctuation) (insert (concat org-mouse-punctuation " "))))) (insert text) @@ -674,7 +674,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" 'org-mode-restart)))) ((or (eolp) (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") - (looking-back " \\|\t"))) + (org-looking-back " \\|\t"))) (org-mouse-popup-global-menu)) ((get-context :checkbox) (popup-menu @@ -909,18 +909,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (setq org-mouse-context-menu-function 'org-mouse-context-menu) (when (memq 'context-menu org-mouse-features) - (define-key org-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) nil) - (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu)) - (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse) + (org-defkey org-mouse-map [mouse-3] nil) + (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu)) + (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse) (when (memq 'context-menu org-mouse-features) - (define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) - (define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) + (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) + (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) (when (memq 'yank-link org-mouse-features) - (define-key org-mode-map [S-mouse-2] 'org-mouse-yank-link) - (define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) + (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link) + (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) (when (memq 'move-tree org-mouse-features) - (define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) - (define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) + (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) + (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) (when (memq 'activate-stars org-mouse-features) (font-lock-add-keywords @@ -1100,10 +1100,10 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" "--" ["Day View" org-agenda-day-view :active (org-agenda-check-type nil 'agenda) - :style radio :selected (equal org-agenda-ndays 1)] + :style radio :selected (eq org-agenda-current-span 'day)] ["Week View" org-agenda-week-view :active (org-agenda-check-type nil 'agenda) - :style radio :selected (equal org-agenda-ndays 7)] + :style radio :selected (eq org-agenda-current-span 'week)] "--" ["Show Logbook entries" org-agenda-log-mode :style toggle :selected org-agenda-show-log @@ -1131,13 +1131,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (add-hook 'org-agenda-mode-hook '(lambda () (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) - (define-key org-agenda-mode-map - (if (featurep 'xemacs) [button3] [mouse-3]) - 'org-mouse-show-context-menu) - (define-key org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) - (define-key org-agenda-mode-map (if (featurep 'xemacs) [(control mouse-4)] [C-mouse-4]) 'org-agenda-earlier) - (define-key org-agenda-mode-map (if (featurep 'xemacs) [(control mouse-5)] [C-mouse-5]) 'org-agenda-later) - (define-key org-agenda-mode-map [drag-mouse-3] + (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) + (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) + (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) + (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) + (org-defkey org-agenda-mode-map [drag-mouse-3] '(lambda (event) (interactive "e") (case (org-mouse-get-gesture event) (:left (org-agenda-earlier 1)) @@ -1147,4 +1145,4 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f -;;; org-mouse.el ends-here +;;; org-mouse.el ends here diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index c94dadb5998..eea05716c33 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: tables, plotting ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -44,7 +44,7 @@ '((:plot-type . 2d) (:with . lines) (:ind . 0)) - "Default options to gnuplot used by `org-plot/gnuplot'") + "Default options to gnuplot used by `org-plot/gnuplot'.") (defvar org-plot-timestamp-fmt nil) @@ -134,7 +134,7 @@ Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." (defun org-plot/gnuplot-to-grid-data (table data-file params) "Export the data in TABLE to DATA-FILE for gnuplot. -This means, in a format appropriate for grid plotting by gnuplot. +This means in a format appropriate for grid plotting by gnuplot. PARAMS specifies which columns of TABLE should be plotted as independent and dependant variables." (interactive) @@ -250,8 +250,9 @@ manner suitable for prepending to a user-specified script." (setf plot-lines (cons (format plot-str data-file - (or (and (not text-ind) ind - (> ind 0) (format "%d:" ind)) "") + (or (and ind (> ind 0) + (not text-ind) + (format "%d:" ind)) "") (+ 1 col) (if text-ind (format ":xticlabel(%d)" ind) "") with @@ -271,7 +272,7 @@ manner suitable for prepending to a user-specified script." ;; facade functions ;;;###autoload (defun org-plot/gnuplot (&optional params) - "Plot table using gnuplot. Gnuplot options can be specified with PARAMS. + "Plot table using gnuplot. Gnuplot options can be specified with PARAMS. If not given options will be taken from the +PLOT line directly before or after the table." (interactive) @@ -300,7 +301,7 @@ line directly before or after the table." (setf table (delq 'hline (cdr table)))) ;; clean non-data from table ;; collect options (save-excursion (while (and (equal 0 (forward-line -1)) - (looking-at "#\\+")) + (looking-at "[[:space:]]*#\\+")) (setf params (org-plot/collect-options params)))) ;; dump table to datafile (very different for grid) (case (plist-get params :plot-type) @@ -320,7 +321,6 @@ line directly before or after the table." (mapcar (lambda (row) (nth ind row)) table)))) 0) (plist-put params :timeind t) ;; check for text ind column - (if (or (string= (plist-get params :with) "hist") (> (length (delq 0 (mapcar diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index f05627fcd0b..889303717c5 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -9,7 +9,7 @@ ;; Author: Ross Patterson <me AT rpatterson DOT net> ;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de> ;; Keywords: org, emacsclient, wp -;; Version: 6.33x +;; Version: 7.4 ;; This file is part of GNU Emacs. ;; @@ -31,8 +31,8 @@ ;; ;; Intercept calls from emacsclient to trigger custom actions. ;; -;; This is done by advising `server-visit-files' to scann the list of filenames -;; for `org-protocol-the-protocol' and sub-procols defined in +;; This is done by advising `server-visit-files' to scan the list of filenames +;; for `org-protocol-the-protocol' and sub-protocols defined in ;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'. ;; ;; Any application that supports calling external programs with an URL @@ -58,7 +58,7 @@ ;; (setq org-protocol-protocol-alist ;; '(("my-protocol" ;; :protocol "my-protocol" -;; :function my-protocol-handler-fuction))) +;; :function my-protocol-handler-function))) ;; ;; A "sub-protocol" will be found in URLs like this: ;; @@ -84,15 +84,20 @@ ;; URLs to local filenames defined in `org-protocol-project-alist'. ;; ;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and -;; pushes the browsers URL to the `kill-ring' for yanking. This handler is +;; pushes the browsers URL to the `kill-ring' for yanking. This handler is ;; triggered through the sub-protocol \"store-link\". ;; -;; * Call `org-protocol-remember' by using the sub-protocol \"remember\". If -;; Org-mode is loaded, emacs will pop-up a remember buffer and fill the -;; template with the data provided. I.e. the browser's URL is inserted as an -;; Org-link of which the page title will be the description part. If text +;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If +;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the +;; template with the data provided. I.e. the browser's URL is inserted as an +;; Org-link of which the page title will be the description part. If text ;; was select in the browser, that text will be the body of the entry. ;; +;; * Call `org-protocol-remember' by using the sub-protocol \"remember\". +;; This is provided for backward compatibility. +;; You may read `org-capture' as `org-remember' throughout this file if +;; you still use `org-remember'. +;; ;; You may use the same bookmark URL for all those standard handlers and just ;; adjust the sub-protocol used: ;; @@ -101,7 +106,7 @@ ;; encodeURIComponent(document.title)+'/'+ ;; encodeURIComponent(window.getSelection()) ;; -;; The handler for the sub-protocol \"remember\" detects an optional template +;; The handler for the sub-protocol \"capture\" detects an optional template ;; char that, if present, triggers the use of a special template. ;; Example: ;; @@ -121,8 +126,6 @@ (eval-when-compile (require 'cl)) -(declare-function org-publish-initialize-files-alist "org-publish" - (&optional refresh)) (declare-function org-publish-get-project-from-filename "org-publish" (filename &optional up)) (declare-function server-edit "server" (&optional arg)) @@ -143,6 +146,7 @@ for `org-protocol-the-protocol' and sub-procols defined in (defconst org-protocol-protocol-alist-default '(("org-remember" :protocol "remember" :function org-protocol-remember :kill-client t) + ("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t) ("org-store-link" :protocol "store-link" :function org-protocol-store-link) ("org-open-source" :protocol "open-source" :function org-protocol-open-source)) "Default protocols to use. @@ -151,18 +155,19 @@ See `org-protocol-protocol-alist' for a description of this variable.") (defconst org-protocol-the-protocol "org-protocol" "This is the protocol to detect if org-protocol.el is loaded. -`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold the -sub-protocols that trigger the required action. You will have to define just one -protocol handler OS-wide (MS-Windows) or per application (Linux). That protocol -handler should call emacsclient.") +`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold +the sub-protocols that trigger the required action. You will have to define +just one protocol handler OS-wide (MS-Windows) or per application (Linux). +That protocol handler should call emacsclient.") ;;; User variables: (defcustom org-protocol-reverse-list-of-files t - "* The filenames passed on the commandline are passed to the emacs-server in -reversed order. Set to `t' (default) to re-reverse the list, i.e. use the -sequence on the command line. If nil, the sequence of the filenames is + "* Non-nil means re-reverse the list of filenames passed on the command line. +The filenames passed on the command line are passed to the emacs-server in +reverse order. Set to t (default) to re-reverse the list, i.e. use the +sequence on the command line. If nil, the sequence of the filenames is unchanged." :group 'org-protocol :type 'boolean) @@ -225,7 +230,7 @@ protocol - protocol to detect in a filename without trailing colon and slashes. If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol' will search filenames for \"org-protocol:/my-protocol:/\" and trigger your action for every match. `org-protocol' is defined in - `org-protocol-the-protocol'. Double and tripple slashes are compressed + `org-protocol-the-protocol'. Double and triple slashes are compressed to one by emacsclient. function - function that handles requests with protocol and takes exactly one @@ -239,7 +244,7 @@ function - function that handles requests with protocol and takes exactly one kill-client - If t, kill the client immediately, once the sub-protocol is detected. This is necessary for actions that can be interrupted by - `C-g' to avoid dangeling emacsclients. Note, that all other command + `C-g' to avoid dangling emacsclients. Note, that all other command line arguments but the this one will be discarded, greedy handlers still receive the whole list of arguments though. @@ -248,23 +253,22 @@ Here is an example: (setq org-protocol-protocol-alist '((\"my-protocol\" :protocol \"my-protocol\" - :function my-protocol-handler-fuction) + :function my-protocol-handler-function) (\"your-protocol\" :protocol \"your-protocol\" - :function your-protocol-handler-fuction)))" + :function your-protocol-handler-function)))" :group 'org-protocol :type '(alist)) -(defcustom org-protocol-default-template-key "w" +(defcustom org-protocol-default-template-key nil "The default org-remember-templates key to use." :group 'org-protocol :type 'string) - ;;; Helper functions: (defun org-protocol-sanitize-uri (uri) - "emacsclient compresses double and tripple slashes. + "emacsclient compresses double and triple slashes. Slashes are sanitized to double slashes here." (when (string-match "^\\([a-z]+\\):/" uri) (let* ((splitparts (split-string uri "/+"))) @@ -273,12 +277,13 @@ Slashes are sanitized to double slashes here." (defun org-protocol-split-data(data &optional unhexify separator) - "Split, what a org-protocol handler function gets as only argument. -data is that one argument. Data is splitted at each occurrence of separator - (regexp). If no separator is specified or separator is nil, assume \"/+\". -The results of that splitting are return as a list. If unhexify is non-nil, -hex-decode each split part. If unhexify is a function, use that function to -decode each split part." + "Split, what an org-protocol handler function gets as only argument. +DATA is that one argument. DATA is split at each occurrence of +SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is +nil, assume \"/+\". The results of that splitting are returned +as a list. If UNHEXIFY is non-nil, hex-decode each split part. If +UNHEXIFY is a function, use that function to decode each split +part." (let* ((sep (or separator "/+")) (split-parts (split-string data sep))) (if unhexify @@ -308,7 +313,7 @@ encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'." (let* ((start (match-beginning 0)) (end (match-end 0)) (hex (match-string 0 str)) - (replacement (org-protocol-unhex-compound hex))) + (replacement (org-protocol-unhex-compound (upcase hex)))) (setq tmp (concat tmp (substring str 0 start) replacement)) (setq str (substring str end)))) (setq tmp (concat tmp str)) @@ -316,7 +321,7 @@ encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'." (defun org-protocol-unhex-compound (hex) - "Unhexify unicode hex-chars. E.g. `%C3%B6' is the german Umlaut `ü'." + "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ü'." (let* ((bytes (remove "" (split-string hex "%"))) (ret "") (eat 0) @@ -412,9 +417,9 @@ This function transforms it into a flat list." ;;; Standard protocol handlers: (defun org-protocol-store-link (fname) - "Process an org-protocol://store-link:// style url -and store a browser URL as an org link. Also pushes the links URL to the -`kill-ring'. + "Process an org-protocol://store-link:// style url. +Additionally store a browser URL as an org link. Also pushes the +link's URL to the `kill-ring'. The location for a browser's bookmark has to look like this: @@ -443,50 +448,75 @@ The sub-protocol used to reach this function is set in (defun org-protocol-remember (info) "Process an org-protocol://remember:// style url. +The location for a browser's bookmark has to look like this: + + javascript:location.href='org-protocol://remember://'+ \\ + encodeURIComponent(location.href)+'/' \\ + encodeURIComponent(document.title)+'/'+ \\ + encodeURIComponent(window.getSelection()) + +See the docs for `org-protocol-capture' for more information." + + (if (and (boundp 'org-stored-links) + (or (fboundp 'org-capture)) + (org-protocol-do-capture info 'org-remember)) + (message "Org-mode not loaded.")) + nil) + +(defun org-protocol-capture (info) + "Process an org-protocol://capture:// style url. + The sub-protocol used to reach this function is set in `org-protocol-protocol-alist'. This function detects an URL, title and optional text, separated by '/' The location for a browser's bookmark has to look like this: - javascript:location.href='org-protocol://remember://'+ \\ + javascript:location.href='org-protocol://capture://'+ \\ encodeURIComponent(location.href)+'/' \\ encodeURIComponent(document.title)+'/'+ \\ encodeURIComponent(window.getSelection()) By default, it uses the character `org-protocol-default-template-key', -which should be associated with a template in `org-remember-templates'. +which should be associated with a template in `org-capture-templates'. But you may prepend the encoded URL with a character and a slash like so: - javascript:location.href='org-protocol://org-store-link://b/'+ ... + javascript:location.href='org-protocol://capture://b/'+ ... Now template ?b will be used." - (if (and (boundp 'org-stored-links) - (fboundp 'org-remember)) - (let* ((parts (org-protocol-split-data info t)) - (template (or (and (= 1 (length (car parts))) (pop parts)) - org-protocol-default-template-key)) - (url (org-protocol-sanitize-uri (car parts))) - (type (if (string-match "^\\([a-z]+\\):" url) - (match-string 1 url))) - (title (cadr parts)) - (region (caddr parts)) - (orglink (org-make-link-string url title)) - remember-annotation-functions) - (setq org-stored-links - (cons (list url title) org-stored-links)) - (kill-new orglink) - (org-store-link-props :type type - :link url - :description title - :initial region) - (raise-frame) - (org-remember nil (string-to-char template))) - - (message "Org-mode not loaded.")) + (or (fboundp 'org-capture)) + (org-protocol-do-capture info 'org-capture)) + (message "Org-mode not loaded.")) nil) +(defun org-protocol-do-capture (info capture-func) + "Support `org-capture' and `org-remember' alike. +CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." + (let* ((parts (org-protocol-split-data info t)) + (template (or (and (= 1 (length (car parts))) (pop parts)) + org-protocol-default-template-key)) + (url (org-protocol-sanitize-uri (car parts))) + (type (if (string-match "^\\([a-z]+\\):" url) + (match-string 1 url))) + (title(or (cadr parts) "")) + (region (or (caddr parts) "")) + (orglink (org-make-link-string + url (if (string-match "[^[:space:]]" title) title url))) + (org-capture-link-is-already-stored t) ;; avoid call to org-store-link + remember-annotation-functions) + (setq org-stored-links + (cons (list url title) org-stored-links)) + (kill-new orglink) + (org-store-link-props :type type + :link url + :description title + :annotation orglink + :initial region) + (raise-frame) + (funcall capture-func nil template))) + + (defun org-protocol-open-source (fname) "Process an org-protocol://open-source:// style url. @@ -560,7 +590,7 @@ This is, how the matching is done: protocol and sub-protocol are regexp-quoted. -If a matching protcol is found, the protcol is stripped from fname and the +If a matching protocol is found, the protocol is stripped from fname and the result is passed to the protocols function as the only parameter. If the function returns nil, the filename is removed from the list of filenames passed from emacsclient to the server. @@ -613,11 +643,10 @@ as filename." (defun org-protocol-create-for-org () "Create a org-protocol project for the current file's Org-mode project. This works, if the file visited is part of a publishing project in -`org-publish-project-alist'. This functions calls `org-protocol-create' to do +`org-publish-project-alist'. This function calls `org-protocol-create' to do most of the work." (interactive) (require 'org-publish) - (org-publish-initialize-files-alist) (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) (if all (org-protocol-create (cdr all)) (message "Not in an org-project. Did mean %s?" diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el index 5bb641f0014..46d9d9e1a30 100644 --- a/lisp/org/org-publish.el +++ b/lisp/org/org-publish.el @@ -4,7 +4,7 @@ ;; Author: David O'Toole <dto@gnu.org> ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> ;; Keywords: hypermedia, outlines, wp -;; Version: 6.33x +;; Version: 7.4 ;; This file is part of GNU Emacs. ;; @@ -31,7 +31,7 @@ ;; + Publish all one's org-files to HTML or PDF ;; + Upload HTML, images, attachments and other files to a web server ;; + Exclude selected private pages from publishing -;; + Publish a clickable index of pages +;; + Publish a clickable sitemap of pages ;; + Manage local timestamps for publishing only changed files ;; + Accept plugin functions to extend range of publishable content ;; @@ -39,6 +39,17 @@ ;;; Code: + +(defun org-publish-sanitize-plist (plist) + (mapcar (lambda (x) + (or (cdr (assq x '((:index-filename . :sitemap-filename) + (:index-title . :sitemap-title) + (:index-function . :sitemap-function) + (:index-style . :sitemap-style) + (:auto-index . :auto-sitemap)))) + x)) + plist)) + (eval-when-compile (require 'cl)) (require 'org) @@ -59,11 +70,14 @@ Each element of the alist is a publishing 'project.' The CAR of each element is a string, uniquely identifying the project. The CDR of each element is in one of the following forms: - (:property value :property value ... ) +1. A well-formed property list with an even number of elements, alternating + keys and values, specifying parameters for the publishing process. -OR, + (:property value :property value ... ) - (:components (\"project-1\" \"project-2\" ...)) +2. A meta-project definition, specifying of a list of sub-projects: + + (:components (\"project-1\" \"project-2\" ...)) When the CDR of an element of org-publish-project-alist is in this second form, the elements of the list after :components are @@ -80,7 +94,8 @@ Most properties are optional, but some should always be set: :base-directory Directory containing publishing source files :base-extension Extension (without the dot!) of source files. - This can be a regular expression. + This can be a regular expression. If not given, + \"org\" will be used as default extension. :publishing-directory Directory (possibly remote) where output files will be published @@ -112,9 +127,11 @@ project for publishing. For example, you could call GNU Make on a certain makefile, to ensure published files are built up to date. :preparation-function Function to be called before publishing - this project. + this project. This may also be a list + of functions. :completion-function Function to be called after publishing - this project. + this project. This may also be a list + of functions. Some properties control details of the Org publishing process, and are equivalent to the corresponding user variables listed in @@ -144,28 +161,49 @@ learn more about their use and default values. :author `user-full-name' :email `user-mail-address' -The following properties may be used to control publishing of an -index of files or summary page for a given project. +The following properties may be used to control publishing of a +sitemap of files or summary page for a given project. - :auto-index Whether to publish an index during + :auto-sitemap Whether to publish a sitemap during `org-publish-current-project' or `org-publish-all'. - :index-filename Filename for output of index. Defaults + :sitemap-filename Filename for output of sitemap. Defaults to 'sitemap.org' (which becomes 'sitemap.html'). - :index-title Title of index page. Defaults to name of file. - :index-function Plugin function to use for generation of index. - Defaults to `org-publish-org-index', which + :sitemap-title Title of sitemap page. Defaults to name of file. + :sitemap-function Plugin function to use for generation of sitemap. + Defaults to `org-publish-org-sitemap', which generates a plain list of links to all files in the project. - :index-style Can be `list' (index is just an itemized list + :sitemap-style Can be `list' (sitemap is just an itemized list of the titles of the files involved) or `tree' (the directory structure of the source - files is reflected in the index). Defaults to - `tree'." + files is reflected in the sitemap). Defaults to + `tree'. + + If you create a sitemap file, adjust the sorting like this: + + :sitemap-sort-folders Where folders should appear in the sitemap. + Set this to `first' (default) or `last' to + display folders first or last, respectively. + Any other value will mix files and folders. + :sitemap-alphabetically The site map is normally sorted alphabetically. + Set this explicitly to nil to turn off sorting. + :sitemap-ignore-case Should sorting be case-sensitive? Default nil. + +The following properties control the creation of a concept index. + + :makeindex Create a concept index. + +Other properties affecting publication. + + :body-only Set this to 't' to publish only the body of the + documents, excluding everything outside and + including the <body> tags in HTML, or + \begin{document}..\end{document} in LaTeX." :group 'org-publish :type 'alist) (defcustom org-publish-use-timestamps-flag t - "When non-nil, use timestamp checking to publish only changed files. + "Non-nil means use timestamp checking to publish only changed files. When nil, do no timestamp checking and always publish all files." :group 'org-publish :type 'boolean) @@ -177,7 +215,7 @@ When nil, do no timestamp checking and always publish all files." :type 'directory) (defcustom org-publish-list-skipped-files t - "Non-nil means, show message about files *not* published." + "Non-nil means show message about files *not* published." :group 'org-publish :type 'boolean) @@ -194,6 +232,34 @@ Any changes made by this hook will be saved." :group 'org-publish :type 'hook) +(defcustom org-publish-sitemap-sort-alphabetically t + "Should sitemaps be sorted alphabetically by default? + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-alphabetically'." + :group 'org-publish + :type 'boolean) + +(defcustom org-publish-sitemap-sort-folders 'first + "A symbol, denoting if folders are sorted first in sitemaps. +Possible values are `first', `last', and nil. +If `first', folders will be sorted before files. +If `last', folders are sorted to the end after the files. +Any other value will not mix files and folders. + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-sort-folders'." + :group 'org-publish + :type 'symbol) + +(defcustom org-publish-sitemap-sort-ignore-case nil + "Sort sitemaps case insensitively by default? + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-ignore-case'." + :group 'org-publish + :type 'boolean) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Timestamp-related functions @@ -201,29 +267,19 @@ Any changes made by this hook will be saved." "Return path to timestamp file for filename FILENAME." (setq filename (concat filename "::" (or pub-dir "") "::" (format "%s" (or pub-func "")))) - (concat (file-name-as-directory org-publish-timestamp-directory) - "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) + (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) (defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir) - "Return `t' if FILENAME should be published in PUB-DIR using PUB-FUNC. -TRUE-PUB-DIR is there the file will truely end up. Currently we are not using + "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC. +TRUE-PUB-DIR is where the file will truly end up. Currently we are not using this - maybe it can eventually be used to check if the file is present at the target location, and how old it is. Right ow we cannot do this, because we do not know under what file name the file will be stored - the publishing function can still decide about that independently." (let ((rtn (if org-publish-use-timestamps-flag - (if (file-exists-p org-publish-timestamp-directory) - ;; first handle possible wrong timestamp directory - (if (not (file-directory-p org-publish-timestamp-directory)) - (error "Org publish timestamp: %s is not a directory" - org-publish-timestamp-directory) - ;; there is a timestamp, check if FILENAME is newer - (file-newer-than-file-p - filename (org-publish-timestamp-filename - filename pub-dir pub-func))) - (make-directory org-publish-timestamp-directory) - t) + (org-publish-cache-file-needs-publishing + filename pub-dir pub-func) ;; don't use timestamps, always return t t))) (if rtn @@ -235,55 +291,33 @@ function can still decide about that independently." (defun org-publish-update-timestamp (filename &optional pub-dir pub-func) "Update publishing timestamp for file FILENAME. If there is no timestamp, create one." - (let ((timestamp-file (org-publish-timestamp-filename - filename pub-dir pub-func)) - newly-created-timestamp) - (if (not (file-exists-p timestamp-file)) - ;; create timestamp file if needed - (with-temp-buffer - (make-directory (file-name-directory timestamp-file) t) - (write-file timestamp-file) - (setq newly-created-timestamp t))) - ;; Emacs 21 doesn't have `set-file-times' - (if (and (fboundp 'set-file-times) - (not newly-created-timestamp)) - (set-file-times timestamp-file) - (call-process "touch" nil 0 nil (expand-file-name timestamp-file))))) + (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) + (stamp (org-publish-cache-ctime-of-src filename))) + (org-publish-cache-set key stamp))) (defun org-publish-remove-all-timestamps () - "Remove all files in the timstamp directory." + "Remove all files in the timestamp directory." (let ((dir org-publish-timestamp-directory) files) (when (and (file-exists-p dir) (file-directory-p dir)) - (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))))) + (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) + (org-publish-reset-cache)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Mapping files to project names - -(defvar org-publish-files-alist nil - "Alist of files and their parent projects. -Each element of this alist is of the form: - - (file-name . project-name)") +;;; (defvar org-publish-initial-buffer nil "The buffer `org-publish' has been called from.") (defvar org-publish-temp-files nil "Temporary list of files to be published.") -(defun org-publish-initialize-files-alist (&optional refresh) - "Set `org-publish-files-alist' if it is not set. -Also set it if the optional argument REFRESH is non-nil." - (interactive "P") - (when (or refresh (not org-publish-files-alist)) - (setq org-publish-files-alist - (org-publish-get-files org-publish-project-alist)))) +;; Here, so you find the variable right before it's used the first time: +(defvar org-publish-cache nil + "This will cache timestamps and titles for files in publishing projects. +Blocks could hash sha1 values here.") -(defun org-publish-validate-link (link &optional directory) - "Check if LINK points to a file in the current project." - (assoc (expand-file-name link directory) org-publish-files-alist)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Compatibility aliases @@ -306,27 +340,11 @@ This is a compatibility function for Emacsen without `delete-dups'." list)) (declare-function org-publish-delete-dups "org-publish" (list)) +(declare-function find-lisp-find-files "find-lisp" (directory regexp)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Getting project information out of org-publish-project-alist -(defun org-publish-get-files (projects-alist &optional no-exclusion) - "Return the list of all publishable files for PROJECTS-ALIST. -If NO-EXCLUSION is non-nil, don't exclude files." - (let (all-files) - ;; add all projects - (mapc - (lambda(p) - (let* ((exclude (plist-get (cdr p) :exclude)) - (files (and p (org-publish-get-base-files p exclude)))) - ;; add all files from this project - (mapc (lambda(f) - (add-to-list 'all-files - (cons (expand-file-name f) (car p)))) - files))) - (org-publish-expand-projects projects-alist)) - all-files)) - (defun org-publish-expand-projects (projects-alist) "Expand projects in PROJECTS-ALIST. This splices all the components into the list." @@ -340,6 +358,42 @@ This splices all the components into the list." (push p rtn))) (nreverse (org-publish-delete-dups (delq nil rtn))))) + +(defvar sitemap-alphabetically) +(defvar sitemap-sort-folders) +(defvar sitemap-ignore-case) +(defvar sitemap-requested) +(defun org-publish-compare-directory-files (a b) + "Predicate for `sort', that sorts folders-first/last and alphabetically." + (let ((retval t)) + (when (or sitemap-alphabetically sitemap-sort-folders) + ;; First we sort alphabetically: + (when sitemap-alphabetically + (let* ((adir (file-directory-p a)) + (aorg (and (string-match "\\.org$" a) (not adir))) + (bdir (file-directory-p b)) + (borg (and (string-match "\\.org$" b) (not bdir))) + (A (if aorg + (concat (file-name-directory a) + (org-publish-find-title a)) a)) + (B (if borg + (concat (file-name-directory b) + (org-publish-find-title b)) b))) + (setq retval (if sitemap-ignore-case + (not (string-lessp (upcase B) (upcase A))) + (not (string-lessp B A)))))) + + ;; Directory-wise wins: + (when sitemap-sort-folders + ;; a is directory, b not: + (cond + ((and (file-directory-p a) (not (file-directory-p b))) + (setq retval (equal sitemap-sort-folders 'first))) + ;; a is not a directory, but b is: + ((and (not (file-directory-p a)) (file-directory-p b)) + (setq retval (equal sitemap-sort-folders 'last)))))) + retval)) + (defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir) "Set `org-publish-temp-files' with files from BASE-DIR directory. If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is @@ -358,8 +412,12 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR." (and skip-file (string-match skip-file fnd)) (not (file-exists-p (file-truename f))) (not (string-match match fnd))) + (pushnew f org-publish-temp-files))))) - (directory-files base-dir t (unless recurse match)))) + (if sitemap-requested + (sort (directory-files base-dir t (unless recurse match)) + 'org-publish-compare-directory-files) + (directory-files base-dir t (unless recurse match))))) (defun org-publish-get-base-files (project &optional exclude-regexp) "Return a list of all files in PROJECT. @@ -371,9 +429,29 @@ matching filenames." (include-list (plist-get project-plist :include)) (recurse (plist-get project-plist :recursive)) (extension (or (plist-get project-plist :base-extension) "org")) + ;; sitemap-... variables are dynamically scoped for + ;; org-publish-compare-directory-files: + (sitemap-requested + (plist-get project-plist :auto-sitemap)) + (sitemap-sort-folders + (if (plist-member project-plist :sitemap-sort-folders) + (plist-get project-plist :sitemap-sort-folders) + org-publish-sitemap-sort-folders)) + (sitemap-alphabetically + (if (plist-member project-plist :sitemap-alphabetically) + (plist-get project-plist :sitemap-alphabetically) + org-publish-sitemap-sort-alphabetically)) + (sitemap-ignore-case + (if (plist-member project-plist :sitemap-ignore-case) + (plist-get project-plist :sitemap-ignore-case) + org-publish-sitemap-sort-ignore-case)) (match (if (eq extension 'any) "^[^\\.]" (concat "^[^\\.].*\\.\\(" extension "\\)$")))) + ;; Make sure sitemap-sort-folders' has an accepted value + (unless (memq sitemap-sort-folders '(first last)) + (setq sitemap-sort-folders nil)) + (setq org-publish-temp-files nil) (org-publish-get-base-files-1 base-dir recurse match ;; FIXME distinguish exclude regexp @@ -387,9 +465,33 @@ matching filenames." org-publish-temp-files)) (defun org-publish-get-project-from-filename (filename &optional up) - "Return the project FILENAME belongs." - (let* ((project-name (cdr (assoc (expand-file-name filename) - org-publish-files-alist)))) + "Return the project that FILENAME belongs to." + (let* ((filename (expand-file-name filename)) + project-name) + + (catch 'p-found + (dolist (prj org-publish-project-alist) + (unless (plist-get (cdr prj) :components) + ;; [[info:org:Selecting%20files]] shows how this is supposed to work: + (let* ((r (plist-get (cdr prj) :recursive)) + (b (expand-file-name (file-name-as-directory + (plist-get (cdr prj) :base-directory)))) + (x (or (plist-get (cdr prj) :base-extension) "org")) + (e (plist-get (cdr prj) :exclude)) + (i (plist-get (cdr prj) :include)) + (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) + (when (or + (and + i + (member filename + (mapcar + (lambda (file) (expand-file-name file b)) + i))) + (and + (not (and e (string-match e filename))) + (string-match xm filename))) + (setq project-name (car prj)) + (throw 'p-found project-name)))))) (when up (dolist (prj org-publish-project-alist) (if (member project-name (plist-get (cdr prj) :components)) @@ -421,13 +523,15 @@ PUB-DIR is the publishing directory." (setq export-buf-or-file (funcall (intern (concat "org-export-as-" format)) (plist-get plist :headline-levels) - nil plist nil nil pub-dir)) + nil plist nil + (plist-get plist :body-only) + pub-dir)) (when (and (bufferp export-buf-or-file) (buffer-live-p export-buf-or-file)) (set-buffer export-buf-or-file) ;; run hooks after export and save export - (and (run-hooks 'org-publish-after-export-hook) - (if (buffer-modified-p) (save-buffer))) + (progn (run-hooks 'org-publish-after-export-hook) + (if (buffer-modified-p) (save-buffer))) (kill-buffer export-buf-or-file)) ;; maybe restore buffer's content (set-buffer init-buf) @@ -439,34 +543,65 @@ PUB-DIR is the publishing directory." (unless visiting (kill-buffer init-buf)))))) +(defmacro org-publish-with-aux-preprocess-maybe (&rest body) + "Execute BODY with a modified hook to preprocess for index." + `(let ((org-export-preprocess-after-headline-targets-hook + (if (plist-get project-plist :makeindex) + (cons 'org-publish-aux-preprocess + org-export-preprocess-after-headline-targets-hook) + org-export-preprocess-after-headline-targets-hook))) + ,@body)) + +(defvar project-plist) (defun org-publish-org-to-latex (plist filename pub-dir) "Publish an org file to LaTeX. See `org-publish-org-to' to the list of arguments." - (org-publish-org-to "latex" plist filename pub-dir)) + (org-publish-with-aux-preprocess-maybe + (org-publish-org-to "latex" plist filename pub-dir))) (defun org-publish-org-to-pdf (plist filename pub-dir) "Publish an org file to PDF (via LaTeX). See `org-publish-org-to' to the list of arguments." - (org-publish-org-to "pdf" plist filename pub-dir)) + (org-publish-with-aux-preprocess-maybe + (org-publish-org-to "pdf" plist filename pub-dir))) (defun org-publish-org-to-html (plist filename pub-dir) "Publish an org file to HTML. See `org-publish-org-to' to the list of arguments." - (org-publish-org-to "html" plist filename pub-dir)) + (org-publish-with-aux-preprocess-maybe + (org-publish-org-to "html" plist filename pub-dir))) (defun org-publish-org-to-org (plist filename pub-dir) "Publish an org file to HTML. See `org-publish-org-to' to the list of arguments." (org-publish-org-to "org" plist filename pub-dir)) +(defun org-publish-org-to-ascii (plist filename pub-dir) + "Publish an org file to ASCII. +See `org-publish-org-to' to the list of arguments." + (org-publish-with-aux-preprocess-maybe + (org-publish-org-to "ascii" plist filename pub-dir))) + +(defun org-publish-org-to-latin1 (plist filename pub-dir) + "Publish an org file to Latin-1. +See `org-publish-org-to' to the list of arguments." + (org-publish-with-aux-preprocess-maybe + (org-publish-org-to "latin1" plist filename pub-dir))) + +(defun org-publish-org-to-utf8 (plist filename pub-dir) + "Publish an org file to UTF-8. +See `org-publish-org-to' to the list of arguments." + (org-publish-with-aux-preprocess-maybe + (org-publish-org-to "utf8" plist filename pub-dir))) + (defun org-publish-attachment (plist filename pub-dir) "Publish a file with no transformation of any kind. See `org-publish-org-to' to the list of arguments." ;; make sure eshell/cp code is loaded - (unless (file-directory-p pub-dir) - (make-directory pub-dir t)) - (or (equal (expand-file-name (file-name-directory filename)) - (file-name-as-directory (expand-file-name pub-dir))) + (unless (file-directory-p pub-dir) + (make-directory pub-dir t)) + (or (equal (expand-file-name (file-name-directory filename)) + (file-name-as-directory (expand-file-name pub-dir))) (copy-file filename (expand-file-name (file-name-nondirectory filename) pub-dir) t))) @@ -474,30 +609,39 @@ See `org-publish-org-to' to the list of arguments." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Publishing files, sets of files, and indices -(defun org-publish-file (filename &optional project) - "Publish file FILENAME from PROJECT." +(defun org-publish-file (filename &optional project no-cache) + "Publish file FILENAME from PROJECT. +If NO-CACHE is not nil, do not initialize org-publish-cache and +write it to disk. This is needed, since this function is used to +publish single files, when entire projects are published. +See `org-publish-projects'." (let* ((project (or project (or (org-publish-get-project-from-filename filename) - (if (y-or-n-p - (format "%s is not in a project. Re-read the list of projects files? " - (abbreviate-file-name filename))) - ;; If requested, re-initialize the list of projects files - (progn (org-publish-initialize-files-alist t) - (or (org-publish-get-project-from-filename filename) - (error "File %s not part of any known project" - (abbreviate-file-name filename)))) - (error "Can't publish file outside of a project"))))) + (error "File %s not part of any known project" + (abbreviate-file-name filename))))) (project-plist (cdr project)) - (ftname (file-truename filename)) + (ftname (expand-file-name filename)) (publishing-function (or (plist-get project-plist :publishing-function) 'org-publish-org-to-html)) - (base-dir (file-name-as-directory - (file-truename (plist-get project-plist :base-directory)))) - (pub-dir (file-name-as-directory - (file-truename (plist-get project-plist :publishing-directory)))) + (base-dir + (file-name-as-directory + (expand-file-name + (or (plist-get project-plist :base-directory) + (error "Project %s does not have :base-directory defined" + (car project)))))) + (pub-dir + (file-name-as-directory + (file-truename + (or (plist-get project-plist :publishing-directory) + (error "Project %s does not have :publishing-directory defined" + (car project)))))) tmp-pub-dir) + + (unless no-cache + (org-publish-initialize-cache (car project))) + (setq tmp-pub-dir (file-name-directory (concat pub-dir @@ -514,35 +658,47 @@ See `org-publish-org-to' to the list of arguments." tmp-pub-dir) (funcall publishing-function project-plist filename tmp-pub-dir) (org-publish-update-timestamp - filename pub-dir publishing-function))))) + filename pub-dir publishing-function))) + (unless no-cache (org-publish-write-cache-file)))) (defun org-publish-projects (projects) "Publish all files belonging to the PROJECTS alist. -If :auto-index is set, publish the index too." +If :auto-sitemap is set, publish the sitemap too. +If :makeindex is set, also produce a file theindex.org." (mapc (lambda (project) + ;; Each project uses it's own cache file: + (org-publish-initialize-cache (car project)) (let* ((project-plist (cdr project)) (exclude-regexp (plist-get project-plist :exclude)) - (index-p (plist-get project-plist :auto-index)) - (index-filename (or (plist-get project-plist :index-filename) - "sitemap.org")) - (index-function (or (plist-get project-plist :index-function) - 'org-publish-org-index)) + (sitemap-p (plist-get project-plist :auto-sitemap)) + (sitemap-filename (or (plist-get project-plist :sitemap-filename) + "sitemap.org")) + (sitemap-function (or (plist-get project-plist :sitemap-function) + 'org-publish-org-sitemap)) (preparation-function (plist-get project-plist :preparation-function)) (completion-function (plist-get project-plist :completion-function)) (files (org-publish-get-base-files project exclude-regexp)) file) - (when preparation-function (funcall preparation-function)) - (if index-p (funcall index-function project index-filename)) + (when preparation-function (run-hooks 'preparation-function)) + (if sitemap-p (funcall sitemap-function project sitemap-filename)) (while (setq file (pop files)) - (org-publish-file file project)) - (when completion-function (funcall completion-function)))) + (org-publish-file file project t)) + (when (plist-get project-plist :makeindex) + (org-publish-index-generate-theindex.inc + (plist-get project-plist :base-directory)) + (org-publish-file (expand-file-name + "theindex.org" + (plist-get project-plist :base-directory)) + project t)) + (when completion-function (run-hooks 'completion-function)) + (org-publish-write-cache-file))) (org-publish-expand-projects projects))) -(defun org-publish-org-index (project &optional index-filename) - "Create an index of pages in set defined by PROJECT. -Optionally set the filename of the index with INDEX-FILENAME. -Default for INDEX-FILENAME is 'sitemap.org'." +(defun org-publish-org-sitemap (project &optional sitemap-filename) + "Create a sitemap of pages in set defined by PROJECT. +Optionally set the filename of the sitemap with SITEMAP-FILENAME. +Default for SITEMAP-FILENAME is 'sitemap.org'." (let* ((project-plist (cdr project)) (dir (file-name-as-directory (plist-get project-plist :base-directory))) @@ -550,28 +706,28 @@ Default for INDEX-FILENAME is 'sitemap.org'." (indent-str (make-string 2 ?\ )) (exclude-regexp (plist-get project-plist :exclude)) (files (nreverse (org-publish-get-base-files project exclude-regexp))) - (index-filename (concat dir (or index-filename "sitemap.org"))) - (index-title (or (plist-get project-plist :index-title) - (concat "Index for project " (car project)))) - (index-style (or (plist-get project-plist :index-style) + (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) + (sitemap-title (or (plist-get project-plist :sitemap-title) + (concat "Sitemap for project " (car project)))) + (sitemap-style (or (plist-get project-plist :sitemap-style) 'tree)) - (visiting (find-buffer-visiting index-filename)) - (ifn (file-name-nondirectory index-filename)) - file index-buffer) - (with-current-buffer (setq index-buffer - (or visiting (find-file index-filename))) + (visiting (find-buffer-visiting sitemap-filename)) + (ifn (file-name-nondirectory sitemap-filename)) + file sitemap-buffer) + (with-current-buffer (setq sitemap-buffer + (or visiting (find-file sitemap-filename))) (erase-buffer) - (insert (concat "#+TITLE: " index-title "\n\n")) + (insert (concat "#+TITLE: " sitemap-title "\n\n")) (while (setq file (pop files)) (let ((fn (file-name-nondirectory file)) (link (file-relative-name file dir)) (oldlocal localdir)) - ;; index shouldn't index itself - (unless (equal (file-truename index-filename) + ;; sitemap shouldn't list itself + (unless (equal (file-truename sitemap-filename) (file-truename file)) - (if (eq index-style 'list) - (message "Generating list-style index for %s" index-title) - (message "Generating tree-style index for %s" index-title) + (if (eq sitemap-style 'list) + (message "Generating list-style sitemap for %s" sitemap-title) + (message "Generating tree-style sitemap for %s" sitemap-title) (setq localdir (concat (file-name-as-directory dir) (file-name-directory link))) (unless (string= localdir oldlocal) @@ -600,11 +756,13 @@ Default for INDEX-FILENAME is 'sitemap.org'." (org-publish-find-title file) "]]\n"))))) (save-buffer)) - (or visiting (kill-buffer index-buffer)))) + (or visiting (kill-buffer sitemap-buffer)))) (defun org-publish-find-title (file) - "Find the title of file in project." - (let* ((visiting (find-buffer-visiting file)) + "Find the title of FILE in project." + (or + (org-publish-cache-get-file-property file :title nil t) + (let* ((visiting (find-buffer-visiting file)) (buffer (or visiting (find-file-noselect file))) title) (with-current-buffer buffer @@ -618,7 +776,8 @@ Default for INDEX-FILENAME is 'sitemap.org'." (file-name-nondirectory (file-name-sans-extension file)))))) (unless visiting (kill-buffer buffer)) - title)) + (org-publish-cache-set-file-property file :title title) + title))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Interactive publishing functions @@ -640,7 +799,12 @@ Default for INDEX-FILENAME is 'sitemap.org'." (save-window-excursion (let* ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects (list project))))) + (org-publish-projects + (if (stringp project) + ;; If this function is called in batch mode, + ;; project is still a string here. + (list (assoc project org-publish-project-alist)) + (list project)))))) ;;;###autoload (defun org-publish-all (&optional force) @@ -650,18 +814,17 @@ directory and force publishing all files." (interactive "P") (when force (org-publish-remove-all-timestamps)) - (org-publish-initialize-files-alist) (save-window-excursion (let ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) (org-publish-projects org-publish-project-alist)))) + ;;;###autoload (defun org-publish-current-file (&optional force) "Publish the current file. With prefix argument, force publish the file." (interactive "P") - (org-publish-initialize-files-alist) (save-window-excursion (let ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) @@ -673,17 +836,245 @@ With prefix argument, force publish the file." With a prefix argument, force publishing of all files in the project." (interactive "P") - (org-publish-initialize-files-alist) (save-window-excursion (let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up)) (org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) (if (not project) (error "File %s is not part of any known project" (buffer-file-name))) + ;; FIXME: force is not used here? (org-publish project)))) -(provide 'org-publish) +;;; Index generation + +(defvar backend) ; dynamically scoped +(defun org-publish-aux-preprocess () + "Find index entries and write them to an .orgx file." + (let ((case-fold-search t) + entry index target) + (goto-char (point-min)) + (while + (and + (re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t) + (> (match-end 1) (match-beginning 1))) + (setq entry (match-string 1)) + (when (eq backend 'latex) + (replace-match (format "\\index{%s}" entry) t t)) + (save-excursion + (ignore-errors (org-back-to-heading t)) + (setq target (get-text-property (point) 'target)) + (setq target (or (cdr (assoc target org-export-preferred-target-alist)) + (cdr (assoc target org-export-id-target-alist)) + target "")) + (push (cons entry target) index))) + (with-temp-file + (concat (file-name-sans-extension org-current-export-file) ".orgx") + (dolist (entry (nreverse index)) + (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry))))))) + +(defun org-publish-index-generate-theindex.inc (directory) + "Generate the index from all .orgx files in the current directory and below." + (require 'find-lisp) + (let* ((fulldir (file-name-as-directory + (expand-file-name directory))) + (full-files (find-lisp-find-files directory "\\.orgx\\'")) + (re (concat "\\`" fulldir)) + (files (mapcar (lambda (f) (if (string-match re f) + (substring f (match-end 0)) + f)) + full-files)) + (default-directory directory) + index origfile buf target entry ibuffer + main last-main letter last-letter file sub link tgext) + ;; `files' contains the list of relative file names + (dolist (file files) + (setq origfile (substring file 0 -1)) + (setq buf (find-file-noselect file)) + (with-current-buffer buf + (goto-char (point-min)) + (while (re-search-forward "^INDEX: (\\(.*?\\)) \\(.*\\)" nil t) + (setq target (match-string 1) + entry (match-string 2)) + (push (list entry origfile target) index))) + (kill-buffer buf)) + (setq index (sort index (lambda (a b) (string< (downcase (car a)) + (downcase (car b)))))) + (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory))) + (with-current-buffer ibuffer + (erase-buffer) + (insert "* Index\n") + (setq last-letter nil) + (dolist (idx index) + (setq entry (car idx) file (nth 1 idx) target (nth 2 idx)) + (if (and (stringp target) (string-match "\\S-" target)) + (setq tgext (concat "::#" target)) + (setq tgext "")) + (setq letter (upcase (substring entry 0 1))) + (when (not (equal letter last-letter)) + (insert "** " letter "\n") + (setq last-letter letter)) + (if (string-match "!" entry) + (setq main (substring entry 0 (match-beginning 0)) + sub (substring entry (match-end 0))) + (setq main nil sub nil last-main nil)) + (when (and main (not (equal main last-main))) + (insert " - " main "\n") + (setq last-main main)) + (setq link (concat "[[file:" file tgext "]" + "[" (or sub entry) "]]")) + (if (and main sub) + (insert " - " link "\n") + (insert " - " link "\n"))) + (save-buffer)) + (kill-buffer ibuffer) + + (let ((index-file (expand-file-name "theindex.org" directory))) + (unless (file-exists-p index-file) + (setq ibuffer (find-file-noselect index-file)) + (with-current-buffer ibuffer + (erase-buffer) + (insert "\n\n#+include: \"theindex.inc\"\n\n") + (save-buffer)) + (kill-buffer ibuffer))))) + + +;; Caching functions: + +(defun org-publish-write-cache-file (&optional free-cache) + "Write `org-publish-cache' to file. +If FREE-CACHE, empty the cache." + (unless org-publish-cache + (error "%s" "`org-publish-write-cache-file' called, but no cache present")) + + (let ((cache-file (org-publish-cache-get ":cache-file:"))) + (unless cache-file + (error + "%s" "Cannot find cache-file name in `org-publish-write-cache-file'")) + (with-temp-file cache-file + (let ((print-level nil) + (print-length nil)) + (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") + (maphash (lambda (k v) + (insert + (format (concat "(puthash %S " + (if (or (listp v) (symbolp v)) + "'" "") + "%S org-publish-cache)\n") k v))) + org-publish-cache))) + (when free-cache (org-publish-reset-cache)))) + +(defun org-publish-initialize-cache (project-name) + "Initialize the projects cache if not initialized yet and return it." + + (unless project-name + (error "%s%s" "Cannot initialize `org-publish-cache' without projects name" + " in `org-publish-initialize-cache'")) + + (unless (file-exists-p org-publish-timestamp-directory) + (make-directory org-publish-timestamp-directory t)) + (if (not (file-directory-p org-publish-timestamp-directory)) + (error "Org publish timestamp: %s is not a directory" + org-publish-timestamp-directory)) + + (unless (and org-publish-cache + (string= (org-publish-cache-get ":project:") project-name)) + (let* ((cache-file (concat + (expand-file-name org-publish-timestamp-directory) + project-name + ".cache")) + (cexists (file-exists-p cache-file))) + + (when org-publish-cache + (org-publish-reset-cache)) + + (if cexists + (load-file cache-file) + (setq org-publish-cache + (make-hash-table :test 'equal :weakness nil :size 100)) + (org-publish-cache-set ":project:" project-name) + (org-publish-cache-set ":cache-file:" cache-file)) + (unless cexists (org-publish-write-cache-file nil)))) + org-publish-cache) + +(defun org-publish-reset-cache () + "Empty org-publish-cache and reset it nil." + (message "%s" "Resetting org-publish-cache") + (if (hash-table-p org-publish-cache) + (clrhash org-publish-cache)) + (setq org-publish-cache nil)) + +(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func) + "Check the timestamp of the last publishing of FILENAME. +Return `t', if the file needs publishing" + (unless org-publish-cache + (error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present")) + (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) + (pstamp (org-publish-cache-get key))) + (if (null pstamp) + t + (let ((ctime (org-publish-cache-ctime-of-src filename))) + (< pstamp ctime))))) + +(defun org-publish-cache-set-file-property (filename property value &optional project-name) + "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. +Use cache file of PROJECT-NAME. If the entry does not exist, it will be +created. Return VALUE." + ;; Evtl. load the requested cache file: + (if project-name (org-publish-initialize-cache project-name)) + (let ((pl (org-publish-cache-get filename))) + (if pl + (progn + (plist-put pl property value) + value) + (org-publish-cache-get-file-property + filename property value nil project-name)))) + +(defun org-publish-cache-get-file-property + (filename property &optional default no-create project-name) + "Return the value for a PROPERTY of file FILENAME in publishing cache. +Use cache file of PROJECT-NAME. Return the value of that PROPERTY or +DEFAULT, if the value does not yet exist. +If the entry will be created, unless NO-CREATE is not nil." + ;; Evtl. load the requested cache file: + (if project-name (org-publish-initialize-cache project-name)) + (let ((pl (org-publish-cache-get filename)) + (retval nil)) + (if pl + (if (plist-member pl property) + (setq retval (plist-get pl property)) + (setq retval default)) + ;; no pl yet: + (unless no-create + (org-publish-cache-set filename (list property default))) + (setq retval default)) + retval)) + +(defun org-publish-cache-get (key) + "Return the value stored in `org-publish-cache' for key KEY. +Returns nil, if no value or nil is found, or the cache does not +exist." + (unless org-publish-cache + (error "%s" "`org-publish-cache-get' called, but no cache present")) + (gethash key org-publish-cache)) + +(defun org-publish-cache-set (key value) + "Store KEY VALUE pair in `org-publish-cache'. +Returns value on success, else nil." + (unless org-publish-cache + (error "%s" "`org-publish-cache-set' called, but no cache present")) + (puthash key value org-publish-cache)) + +(defun org-publish-cache-ctime-of-src (filename) + "Get the files ctime as integer." + (let ((src-attr (file-attributes filename))) + (+ + (lsh (car (nth 5 src-attr)) 16) + (cadr (nth 5 src-attr))))) + + + +(provide 'org-publish) ;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index fcf5a8a3887..20227d42d66 100644 --- a/lisp/org/org-remember.el +++ b/lisp/org/org-remember.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -54,14 +54,15 @@ :group 'org) (defcustom org-remember-store-without-prompt t - "Non-nil means, `C-c C-c' stores remember note without further prompts. + "Non-nil means \\<org-remember-mode-map>\\[org-remember-finalize] \ +stores the remember note without further prompts. It then uses the file and headline specified by the template or (if the template does not specify them) by the variables `org-default-notes-file' and `org-remember-default-headline'. To force prompting anyway, use -`C-u C-c C-c' to file the note. +\\[universal-argument] \\[org-remember-finalize] to file the note. -When this variable is nil, `C-c C-c' gives you the prompts, and -`C-u C-c C-c' triggers the fasttrack." +When this variable is nil, \\[org-remember-finalize] gives you the prompts, and +\\[universal-argument] \\[org-remember-finalize] triggers the fasttrack." :group 'org-remember :type 'boolean) @@ -94,10 +95,10 @@ You can set this on a per-template basis with the variable (defcustom org-remember-templates nil "Templates for the creation of remember buffers. When nil, just let remember make the buffer. -When non-nil, this is a list of 5-element lists. In each entry, the first -element is the name of the template, which should be a single short word. -The second element is a character, a unique key to select this template. -The third element is the template. +When non-nil, this is a list of (up to) 6-element lists. In each entry, +the first element is the name of the template, which should be a single +short word. The second element is a character, a unique key to select +this template. The third element is the template. The fourth element is optional and can specify a destination file for remember items created with this template. The default file is given @@ -114,46 +115,49 @@ An optional sixth element specifies the contexts in which the template will be offered to the user. This element can be a list of major modes or a function, and the template will only be offered if `org-remember' is called from a mode in the list, or if the function returns t. -Templates that specify t or nil for the context will be always be added +Templates that specify t or nil for the context will always be added to the list of selectable templates. The template specifies the structure of the remember buffer. It should have a first line starting with a star, to act as the org-mode headline. Furthermore, the following %-escapes will be replaced with content: - %^{prompt} Prompt the user for a string and replace this sequence with it. - A default value and a completion table ca be specified like this: + %^{PROMPT} prompt the user for a string and replace this sequence with it. + A default value and a completion table can be specified like this: %^{prompt|default|completion2|completion3|...} + The arrow keys access a prompt-specific history. + %a annotation, normally the link created with `org-store-link' + %A like %a, but prompt for the description part + %i initial content, copied from the active region. If %i is + indented, the entire inserted text will be indented as well. %t time stamp, date only %T time stamp with date and time %u, %U like the above, but inactive time stamps %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. - You may define a prompt like %^{Please specify birthday + You may define a prompt like %^{Please specify birthday}t %n user name (taken from `user-full-name') - %a annotation, normally the link created with org-store-link - %i initial content, copied from the active region. If %i is - indented, the entire inserted text will be indented as well. %c current kill ring head %x content of the X clipboard - %^C Interactive selection of which kill or clip to use - %^L Like %^C, but insert as link - %k title of currently clocked task - %K link to currently clocked task - %^g prompt for tags, with completion on tags in target file - %^G prompt for tags, with completion all tags in all agenda files - %^{prop}p Prompt the user for a value for property `prop' %:keyword specific information for certain link types, see below - %[pathname] insert the contents of the file given by `pathname' - %(sexp) evaluate elisp `(sexp)' and replace with the result - %! Store this note immediately after filling the template - %& Visit note immediately after storing it - - %? After completing the template, position cursor here. + %^C interactive selection of which kill or clip to use + %^L like %^C, but insert as link + %k title of the currently clocked task + %K link to the currently clocked task + %^g prompt for tags, completing tags in the target file + %^G prompt for tags, completing all tags in all agenda files + %^{PROP}p Prompt the user for a value for property PROP + %[PATHNAME] insert the contents of the file given by PATHNAME + %(SEXP) evaluate elisp `(SEXP)' and replace with the result + %! store this note immediately after completing the template\ + \\<org-remember-mode-map> + (skipping the \\[org-remember-finalize] that normally triggers storing) + %& jump to target location immediately after storing note + %? after completing the template, position cursor here. Apart from these general escapes, you can access information specific to the link type that is created. For example, calling `remember' in emails or gnus will record the author and the subject of the message, which you can access -with %:author and %:subject, respectively. Here is a complete list of what +with %:fromname and %:subject, respectively. Here is a complete list of what is recorded for each link type. Link type | Available information @@ -163,7 +167,8 @@ vm, wl, mh, rmail | %:type %:subject %:message-id | %:from %:fromname %:fromaddress | %:to %:toname %:toaddress | %:fromto (either \"to NAME\" or \"from NAME\") -gnus | %:group, for messages also all email fields +gnus | %:group, for messages also all email fields and + | %:org-date (the Date: header in Org format) w3, w3m | %:type %:url info | %:type %:file %:node calendar | %:type %:date" @@ -211,7 +216,7 @@ The remember buffer is still current when this hook runs." :type 'hook) (defvar org-remember-mode-map (make-sparse-keymap) - "Keymap for org-remember-mode, a minor mode. + "Keymap for `org-remember-mode', a minor mode. Use this map to set additional keybindings for when Org-mode is used for a Remember buffer.") (defvar org-remember-mode-hook nil @@ -219,17 +224,16 @@ for a Remember buffer.") (define-minor-mode org-remember-mode "Minor mode for special key bindings in a remember buffer." - nil " Rem" org-remember-mode-map - (run-hooks 'org-remember-mode-hook)) + nil " Rem" org-remember-mode-map) (define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize) (define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill) (defcustom org-remember-clock-out-on-exit 'query - "Non-nil means, stop the clock when exiting a clocking remember buffer. + "Non-nil means stop the clock when exiting a clocking remember buffer. This only applies if the clock is running in the remember buffer. If the clock is not stopped, it continues to run in the storage location. Instead of nil or t, this may also be the symbol `query' to prompt the -user each time a remember buffer with a running clock is filed away. " +user each time a remember buffer with a running clock is filed away." :group 'org-remember :type '(choice (const :tag "Never" nil) @@ -248,7 +252,7 @@ See also `org-remember-auto-remove-backup-files'." (directory :tag "Directory"))) (defcustom org-remember-auto-remove-backup-files t - "Non-nil means, remove remember backup files after successfully storage. + "Non-nil means remove remember backup files after successfully storage. When remember is finished successfully, with storing the note at the desired target, remove the backup files related to this remember process and show a message about remaining backup files, from previous, unfinished @@ -265,7 +269,7 @@ Set this to nil if you find that you don't need the warning. If you cancel remember calls frequently and know when they contain useful information (because you know that you made an -error or emacs crashed, for example) nil is more useful. In the +error or Emacs crashed, for example) nil is more useful. In the opposite case, the default, t, is more useful." :group 'org-remember :type 'boolean) @@ -351,7 +355,7 @@ RET at beg-of-buf -> Append to file as level 2 headline org-force-remember-template-char)) (t (setq msg (format - "Select template: %s" + "Select template: %s%s" (mapconcat (lambda (x) (cond @@ -362,13 +366,17 @@ RET at beg-of-buf -> Append to file as level 2 headline (format "[%c]%s" (car x) (substring (nth 1 x) 1))) (t (format "[%c]%s" (car x) (nth 1 x))))) - templates " "))) + templates " ") + (if (assoc ?C templates) + "" + " [C]customize templates"))) (let ((inhibit-quit t) char0) (while (not char0) (message msg) (setq char0 (read-char-exclusive)) (when (and (not (assoc char0 templates)) - (not (equal char0 ?\C-g))) + (not (equal char0 ?\C-g)) + (not (equal char0 ?C))) (message "No such template \"%c\"" char0) (ding) (sit-for 1) (setq char0 nil))) @@ -376,15 +384,14 @@ RET at beg-of-buf -> Append to file as level 2 headline (jump-to-register remember-register) (kill-buffer remember-buffer) (error "Abort")) + (when (not (assoc char0 templates)) + (jump-to-register remember-register) + (kill-buffer remember-buffer) + (customize-variable 'org-remember-templates) + (error "Customize templates")) char0)))))) (cddr (assoc char templates))))) -(defun org-get-x-clipboard (value) - "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21." - (if (eq window-system 'x) - (let ((x (org-get-x-clipboard-compat value))) - (if x (org-no-properties x))))) - ;;;###autoload (defun org-remember-apply-template (&optional use-char skip-interactive) "Initialize *remember* buffer with template, invoke `org-mode'. @@ -470,7 +477,7 @@ to be run from that hook to function properly." ## C-u C-c C-c like C-c C-c, and immediately visit note at target location ## C-0 C-c C-c \"%s\" -> \"* %s\" ## %s to select file and header location interactively. -## C-2 C-c C-c as child of the currently clocked item +## C-2 C-c C-c as child (C-3: as sibling) of the currently clocked item ## To switch templates, use `\\[org-remember]'. To abort use `C-c C-k'.\n\n" (if org-remember-store-without-prompt " C-c C-c" " C-1 C-c C-c") (abbreviate-file-name (or file org-default-notes-file)) @@ -479,9 +486,22 @@ to be run from that hook to function properly." (or (cdr org-remember-previous-location) "???") (if org-remember-store-without-prompt "C-1 C-c C-c" " C-c C-c")))) (insert tpl) - (goto-char (point-min)) + ;; %[] Insert contents of a file. + (goto-char (point-min)) + (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) + (unless (org-remember-escaped-%) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (filename (expand-file-name (match-string 1)))) + (goto-char start) + (delete-region start end) + (condition-case error + (insert-file-contents filename) + (error (insert (format "%%![Couldn't insert %s: %s]" + filename error))))))) ;; Simple %-escapes + (goto-char (point-min)) (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) (unless (org-remember-escaped-%) (when (and initial (equal (match-string 0) "%i")) @@ -495,19 +515,6 @@ to be run from that hook to function properly." (or (eval (intern (concat "v-" (match-string 1)))) "") t t))) - ;; %[] Insert contents of a file. - (goto-char (point-min)) - (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) - (unless (org-remember-escaped-%) - (let ((start (match-beginning 0)) - (end (match-end 0)) - (filename (expand-file-name (match-string 1)))) - (goto-char start) - (delete-region start end) - (condition-case error - (insert-file-contents filename) - (error (insert (format "%%![Couldn't insert %s: %s]" - filename error))))))) ;; %() embedded elisp (goto-char (point-min)) (while (re-search-forward "%\\((.+)\\)" nil t) @@ -567,7 +574,7 @@ to be run from that hook to function properly." 'org-tags-completion-function nil nil nil 'org-tags-history))) (setq ins (mapconcat 'identity - (org-split-string ins (org-re "[^[:alnum:]_@]+")) + (org-split-string ins (org-re "[^[:alnum:]_@#%]+")) ":")) (when (string-match "\\S-" ins) (or (equal (char-before) ?:) (insert ":")) @@ -718,9 +725,11 @@ from that hook." If there is an active region, make sure remember uses it as initial content of the remember buffer. -When called interactively with a `C-u' prefix argument GOTO, don't remember +When called interactively with a \\[universal-argument] \ +prefix argument GOTO, don't remember anything, just go to the file/headline where the selected template usually -stores its notes. With a double prefix arg `C-u C-u', go to the last +stores its notes. With a double prefix argument \ +\\[universal-argument] \\[universal-argument], go to the last note stored by remember. Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character @@ -792,21 +801,24 @@ The user is queried for the template." When the template has specified a file and a headline, the entry is filed there, or in the location defined by `org-default-notes-file' and `org-remember-default-headline'. - +\\<org-remember-mode-map> If no defaults have been defined, or if the current prefix argument -is 1 (so you must use `C-1 C-c C-c' to exit remember), an interactive +is 1 (using C-1 \\[org-remember-finalize] to exit remember), an interactive process is used to select the target location. -When the prefix is 0 (i.e. when remember is exited with `C-0 C-c C-c'), +When the prefix is 0 (i.e. when remember is exited with \ +C-0 \\[org-remember-finalize]), the entry is filed to the same location as the previous note. -When the prefix is 2 (i.e. when remember is exited with `C-2 C-c C-c'), +When the prefix is 2 (i.e. when remember is exited with \ +C-2 \\[org-remember-finalize]), the entry is filed as a subentry of the entry where the clock is currently running. -When `C-u' has been used as prefix argument, the note is stored and emacs -moves point to the new location of the note, so that editing can be -continued there (similar to inserting \"%&\" into the template). +When \\[universal-argument] has been used as prefix argument, the +note is stored and Emacs moves point to the new location of the +note, so that editing can be continued there (similar to +inserting \"%&\" into the template). Before storing the note, the function ensures that the text has an org-mode-style headline, i.e. a first line that starts with @@ -860,6 +872,7 @@ See also the variable `org-reverse-note-order'." (previousp (and (member current-prefix-arg '((16) 0)) org-remember-previous-location)) (clockp (equal current-prefix-arg 2)) + (clocksp (equal current-prefix-arg 3)) (fastp (org-xor (equal current-prefix-arg 1) org-remember-store-without-prompt)) (file (cond @@ -882,7 +895,7 @@ See also the variable `org-reverse-note-order'." visiting (and file (org-find-base-buffer-visiting file)) heading (cdr org-remember-previous-location) fastp t)) - (when clockp + (when (or clockp clocksp) (setq file (buffer-file-name (marker-buffer org-clock-marker)) visiting (and file (org-find-base-buffer-visiting file)) heading org-clock-heading-for-remember @@ -1015,7 +1028,9 @@ See also the variable `org-reverse-note-order'." (beginning-of-line 2) (end-of-line 1) (insert "\n")))) - (org-paste-subtree (org-get-valid-level level 1) txt) + (org-paste-subtree (if clocksp + level + (org-get-valid-level level 1)) txt) (and org-auto-align-tags (org-set-tags nil t)) (bookmark-set "org-remember-last-stored") (move-marker org-remember-last-stored-marker (point))) diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index 86173b040c5..c3b7d4532c5 100644 --- a/lisp/org/org-rmail.el +++ b/lisp/org/org-rmail.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -59,10 +59,20 @@ (from (mail-fetch-field "from")) (to (mail-fetch-field "to")) (subject (mail-fetch-field "subject")) + (date (mail-fetch-field "date")) + (date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) desc link) (org-store-link-props :type "rmail" :from from :to to :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (setq message-id (org-remove-angle-brackets message-id)) (setq desc (org-email-link-description)) (setq link (org-make-link "rmail:" folder "#" message-id)) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 9001a8542d4..16760461e87 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -8,7 +8,7 @@ ;; Dan Davison <davison at stats dot ox dot ac dot uk> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -34,10 +34,13 @@ (require 'org-macs) (require 'org-compat) +(require 'ob-keys) +(require 'ob-comint) (eval-when-compile (require 'cl)) (declare-function org-do-remove-indentation "org" (&optional n)) +(declare-function org-at-table.el-p "org" ()) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-switch-to-buffer-other-window "org" (&rest args)) @@ -62,7 +65,7 @@ there are kept outside the narrowed region." "The default coderef format. This format string will be used to search for coderef labels in literal examples (EXAMPLE and SRC blocks). The format can be overwritten in -an individual literal example with the -f option, like +an individual literal example with the -l option, like #+BEGIN_SRC pascal +n -r -l \"((%s))\" ... @@ -86,10 +89,11 @@ These are the regions where each line starts with a colon." (function :tag "Other (specify)"))) (defcustom org-src-preserve-indentation nil - "If non-nil, leading whitespace characters in source code -blocks are preserved on export, and when switching between the -org buffer and the language mode edit buffer. If this variable -is nil then, after editing with \\[org-edit-src-code], the + "If non-nil preserve leading whitespace characters on export. +If non-nil leading whitespace characters in source code blocks +are preserved on export, and when switching between the org +buffer and the language mode edit buffer. If this variable is nil +then, after editing with \\[org-edit-src-code], the minimum (across-lines) number of leading whitespace characters are removed from all lines, and the code block is uniformly indented according to the value of `org-edit-src-content-indentation'." @@ -100,11 +104,15 @@ indented according to the value of `org-edit-src-content-indentation'." "Indentation for the content of a source code block. This should be the number of spaces added to the indentation of the #+begin line in order to compute the indentation of the block content after -editing it with \\[org-edit-src-code]. Has no effect if +editing it with \\[org-edit-src-code]. Has no effect if `org-src-preserve-indentation' is non-nil." :group 'org-edit-structure :type 'integer) +(defvar org-src-strip-leading-and-trailing-blank-lines nil + "If non-nil, blank lines are removed when exiting the code edit +buffer.") + (defcustom org-edit-src-persistent-message t "Non-nil means show persistent exit help message while editing src examples. The message is shown in the header-line, which will be created in the @@ -113,7 +121,6 @@ When nil, the message will only be shown intermittently in the echo area." :group 'org-edit-structure :type 'boolean) - (defcustom org-src-window-setup 'reorganize-frame "How the source code edit buffer should be displayed. Possible values for this option are: @@ -146,7 +153,8 @@ but which mess up the display of a snippet in Org exported files.") (defcustom org-src-lang-modes '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) - ("asymptote" . asy) ("dot" . fundamental)) + ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql) + ("calc" . fundamental)) "Alist mapping languages to their major mode. The key is the language name, the value is the string that should be inserted as the name of the major mode. For many languages this is @@ -164,8 +172,10 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-src-mode-map (make-sparse-keymap)) (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) + (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) +(defvar org-edit-src-allow-write-back-p t) (defvar org-edit-src-picture nil) (defvar org-edit-src-beg-marker nil) (defvar org-edit-src-end-marker nil) @@ -179,6 +189,8 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is immediately; otherwise it will ask whether you want to return to the existing edit buffer.") +(defvar org-src-babel-info nil) + (define-minor-mode org-src-mode "Minor mode for language major mode buffers generated by org. This minor mode is turned on in two situations: @@ -187,32 +199,39 @@ This minor mode is turned on in two situations: There is a mode hook, and keybindings for `org-edit-src-exit' and `org-edit-src-save'") -(defun org-edit-src-code (&optional context) +(defun org-edit-src-code (&optional context code edit-buffer-name quietp) "Edit the source code example at point. -The example is copied to a separate buffer, and that buffer is switched -to the correct language mode. When done, exit with \\[org-edit-src-exit]. -This will remove the original code in the Org buffer, and replace it with -the edited version. Optional argument CONTEXT is used by -\\[org-edit-src-save] when calling this function." +The example is copied to a separate buffer, and that buffer is +switched to the correct language mode. When done, exit with +\\[org-edit-src-exit]. This will remove the original code in the +Org buffer, and replace it with the edited version. Optional +argument CONTEXT is used by \\[org-edit-src-save] when calling +this function. See \\[org-src-window-setup] to configure the +display of windows containing the Org buffer and the code +buffer." (interactive) (unless (eq context 'save) (setq org-edit-src-saved-temp-window-config (current-window-configuration))) - (let ((line (org-current-line)) - (col (current-column)) + (let ((mark (and (org-region-active-p) (mark))) (case-fold-search t) - (msg (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote)")) (info (org-edit-src-find-region-and-lang)) + (babel-info (org-babel-get-src-block-info 'light)) (org-mode-p (eq major-mode 'org-mode)) (beg (make-marker)) (end (make-marker)) (preserve-indentation org-src-preserve-indentation) - block-nindent total-nindent ovl lang lang-f single lfmt code begline buffer) + (allow-write-back-p (null code)) + block-nindent total-nindent ovl lang lang-f single lfmt buffer msg + begline markline markcol line col) (if (not info) nil (setq beg (move-marker beg (nth 0 info)) end (move-marker end (nth 1 info)) - code (buffer-substring-no-properties beg end) + msg (if allow-write-back-p + (substitute-command-keys + "Edit, then exit with C-c ' (C-c and single quote)") + "Exit with C-c ' (C-c and single quote)") + code (or code (buffer-substring-no-properties beg end)) lang (or (cdr (assoc (nth 2 info) org-src-lang-modes)) (nth 2 info)) lang (if (symbolp lang) (symbol-name lang) lang) @@ -221,9 +240,23 @@ the edited version. Optional argument CONTEXT is used by block-nindent (nth 5 info) lang-f (intern (concat lang "-mode")) begline (save-excursion (goto-char beg) (org-current-line))) + (if (and mark (>= mark beg) (<= mark (1+ end))) + (save-excursion (goto-char (min mark end)) + (setq markline (org-current-line) + markcol (current-column)))) + (if (equal lang-f 'table.el-mode) + (setq lang-f (lambda () + (text-mode) + (if (org-bound-and-true-p flyspell-mode) + (flyspell-mode -1)) + (table-recognize) + (org-set-local 'org-edit-src-content-indentation 0)))) (unless (functionp lang-f) (error "No such language mode: %s" lang-f)) - (org-goto-line line) + (save-excursion + (if (> (point) end) (goto-char end)) + (setq line (org-current-line) + col (current-column))) (if (and (setq buffer (org-edit-src-find-buffer beg end)) (if org-src-ask-before-returning-to-edit-buffer (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ") t)) @@ -231,20 +264,21 @@ the edited version. Optional argument CONTEXT is used by (when buffer (with-current-buffer buffer (if (boundp 'org-edit-src-overlay) - (org-delete-overlay org-edit-src-overlay))) + (delete-overlay org-edit-src-overlay))) (kill-buffer buffer)) (setq buffer (generate-new-buffer - (org-src-construct-edit-buffer-name (buffer-name) lang))) - (setq ovl (org-make-overlay beg end)) - (org-overlay-put ovl 'edit-buffer buffer) - (org-overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") - (org-overlay-put ovl 'face 'secondary-selection) - (org-overlay-put ovl - 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'org-edit-src-continue) - map)) - (org-overlay-put ovl :read-only "Leave me alone") + (or edit-buffer-name + (org-src-construct-edit-buffer-name (buffer-name) lang)))) + (setq ovl (make-overlay beg end)) + (overlay-put ovl 'edit-buffer buffer) + (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl + 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'org-edit-src-continue) + map)) + (overlay-put ovl :read-only "Leave me alone") (org-src-switch-to-buffer buffer 'edit) (if (eq single 'macro-definition) (setq code (replace-regexp-in-string "\\\\n" "\n" code t t))) @@ -254,10 +288,16 @@ the edited version. Optional argument CONTEXT is used by (unless preserve-indentation (setq total-nindent (or (org-do-remove-indentation) 0))) (let ((org-inhibit-startup t)) - (funcall lang-f)) + (condition-case e + (funcall lang-f) + (error + (error "Language mode `%s' fails with: %S" lang-f (nth 1 e))))) (set (make-local-variable 'org-edit-src-force-single-line) single) (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) + (set (make-local-variable 'org-edit-src-allow-write-back-p) allow-write-back-p) (set (make-local-variable 'org-src-preserve-indentation) preserve-indentation) + (when babel-info + (set (make-local-variable 'org-src-babel-info) babel-info)) (when lfmt (set (make-local-variable 'org-coderef-label-format) lfmt)) (when org-mode-p @@ -265,6 +305,12 @@ the edited version. Optional argument CONTEXT is used by (while (re-search-forward "^," nil t) (if (eq (org-current-line) line) (setq total-nindent (1+ total-nindent))) (replace-match ""))) + (when markline + (org-goto-line (1+ (- markline begline))) + (org-move-to-column + (if preserve-indentation markcol (max 0 (- markcol total-nindent)))) + (push-mark (point) 'no-message t) + (setq deactivate-mark nil)) (org-goto-line (1+ (- line begline))) (org-move-to-column (if preserve-indentation col (max 0 (- col total-nindent)))) @@ -276,7 +322,7 @@ the edited version. Optional argument CONTEXT is used by (set-buffer-modified-p nil) (and org-edit-src-persistent-message (org-set-local 'header-line-format msg))) - (message "%s" msg) + (unless quietp (message "%s" msg)) t))) (defun org-edit-src-continue (e) @@ -307,13 +353,15 @@ the edited version. Optional argument CONTEXT is used by (if (eq context 'edit) (delete-other-windows)) (org-switch-to-buffer-other-window buffer) (if (eq context 'exit) (delete-other-windows))) + ('switch-invisibly + (set-buffer buffer)) (t (message "Invalid value %s for org-src-window-setup" (symbol-name org-src-window-setup)) (switch-to-buffer buffer)))) (defun org-src-construct-edit-buffer-name (org-buffer-name lang) - "Construct the buffer name for a source editing buffer" + "Construct the buffer name for a source editing buffer." (concat "*Org Src " org-buffer-name "[ " lang " ]*")) (defun org-edit-src-find-buffer (beg end) @@ -374,22 +422,22 @@ the fragment in the Org-mode buffer." (when buffer (with-current-buffer buffer (if (boundp 'org-edit-src-overlay) - (org-delete-overlay org-edit-src-overlay))) + (delete-overlay org-edit-src-overlay))) (kill-buffer buffer)) (setq buffer (generate-new-buffer (org-src-construct-edit-buffer-name (buffer-name) "Fixed Width"))) - (setq ovl (org-make-overlay beg end)) - (org-overlay-put ovl 'face 'secondary-selection) - (org-overlay-put ovl 'edit-buffer buffer) - (org-overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") - (org-overlay-put ovl 'face 'secondary-selection) - (org-overlay-put ovl + (setq ovl (make-overlay beg end)) + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl 'edit-buffer buffer) + (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl 'keymap (let ((map (make-sparse-keymap))) (define-key map [mouse-1] 'org-edit-src-continue) map)) - (org-overlay-put ovl :read-only "Leave me alone") + (overlay-put ovl :read-only "Leave me alone") (switch-to-buffer buffer) (insert code) (remove-text-properties (point-min) (point-max) @@ -399,7 +447,7 @@ the fragment in the Org-mode buffer." ((eq org-edit-fixed-width-region-mode 'artist-mode) (fundamental-mode) (artist-mode 1)) - (t (funcall org-edit-fixed-width-region-mode))) + (t (funcall org-edit-fixed-width-region-mode))) (set (make-local-variable 'org-edit-src-force-single-line) nil) (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) (set (make-local-variable 'org-edit-src-picture) t) @@ -482,7 +530,16 @@ the language, a switch telling if the content should be in a single line." (throw 'exit (list (match-end 0) end (org-edit-src-get-lang lang) - single lfmt ind)))))))))))) + single lfmt ind))))))))) + (when (org-at-table.el-p) + (re-search-backward "^[\t]*[^ \t|\\+]" nil t) + (setq beg (1+ (point-at-eol))) + (goto-char beg) + (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t) + (progn (goto-char (point-max)) (newline))) + (setq end (point-at-bol)) + (setq ind (org-edit-src-get-indentation beg)) + (throw 'exit (list beg end 'table.el nil nil ind)))))) (defun org-edit-src-get-lang (lang) "Extract the src language." @@ -505,7 +562,7 @@ the language, a switch telling if the content should be in a single line." (match-string 1 s)))) (defun org-edit-src-get-indentation (pos) - "Count leading whitespace characters on line" + "Count leading whitespace characters on line." (save-match-data (goto-char pos) (org-get-indentation))) @@ -513,8 +570,9 @@ the language, a switch telling if the content should be in a single line." (defun org-edit-src-exit (&optional context) "Exit special edit and protect problematic lines." (interactive) - (unless org-edit-src-from-org-mode - (error "This is not a sub-editing buffer, something is wrong...")) + (unless (org-bound-and-true-p org-edit-src-from-org-mode) + (error "This is not a sub-editing buffer, something is wrong")) + (widen) (let* ((beg org-edit-src-beg-marker) (end org-edit-src-end-marker) (ovl org-edit-src-overlay) @@ -524,59 +582,71 @@ the language, a switch telling if the content should be in a single line." (total-nindent (+ (or org-edit-src-block-indentation 0) org-edit-src-content-indentation)) (preserve-indentation org-src-preserve-indentation) + (allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p)) (delta 0) code line col indent) - (untabify (point-min) (point-max)) - (save-excursion - (goto-char (point-min)) - (if (looking-at "[ \t\n]*\n") (replace-match "")) - (unless macro - (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))) + (when allow-write-back-p + (unless preserve-indentation (untabify (point-min) (point-max))) + (if org-src-strip-leading-and-trailing-blank-lines + (save-excursion + (goto-char (point-min)) + (if (looking-at "[ \t\n]*\n") (replace-match "")) + (unless macro + (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))))) (setq line (if (org-bound-and-true-p org-edit-src-force-single-line) 1 (org-current-line)) col (current-column)) - (when single - (goto-char (point-min)) - (if (re-search-forward "\\s-+\\'" nil t) (replace-match "")) - (goto-char (point-min)) - (let ((cnt 0)) - (while (re-search-forward "\n" nil t) - (setq cnt (1+ cnt)) - (replace-match (if macro "\\n" " ") t t)) - (when (and macro (> cnt 0)) - (goto-char (point-max)) (insert "\\n"))) - (goto-char (point-min)) - (if (looking-at "\\s-*") (replace-match " "))) - (when (org-bound-and-true-p org-edit-src-from-org-mode) - (goto-char (point-min)) - (while (re-search-forward - (if (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t) - (if (eq (org-current-line) line) (setq delta (1+ delta))) - (replace-match ",\\1"))) - (when (org-bound-and-true-p org-edit-src-picture) - (setq preserve-indentation nil) - (untabify (point-min) (point-max)) - (goto-char (point-min)) - (while (re-search-forward "^" nil t) - (replace-match ": "))) - (unless (or single preserve-indentation (= total-nindent 0)) - (setq indent (make-string total-nindent ?\ )) - (goto-char (point-min)) - (while (re-search-forward "^" nil t) - (replace-match indent))) - (if (org-bound-and-true-p org-edit-src-picture) - (setq total-nindent (+ total-nindent 2))) - (setq code (buffer-string)) - (set-buffer-modified-p nil) + (when allow-write-back-p + (when single + (goto-char (point-min)) + (if (re-search-forward "\\s-+\\'" nil t) (replace-match "")) + (goto-char (point-min)) + (let ((cnt 0)) + (while (re-search-forward "\n" nil t) + (setq cnt (1+ cnt)) + (replace-match (if macro "\\n" " ") t t)) + (when (and macro (> cnt 0)) + (goto-char (point-max)) (insert "\\n"))) + (goto-char (point-min)) + (if (looking-at "\\s-*") (replace-match " "))) + (when (org-bound-and-true-p org-edit-src-from-org-mode) + (goto-char (point-min)) + (while (re-search-forward + (if (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t) + (if (eq (org-current-line) line) (setq delta (1+ delta))) + (replace-match ",\\1"))) + (when (org-bound-and-true-p org-edit-src-picture) + (setq preserve-indentation nil) + (untabify (point-min) (point-max)) + (goto-char (point-min)) + (while (re-search-forward "^" nil t) + (replace-match ": "))) + (unless (or single preserve-indentation (= total-nindent 0)) + (setq indent (make-string total-nindent ?\ )) + (goto-char (point-min)) + (while (re-search-forward "^" nil t) + (replace-match indent))) + (if (org-bound-and-true-p org-edit-src-picture) + (setq total-nindent (+ total-nindent 2))) + (setq code (buffer-string)) + (set-buffer-modified-p nil)) (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) (kill-buffer buffer) (goto-char beg) - (delete-region beg end) - (insert code) - (goto-char beg) - (if single (just-one-space)) - (org-goto-line (1- (+ (org-current-line) line))) - (org-move-to-column (if preserve-indentation col (+ col total-nindent delta))) + (when allow-write-back-p + (delete-region beg end) + (insert code) + (goto-char beg) + (if single (just-one-space))) + (if (memq t (mapcar (lambda (overlay) + (eq (overlay-get overlay 'invisible) + 'org-hide-block)) + (overlays-at (point)))) + ;; Block is hidden; put point at start of block + (beginning-of-line 0) + ;; Block is visible, put point where it was in the code buffer + (org-goto-line (1- (+ (org-current-line) line))) + (org-move-to-column (if preserve-indentation col (+ col total-nindent delta)))) (move-marker beg nil) (move-marker end nil)) (unless (eq context 'save) @@ -601,18 +671,140 @@ the language, a switch telling if the content should be in a single line." (message (or msg "")))) (defun org-src-mode-configure-edit-buffer () - (when org-edit-src-from-org-mode - (setq buffer-offer-save t) - (setq buffer-file-name - (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) - "[" (buffer-name) "]")) - (set (if (featurep 'xemacs) 'write-contents-hooks 'write-contents-functions) - '(org-edit-src-save)) + (when (org-bound-and-true-p org-edit-src-from-org-mode) (org-add-hook 'kill-buffer-hook - '(lambda () (org-delete-overlay org-edit-src-overlay)) nil 'local))) + '(lambda () (delete-overlay org-edit-src-overlay)) nil 'local) + (if (org-bound-and-true-p org-edit-src-allow-write-back-p) + (progn + (setq buffer-offer-save t) + (setq buffer-file-name + (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) + "[" (buffer-name) "]")) + (if (featurep 'xemacs) + (progn + (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4 + (setq write-contents-hooks '(org-edit-src-save))) + (setq write-contents-functions '(org-edit-src-save)))) + (setq buffer-read-only t)))) (org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer) + +(defun org-src-associate-babel-session (info) + "Associate edit buffer with comint session." + (interactive) + (let ((session (cdr (assoc :session (nth 2 info))))) + (and session (not (string= session "none")) + (org-babel-comint-buffer-livep session) + ((lambda (f) (and (fboundp f) (funcall f session))) + (intern (format "org-babel-%s-associate-session" (nth 0 info))))))) + +(defun org-src-babel-configure-edit-buffer () + (when org-src-babel-info + (org-src-associate-babel-session org-src-babel-info))) + +(org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer) +(defmacro org-src-do-at-code-block (&rest body) + "Execute a command from an edit buffer in the Org-mode buffer." + `(let ((beg-marker org-edit-src-beg-marker)) + (if beg-marker + (with-current-buffer (marker-buffer beg-marker) + (goto-char (marker-position beg-marker)) + ,@body)))) + +(defun org-src-do-key-sequence-at-code-block (&optional key) + "Execute key sequence at code block in the source Org buffer. +The command bound to KEY in the Org-babel key map is executed +remotely with point temporarily at the start of the code block in +the Org buffer. + +This command is not bound to a key by default, to avoid conflicts +with language major mode bindings. To bind it to C-c @ in all +language major modes, you could use + + (add-hook 'org-src-mode-hook + (lambda () (define-key org-src-mode-map \"\\C-c@\" + 'org-src-do-key-sequence-at-code-block))) + +In that case, for example, C-c @ t issued in code edit buffers +would tangle the current Org code block, C-c @ e would execute +the block and C-c @ h would display the other available +Org-babel commands." + (interactive "kOrg-babel key: ") + (if (equal key (kbd "C-g")) (keyboard-quit) + (org-edit-src-save) + (org-src-do-at-code-block + (call-interactively + (lookup-key org-babel-map key))))) + +(defcustom org-src-tab-acts-natively nil + "If non-nil, the effect of TAB in a code block is as if it were +issued in the language major mode buffer." + :type 'boolean + :group 'org-babel) + +(defun org-src-native-tab-command-maybe () + "Perform language-specific TAB action. +Alter code block according to effect of TAB in the language major +mode." + (and org-src-tab-acts-natively + (let ((org-src-strip-leading-and-trailing-blank-lines nil)) + (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))))) + +(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe) + +(defun org-src-font-lock-fontify-block (lang start end) + "Fontify code block. +This function is called by emacs automatic fontification, as long +as `org-src-fontify-natively' is non-nil. For manual +fontification of code blocks see `org-src-fontify-block' and +`org-src-fontify-buffer'" + (let* ((lang-mode (org-src-get-lang-mode lang)) + (string (buffer-substring-no-properties start end)) + (modified (buffer-modified-p)) + (org-buffer (current-buffer)) pos next) + (remove-text-properties start end '(face nil)) + (with-current-buffer + (get-buffer-create + (concat " org-src-fontification:" (symbol-name lang-mode))) + (delete-region (point-min) (point-max)) + (insert string) + (unless (eq major-mode lang-mode) (funcall lang-mode)) + (font-lock-fontify-buffer) + (setq pos (point-min)) + (while (setq next (next-single-property-change pos 'face)) + (put-text-property + (+ start (1- pos)) (+ start next) 'face + (get-text-property pos 'face) org-buffer) + (setq pos next))) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified)) + t) ;; Tell `org-fontify-meta-lines-and-blocks' that we fontified + +(defun org-src-fontify-block () + "Fontify code block at point." + (interactive) + (save-excursion + (let ((org-src-fontify-natively t) + (info (org-edit-src-find-region-and-lang))) + (font-lock-fontify-region (nth 0 info) (nth 1 info))))) + +(defun org-src-fontify-buffer () + "Fontify all code blocks in the current buffer" + (interactive) + (org-babel-map-src-blocks nil + (org-src-fontify-block))) + +(defun org-src-get-lang-mode (lang) + "Return major mode that should be used for LANG. +LANG is a string, and the returned major mode is a symbol." + (intern + (concat + ((lambda (l) (if (symbolp l) (symbol-name l) l)) + (or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode"))) + (provide 'org-src) ;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8 diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index cd87fdab302..b8f781e90a5 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -48,8 +48,14 @@ (defvar org-export-html-table-tag) ; defined in org-exp.el (defvar constants-unit-system) +(defvar orgtbl-after-send-table-hook nil + "Hook for functions attaching to `C-c C-c', if the table is sent. +This can be used to add additional functionality after the table is sent +to the receiver position, othewise, if table is not sent, the functions +are not run.") + (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) - "Non-nil means, use the optimized table editor version for `orgtbl-mode'. + "Non-nil means use the optimized table editor version for `orgtbl-mode'. In the optimized version, the table editor takes over all simple keys that normally just insert a character. In tables, the characters are inserted in a way to minimize disturbing the table structure (i.e. in overwrite mode @@ -142,14 +148,14 @@ alignment to the right border applies." :group 'org-table) (defcustom org-table-automatic-realign t - "Non-nil means, automatically re-align table when pressing TAB or RETURN. + "Non-nil means automatically re-align table when pressing TAB or RETURN. When nil, aligning is only done with \\[org-table-align], or after column removal/insertion." :group 'org-table-editing :type 'boolean) (defcustom org-table-auto-blank-field t - "Non-nil means, automatically blank table field when starting to type into it. + "Non-nil means automatically blank table field when starting to type into it. This only happens when typing immediately after a field motion command (TAB, S-TAB or RET). Only relevant when `org-enable-table-editor' is equal to `optimized'." @@ -157,7 +163,7 @@ Only relevant when `org-enable-table-editor' is equal to `optimized'." :type 'boolean) (defcustom org-table-tab-jumps-over-hlines t - "Non-nil means, tab in the last column of a table with jump over a hline. + "Non-nil means tab in the last column of a table with jump over a hline. If a horizontal separator line is following the current line, `org-table-next-field' can either create a new row before that line, or jump over the line. When this option is nil, a new line will be created before @@ -183,7 +189,7 @@ t: accept as input and present for editing" (const :tag "Convert user input, don't offer during editing" 'from))) (defcustom org-table-copy-increment t - "Non-nil means, increment when copying current field with \\[org-table-copy-down]." + "Non-nil means increment when copying current field with \\[org-table-copy-down]." :group 'org-table-calculation :type 'boolean) @@ -196,7 +202,7 @@ t: accept as input and present for editing" calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm)) calc-display-working-message t ) - "List with Calc mode settings for use in calc-eval for table formulas. + "List with Calc mode settings for use in `calc-eval' for table formulas. The list must contain alternating symbols (Calc modes variables and values). Don't remove any of the default settings, just change the values. Org-mode relies on the variables to be present in the list." @@ -204,7 +210,7 @@ relies on the variables to be present in the list." :type 'plist) (defcustom org-table-formula-evaluate-inline t - "Non-nil means, TAB and RET evaluate a formula in current table field. + "Non-nil means TAB and RET evaluate a formula in current table field. If the current field starts with an equal sign, it is assumed to be a formula which should be evaluated as described in the manual and in the documentation string of the command `org-table-eval-formula'. This feature requires the @@ -215,7 +221,7 @@ the command \\[org-table-eval-formula]." :type 'boolean) (defcustom org-table-formula-use-constants t - "Non-nil means, interpret constants in formulas in tables. + "Non-nil means interpret constants in formulas in tables. A constant looks like `$c' or `$Grav' and will be replaced before evaluation by the value given in `org-table-formula-constants', or by a value obtained from the `constants.el' package." @@ -241,8 +247,8 @@ Constants can also be defined on a per-file basis using a line like (string :tag "value")))) (defcustom org-table-allow-automatic-line-recalculation t - "Non-nil means, lines marked with |#| or |*| will be recomputed automatically. -Automatically means, when TAB or RET or C-c C-c are pressed in the line." + "Non-nil means lines marked with |#| or |*| will be recomputed automatically. +Automatically means when TAB or RET or C-c C-c are pressed in the line." :group 'org-table-calculation :type 'boolean) @@ -252,7 +258,7 @@ Automatically means, when TAB or RET or C-c C-c are pressed in the line." :type 'boolean) (defcustom org-table-relative-ref-may-cross-hline t - "Non-nil means, relative formula references may cross hlines. + "Non-nil means relative formula references may cross hlines. Here are the allowed values: nil Relative references may not cross hlines. They will reference the @@ -276,10 +282,11 @@ portability of tables." :group 'org-table) (defcustom org-table-export-default-format "orgtbl-to-tsv" - "Default export parameters for org-table-export. These can be -overridden on for a specific table by setting the TABLE_EXPORT_FORMAT -property. See the manual section on orgtbl radio tables for the different -export transformations and available parameters." + "Default export parameters for `org-table-export'. +These can be overridden for a specific table by setting the +TABLE_EXPORT_FORMAT property. See the manual section on orgtbl +radio tables for the different export transformations and +available parameters." :group 'org-table-import-export :type 'string) @@ -290,8 +297,7 @@ export transformations and available parameters." (defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" "Detects a table line marked for automatic recalculation.") (defconst org-table-border-regexp "^[ \t]*[^| \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") + "Searching from within a table (any type) this finds the first line outside the table.") (defvar org-table-last-highlighted-reference nil) (defvar org-table-formula-history nil) @@ -305,11 +311,11 @@ outside the table.") "Alist with locations of named fields.") (defvar org-table-current-line-types nil - "Table row types, non-nil only for the duration of a comand.") + "Table row types, non-nil only for the duration of a command.") (defvar org-table-current-begin-line nil - "Table begin line, non-nil only for the duration of a comand.") + "Table begin line, non-nil only for the duration of a command.") (defvar org-table-current-begin-pos nil - "Table begin position, non-nil only for the duration of a comand.") + "Table begin position, non-nil only for the duration of a command.") (defvar org-table-dlines nil "Vector of data line line numbers in the current table.") (defvar org-table-hlines nil @@ -327,6 +333,37 @@ outside the table.") "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") "Match a range for reference display.") +(defun org-table-colgroup-line-p (line) + "Is this a table line colgroup information?" + (save-match-data + (and (string-match "[<>]\\|&[lg]t;" line) + (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" + line) + (not (delq + nil + (mapcar + (lambda (s) + (not (member s '("" "<" ">" "<>" "<" ">" "<>")))) + (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) + +(defun org-table-cookie-line-p (line) + "Is this a table line with only alignment/width cookies?" + (save-match-data + (and (string-match "[<>]\\|&[lg]t;" line) + (or (string-match + "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lrcgt&;]+\\)\\'" line) + (string-match "\\(\\`[ \t<>lrc0-9|gt&;]+\\'\\)" line)) + (not (delq nil (mapcar + (lambda (s) + (not (or (equal s "") + (string-match + "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" s) + (string-match + "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" + s)))) + (org-split-string (match-string 1 line) + "[ \t]*|[ \t]*"))))))) + (defconst org-table-translate-regexp (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") "Match a reference that needs translation, for reference display.") @@ -342,8 +379,9 @@ and table.el tables." (if (y-or-n-p "Convert table to Org-mode table? ") (org-table-convert))) ((org-at-table-p) - (if (y-or-n-p "Convert table to table.el table? ") - (org-table-convert))) + (when (y-or-n-p "Convert table to table.el table? ") + (org-table-align) + (org-table-convert))) (t (call-interactively 'table-insert)))) (defun org-table-create-or-convert-from-region (arg) @@ -426,7 +464,7 @@ nil When nil, the command tries to be smart and figure out the (t 1)))) (goto-char beg) (if (equal separator '(4)) - (while (<= (point) end) + (while (< (point) end) ;; parse the csv stuff (cond ((looking-at "^") (insert "| ")) @@ -470,7 +508,7 @@ FILE can be the output file name. If not given, it will be taken from a TABLE_EXPORT_FILE property in the current entry or higher up in the hierarchy, or the user will be prompted for a file name. FORMAT can be an export format, of the same kind as it used when -orgtbl-mode sends a table in a different format. The default format can +`orgtbl-mode' sends a table in a different format. The default format can be found in the variable `org-table-export-default-format', but the function first checks if there is an export format specified in a TABLE_EXPORT_FORMAT property, locally or anywhere up in the hierarchy." @@ -567,7 +605,7 @@ This is being used to correctly align a single field after TAB or RET.") "List of max width of fields in each column. This is being used to correctly align a single field after TAB or RET.") (defvar org-table-formula-debug nil - "Non-nil means, debug table formulas. + "Non-nil means debug table formulas. When nil, simply write \"#ERROR\" in corrupted fields.") (make-variable-buffer-local 'org-table-formula-debug) (defvar org-table-overlay-coordinates nil @@ -575,6 +613,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (make-variable-buffer-local 'org-table-overlay-coordinates) (defvar org-last-recalc-line nil) +(defvar org-table-do-narrow t) ; for dynamic scoping (defconst org-narrow-column-arrow "=>" "Used as display property in narrowed table columns.") @@ -601,7 +640,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) (hfmt1 (concat (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings links dates emph narrow falign falign1 fmax f1 len c e) + emptystrings links dates emph raise narrow + falign falign1 fmax f1 len c e space) (untabify beg end) (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) ;; Check if we have links or dates @@ -611,6 +651,9 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (setq emph (and org-hide-emphasis-markers (re-search-forward org-emph-re end t))) (goto-char beg) + (setq raise (and org-use-sub-superscripts + (re-search-forward org-match-substring-regexp end t))) + (goto-char beg) (setq dates (and org-display-custom-times (re-search-forward org-ts-regexp-both end t))) ;; Make sure the link properties are right @@ -618,13 +661,15 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; Make sure the date properties are right (when dates (goto-char beg) (while (org-activate-dates end))) (when emph (goto-char beg) (while (org-do-emphasis-faces end))) + (when raise (goto-char beg) (while (org-raise-scripts end))) ;; Check if we are narrowing any columns (goto-char beg) - (setq narrow (and org-format-transports-properties-p - (re-search-forward "<[rl]?[0-9]+>" end t))) + (setq narrow (and org-table-do-narrow + org-format-transports-properties-p + (re-search-forward "<[lrc]?[0-9]+>" end t))) (goto-char beg) - (setq falign (re-search-forward "<[rl][0-9]*>" end t)) + (setq falign (re-search-forward "<[lrc][0-9]*>" end t)) (goto-char beg) ;; Get the rows (setq lines (org-split-string @@ -660,13 +705,14 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) ;; Check if there is an explicit width specified + (setq fmax nil) (when (or narrow falign) (setq c column fmax nil falign1 nil) (while c (setq e (pop c)) - (when (and (stringp e) (string-match "^<\\([rl]\\)?\\([0-9]+\\)?>$" e)) + (when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e)) (if (match-end 1) (setq falign1 (match-string 1 e))) - (if (match-end 2) + (if (and org-table-do-narrow (match-end 2)) (setq fmax (string-to-number (match-string 2 e)) c nil)))) ;; Find fields that are wider than fmax, and shorten them (when fmax @@ -685,7 +731,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (list 'display org-narrow-column-arrow) xx))))) ;; Get the maximum width for each column - (push (apply 'max 1 (mapcar 'org-string-width column)) lengths) + (push (apply 'max (or fmax 1) 1 (mapcar 'org-string-width column)) + lengths) ;; Get the fraction of numbers, to decide about alignment of the column (if falign1 (push (equal (downcase falign1) "r") typenums) @@ -705,16 +752,22 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; With invisible characters, `format' does not get the field width right ;; So we need to make these fields wide by hand. - (when (or links emph) + (when (or links emph raise) (loop for i from 0 upto (1- maxfields) do (setq len (nth i lengths)) (loop for j from 0 upto (1- (length fields)) do (setq c (nthcdr i (car (nthcdr j fields)))) (if (and (stringp (car c)) - (text-property-any 0 (length (car c)) 'invisible 'org-link (car c)) -; (string-match org-bracket-link-regexp (car c)) + (or (text-property-any 0 (length (car c)) + 'invisible 'org-link (car c)) + (text-property-any 0 (length (car c)) + 'org-dwidth t (car c))) (< (org-string-width (car c)) len)) - (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) + (progn + (setq space (make-string (- len (org-string-width (car c))) ?\ )) + (setcar c (if (nth i typenums) + (concat space (car c)) + (concat (car c) space)))))))) ;; Compute the formats needed for output of the table (setq rfmt (concat indent "|") hfmt (concat indent "|")) @@ -760,14 +813,6 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (setq org-table-may-need-update nil) )) - - - - - - - - (defun org-table-begin (&optional table-type) "Find the beginning of the table and return its position. With argument TABLE-TYPE, go to the beginning of a table.el-type table." @@ -826,6 +871,7 @@ Optional argument NEW may specify text to replace the current field content." (if (<= (length new) l) ;; FIXME: length -> str-width? (setq n (format f new)) (setq n (concat new "|") org-table-may-need-update t))) + (if (equal (string-to-char n) ?-) (setq n (concat " " n))) (or (equal n o) (let (org-table-may-need-update) (replace-match n t t)))) @@ -1003,6 +1049,47 @@ This actually throws an error, so it aborts the current command." (defvar org-table-clip nil "Clipboard for table regions.") +(defun org-table-get (line column) + "Get the field in table line LINE, column COLUMN. +If LINE is larger than the number of data lines in the table, the function +returns nil. However, if COLUMN is too large, we will simply return an +empty string. +If LINE is nil, use the current line. +If column is nil, use the current column." + (setq column (or column (org-table-current-column))) + (save-excursion + (and (or (not line) (org-table-goto-line line)) + (org-trim (org-table-get-field column))))) + +(defun org-table-put (line column value &optional align) + "Put VALUE into line LINE, column COLUMN. +When ALIGN is set, also realign the table." + (setq column (or column (org-table-current-column))) + (prog1 (save-excursion + (and (or (not line) (org-table-goto-line line)) + (progn (org-table-goto-column column nil 'force) t) + (org-table-get-field column value))) + (and align (org-table-align)))) + +(defun org-table-current-line () + "Return the index of the current data line." + (let ((pos (point)) (end (org-table-end)) (cnt 0)) + (save-excursion + (goto-char (org-table-begin)) + (while (and (re-search-forward org-table-dataline-regexp end t) + (setq cnt (1+ cnt)) + (< (point-at-eol) pos)))) + cnt)) + +(defun org-table-goto-line (N) + "Go to the Nth data line in the current table. +Return t when the line exists, nil if it does not exist." + (goto-char (org-table-begin)) + (let ((end (org-table-end)) (cnt 0)) + (while (and (re-search-forward org-table-dataline-regexp end t) + (< (setq cnt (1+ cnt)) N))) + (= cnt N))) + (defun org-table-blank-field () "Blank the current table field or active region." (interactive) @@ -1074,16 +1161,19 @@ is always the old value." (defun org-table-current-column () "Find out which column we are in." + (interactive) + (if (interactive-p) (org-table-check-inside-data-field)) (save-excursion (let ((cnt 0) (pos (point))) (beginning-of-line 1) (while (search-forward "|" pos t) (setq cnt (1+ cnt))) + (if (interactive-p) (message "In table column %d" cnt)) cnt))) (defun org-table-current-dline () "Find out what table data line we are in. -Only datalines count for this." +Only data lines count for this." (interactive) (if (interactive-p) (org-table-check-inside-data-field)) (save-excursion @@ -1102,22 +1192,20 @@ of the field. If there are less than N fields, just go to after the last delimiter. However, when FORCE is non-nil, create new columns if necessary." (interactive "p") - (let ((pos (point-at-eol))) - (beginning-of-line 1) - (when (> n 0) - (while (and (> (setq n (1- n)) -1) - (or (search-forward "|" pos t) - (and force - (progn (end-of-line 1) - (skip-chars-backward "^|") - (insert " | ")))))) -; (backward-char 2) t))))) - (when (and force (not (looking-at ".*|"))) - (save-excursion (end-of-line 1) (insert " | "))) - (if on-delim - (backward-char 1) - (if (looking-at " ") (forward-char 1)))))) - + (beginning-of-line 1) + (when (> n 0) + (while (and (> (setq n (1- n)) -1) + (or (search-forward "|" (point-at-eol) t) + (and force + (progn (end-of-line 1) + (skip-chars-backward "^|") + (insert " | ") + t))))) + (when (and force (not (looking-at ".*|"))) + (save-excursion (end-of-line 1) (insert " | "))) + (if on-delim + (backward-char 1) + (if (looking-at " ") (forward-char 1))))) (defun org-table-insert-column () "Insert a new column into the table." @@ -1146,7 +1234,7 @@ However, when FORCE is non-nil, create new columns if necessary." (org-table-fix-formulas "$LR" nil (1- col) 1))) (defun org-table-find-dataline () - "Find a dataline in the current table, which is needed for column commands." + "Find a data line in the current table, which is needed for column commands." (if (and (org-at-table-p) (not (org-at-table-hline-p))) t @@ -1686,23 +1774,6 @@ the table and kill the editing buffer." (org-table-align) (message "New field value inserted"))) - - - - - - - - - - - - - - - - - (defvar org-timecnt) ; dynamically scoped parameter (defun org-table-sum (&optional beg end nlast) @@ -1787,7 +1858,7 @@ If NLAST is a number, only the NLAST fields will actually be summed." "Return the formula active for the current field. Assumes that specials are in place. If KEY is given, return the key to this formula. -Otherwise return the formula preceeded with \"=\" or \":=\"." +Otherwise return the formula preceded with \"=\" or \":=\"." (let* ((name (car (rassoc (list (org-current-line) (org-table-current-column)) org-table-named-field-locations))) @@ -2243,6 +2314,20 @@ not overwrite the stored one." (setq form (copy-sequence formula) lispp (and (> (length form) 2)(equal (substring form 0 2) "'("))) (if (and lispp literal) (setq lispp 'literal)) + + ;; Insert row and column number of formula result field + (while (string-match "[@$]#" form) + (setq form + (replace-match + (format "%d" + (save-match-data + (if (equal (substring form (match-beginning 0) + (1+ (match-beginning 0))) + "@") + (org-table-current-dline) + (org-table-current-column)))) + t t form))) + ;; Check for old vertical references (setq form (org-table-rewrite-old-row-references form)) ;; Insert remote references @@ -2315,7 +2400,7 @@ $1-> %s\n" orig formula form0 form)) (org-fit-window-to-buffer bw) (unless (and (interactive-p) (not ndown)) (unless (let (inhibit-redisplay) - (y-or-n-p "Debugging Formula. Continue to next? ")) + (y-or-n-p "Debugging Formula. Continue to next? ")) (org-table-align) (error "Abort")) (delete-window bw) @@ -2340,7 +2425,7 @@ $1-> %s\n" orig formula form0 form)) "Get a calc vector from a column, according to descriptor DESC. Optional arguments TBEG and COL can give the beginning of the table and the current column, to avoid unnecessary parsing. -HIGHLIGHT means, just highlight the range." +HIGHLIGHT means just highlight the range." (if (not (equal (string-to-char desc) ?@)) (setq desc (concat "@" desc))) (save-excursion @@ -2412,7 +2497,7 @@ and TABLE is a vector with line types." ;; 1 2 3 4 5 6 (and (not (match-end 3)) (not (match-end 6))) (and (match-end 3) (match-end 6) (not (match-end 5)))) - (error "invalid row descriptor `%s'" desc)) + (error "Invalid row descriptor `%s'" desc)) (let* ((hdir (and (match-end 2) (match-string 2 desc))) (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) (odir (and (match-end 5) (match-string 5 desc))) @@ -2426,7 +2511,7 @@ and TABLE is a vector with line types." (setq i 0 hdir "+") (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) (if (and (not hn) on (not odir)) - (error "should never happen");;(aref org-table-dlines on) + (error "Should never happen");;(aref org-table-dlines on) (if (and hn (> hn 0)) (setq i (org-table-find-row-type table i 'hline (equal hdir "-") nil hn cline desc))) @@ -2497,7 +2582,8 @@ LISPP means to return something appropriate for a Lisp list." (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. With prefix arg ALL, do this for all lines in the table. -With the prefix argument ALL is `(16)' (a double `C-c C-u' prefix), or if +With the prefix argument ALL is `(16)' \ +\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if it is the symbol `iterate', recompute the table until it no longer changes. If NOALIGN is not nil, do not re-align the table after the computations are done. This is typically used internally to save time, if it is @@ -2625,6 +2711,36 @@ known that the table will be realigned a little later anyway." (throw 'exit t))) (error "No convergence after %d iterations" i)))) +(defun org-table-recalculate-buffer-tables () + "Recalculate all tables in the current buffer." + (interactive) + (save-excursion + (save-restriction + (widen) + (org-table-map-tables (lambda () (org-table-recalculate t)) t)))) + +(defun org-table-iterate-buffer-tables () + "Iterate all tables in the buffer, to converge inter-table dependencies." + (interactive) + (let* ((imax 10) + (checksum (md5 (buffer-string))) + + c1 + (i imax)) + (save-excursion + (save-restriction + (widen) + (catch 'exit + (while (> i 0) + (setq i (1- i)) + (org-table-map-tables (lambda () (org-table-recalculate t)) t) + (if (equal checksum (setq c1 (md5 (buffer-string)))) + (progn + (message "Convergence after %d iterations" (- imax i)) + (throw 'exit t)) + (setq checksum c1))) + (error "No convergence after %d iterations" imax)))))) + (defun org-table-formula-substitute-names (f) "Replace $const with values in string F." (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) @@ -2663,6 +2779,7 @@ Parameters get priority." (org-defkey map "\C-x\C-s" 'org-table-fedit-finish) (org-defkey map "\C-c\C-s" 'org-table-fedit-finish) (org-defkey map "\C-c\C-c" 'org-table-fedit-finish) + (org-defkey map "\C-c'" 'org-table-fedit-finish) (org-defkey map "\C-c\C-q" 'org-table-fedit-abort) (org-defkey map "\C-c?" 'org-table-show-reference) (org-defkey map [(meta shift up)] 'org-table-fedit-line-up) @@ -2759,7 +2876,7 @@ Parameters get priority." (if (eq org-table-use-standard-references t) (org-table-fedit-toggle-ref-type)) (org-goto-line startline) - (message "Edit formulas and finish with `C-c C-c'. See menu for more commands."))) + (message "Edit formulas, finish with `C-c C-c' or `C-c ' '. See menu for more commands."))) (defun org-table-fedit-post-command () (when (not (memq this-command '(lisp-complete-symbol))) @@ -2797,6 +2914,12 @@ full TBLFM line." (not (equal ?. (aref s (max (- (match-beginning 0) 2) 0))))) ;; 3.e5 or something like this. (setq start (match-end 0))) + ((or (> (- (match-end 1) (match-beginning 1)) 2) + ;; (member (match-string 1 s) + ;; '("arctan" "exp" "expm" "lnp" "log" "stir")) + ) + ;; function name, just advance + (setq start (match-end 0))) (t (setq start (match-beginning 0) s (replace-match @@ -2901,7 +3024,7 @@ For example: 28 -> AB." (org-rematch-and-replace 5 (eq dir 'left)))))) (defun org-rematch-and-replace (n &optional decr hline) - "Re-match the group N, and replace it with the shifted refrence." + "Re-match the group N, and replace it with the shifted reference." (or (match-end n) (error "Cannot shift reference in this direction")) (goto-char (match-beginning n)) (and (looking-at (regexp-quote (match-string n))) @@ -2909,7 +3032,7 @@ For example: 28 -> AB." t t))) (defun org-table-shift-refpart (ref &optional decr hline) - "Shift a refrence part REF. + "Shift a reference part REF. If DECR is set, decrease the references row/column, else increase. If HLINE is set, this may be a hline reference, it certainly is not a translation reference." @@ -2977,7 +3100,7 @@ With prefix ARG, apply the new formulas to the table." (select-window sel-win) (goto-char pos) (unless (org-at-table-p) - (error "Lost table position - cannot install formulae")) + (error "Lost table position - cannot install formulas")) (org-table-store-formulas eql) (move-marker pos nil) (kill-buffer "*Edit Formulas*") @@ -3219,8 +3342,8 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (defun org-table-add-rectangle-overlay (beg end &optional face) "Add a new overlay." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face (or face 'secondary-selection)) + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face (or face 'secondary-selection)) (push ov org-table-rectangle-overlays))) (defun org-table-highlight-rectangle (&optional beg end face) @@ -3255,7 +3378,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." "Remove the rectangle overlays." (unless org-inhibit-highlight-removal (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) - (mapc 'org-delete-overlay org-table-rectangle-overlays) + (mapc 'delete-overlay org-table-rectangle-overlays) (setq org-table-rectangle-overlays nil))) (defvar org-table-coordinate-overlays nil @@ -3265,14 +3388,14 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (defun org-table-overlay-coordinates () "Add overlays to the table at point, to show row/column coordinates." (interactive) - (mapc 'org-delete-overlay org-table-coordinate-overlays) + (mapc 'delete-overlay org-table-coordinate-overlays) (setq org-table-coordinate-overlays nil) (save-excursion (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg) (goto-char (org-table-begin)) (while (org-at-table-p) (setq eol (point-at-eol)) - (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-bol)))) + (setq ov (make-overlay (point-at-bol) (1+ (point-at-bol)))) (push ov org-table-coordinate-overlays) (setq hline (looking-at org-table-hline-regexp)) (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) @@ -3286,7 +3409,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." s1 (concat "$" (int-to-string ic)) s2 (org-number-to-letters ic) str (if (eq org-table-use-standard-references t) s2 s1)) - (setq ov (org-make-overlay beg (+ beg (length str)))) + (setq ov (make-overlay beg (+ beg (length str)))) (push ov org-table-coordinate-overlays) (org-overlay-display ov str 'org-special-keyword 'evaporate))) (beginning-of-line 2))))) @@ -3300,7 +3423,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (if (and (org-at-table-p) org-table-overlay-coordinates) (org-table-align)) (unless org-table-overlay-coordinates - (mapc 'org-delete-overlay org-table-coordinate-overlays) + (mapc 'delete-overlay org-table-coordinate-overlays) (setq org-table-coordinate-overlays nil))) (defun org-table-toggle-formula-debugger () @@ -3338,10 +3461,6 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." ;; active, this binding is ignored inside tables and replaced with a ;; modified self-insert. -(defvar orgtbl-mode nil - "Variable controlling `orgtbl-mode', a minor mode enabling the `org-mode' -table editor in arbitrary modes.") -(make-variable-buffer-local 'orgtbl-mode) (defvar orgtbl-mode-map (make-keymap) "Keymap for `orgtbl-mode'.") @@ -3352,7 +3471,7 @@ table editor in arbitrary modes.") (orgtbl-mode 1)) (defvar org-old-auto-fill-inhibit-regexp nil - "Local variable used by `orgtbl-mode'") + "Local variable used by `orgtbl-mode'.") (defconst orgtbl-line-start-regexp "[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\|TBLNAME\\):\\)" @@ -3361,51 +3480,54 @@ table editor in arbitrary modes.") (defconst orgtbl-extra-font-lock-keywords (list (list (concat "^" orgtbl-line-start-regexp ".*") 0 (quote 'org-table) 'prepend)) - "Extra font-lock-keywords to be added when orgtbl-mode is active.") + "Extra `font-lock-keywords' to be added when `orgtbl-mode' is active.") + +;; Install it as a minor mode. +(put 'orgtbl-mode :included t) +(put 'orgtbl-mode :menu-tag "Org Table Mode") ;;;###autoload -(defun orgtbl-mode (&optional arg) +(define-minor-mode orgtbl-mode "The `org-mode' table editor as a minor mode for use in other modes." - (interactive) + :lighter " OrgTbl" :keymap orgtbl-mode-map (org-load-modules-maybe) - (if (org-mode-p) - ;; Exit without error, in case some hook functions calls this - ;; by accident in org-mode. - (message "Orgtbl-mode is not useful in org-mode, command ignored") - (setq orgtbl-mode - (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) - (if orgtbl-mode - (progn - (and (orgtbl-setup) (defun orgtbl-setup () nil)) - ;; Make sure we are first in minor-mode-map-alist - (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) - (and c (setq minor-mode-map-alist - (cons c (delq c minor-mode-map-alist))))) - (org-set-local (quote org-table-may-need-update) t) - (org-add-hook 'before-change-functions 'org-before-change-function - nil 'local) - (org-set-local 'org-old-auto-fill-inhibit-regexp - auto-fill-inhibit-regexp) - (org-set-local 'auto-fill-inhibit-regexp - (if auto-fill-inhibit-regexp - (concat orgtbl-line-start-regexp "\\|" - auto-fill-inhibit-regexp) - orgtbl-line-start-regexp)) - (org-add-to-invisibility-spec '(org-cwidth)) - (when (fboundp 'font-lock-add-keywords) - (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-add orgtbl-mode-menu) - (run-hooks 'orgtbl-mode-hook)) - (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) - (org-table-cleanup-narrow-column-properties) - (org-remove-from-invisibility-spec '(org-cwidth)) - (remove-hook 'before-change-functions 'org-before-change-function t) - (when (fboundp 'font-lock-remove-keywords) - (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-remove orgtbl-mode-menu) - (force-mode-line-update 'all)))) + (cond + ((org-mode-p) + ;; Exit without error, in case some hook functions calls this + ;; by accident in org-mode. + (message "Orgtbl-mode is not useful in org-mode, command ignored")) + (orgtbl-mode + (and (orgtbl-setup) (defun orgtbl-setup () nil)) ;; FIXME: Yuck!?! + ;; Make sure we are first in minor-mode-map-alist + (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) + ;; FIXME: maybe it should use emulation-mode-map-alists? + (and c (setq minor-mode-map-alist + (cons c (delq c minor-mode-map-alist))))) + (org-set-local (quote org-table-may-need-update) t) + (org-add-hook 'before-change-functions 'org-before-change-function + nil 'local) + (org-set-local 'org-old-auto-fill-inhibit-regexp + auto-fill-inhibit-regexp) + (org-set-local 'auto-fill-inhibit-regexp + (if auto-fill-inhibit-regexp + (concat orgtbl-line-start-regexp "\\|" + auto-fill-inhibit-regexp) + orgtbl-line-start-regexp)) + (add-to-invisibility-spec '(org-cwidth)) + (when (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) + (org-restart-font-lock)) + (easy-menu-add orgtbl-mode-menu)) + (t + (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) + (org-table-cleanup-narrow-column-properties) + (org-remove-from-invisibility-spec '(org-cwidth)) + (remove-hook 'before-change-functions 'org-before-change-function t) + (when (fboundp 'font-lock-remove-keywords) + (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) + (org-restart-font-lock)) + (easy-menu-remove orgtbl-mode-menu) + (force-mode-line-update 'all)))) (defun org-table-cleanup-narrow-column-properties () "Remove all properties related to narrow-column invisibility." @@ -3420,11 +3542,6 @@ table editor in arbitrary modes.") (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth)) (remove-text-properties s (1+ s) '(invisible t))))) -;; Install it as a minor mode. -(put 'orgtbl-mode :included t) -(put 'orgtbl-mode :menu-tag "Org Table Mode") -(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) - (defun orgtbl-make-binding (fun n &rest keys) "Create a function for binding in the table minor mode. FUN is the command to call inside a table. N is used to create a unique @@ -3459,34 +3576,33 @@ to execute outside of tables." "Setup orgtbl keymaps." (let ((nfunc 0) (bindings - (list - '([(meta shift left)] org-table-delete-column) - '([(meta left)] org-table-move-column-left) - '([(meta right)] org-table-move-column-right) - '([(meta shift right)] org-table-insert-column) - '([(meta shift up)] org-table-kill-row) - '([(meta shift down)] org-table-insert-row) - '([(meta up)] org-table-move-row-up) - '([(meta down)] org-table-move-row-down) - '("\C-c\C-w" org-table-cut-region) - '("\C-c\M-w" org-table-copy-region) - '("\C-c\C-y" org-table-paste-rectangle) - '("\C-c-" org-table-insert-hline) - '("\C-c}" org-table-toggle-coordinate-overlays) - '("\C-c{" org-table-toggle-formula-debugger) - '("\C-m" org-table-next-row) - '([(shift return)] org-table-copy-down) - '("\C-c?" org-table-field-info) - '("\C-c " org-table-blank-field) - '("\C-c+" org-table-sum) - '("\C-c=" org-table-eval-formula) - '("\C-c'" org-table-edit-formulas) - '("\C-c`" org-table-edit-field) - '("\C-c*" org-table-recalculate) - '("\C-c^" org-table-sort-lines) - '("\M-a" org-table-beginning-of-field) - '("\M-e" org-table-end-of-field) - '([(control ?#)] org-table-rotate-recalc-marks))) + '(([(meta shift left)] org-table-delete-column) + ([(meta left)] org-table-move-column-left) + ([(meta right)] org-table-move-column-right) + ([(meta shift right)] org-table-insert-column) + ([(meta shift up)] org-table-kill-row) + ([(meta shift down)] org-table-insert-row) + ([(meta up)] org-table-move-row-up) + ([(meta down)] org-table-move-row-down) + ("\C-c\C-w" org-table-cut-region) + ("\C-c\M-w" org-table-copy-region) + ("\C-c\C-y" org-table-paste-rectangle) + ("\C-c-" org-table-insert-hline) + ("\C-c}" org-table-toggle-coordinate-overlays) + ("\C-c{" org-table-toggle-formula-debugger) + ("\C-m" org-table-next-row) + ([(shift return)] org-table-copy-down) + ("\C-c?" org-table-field-info) + ("\C-c " org-table-blank-field) + ("\C-c+" org-table-sum) + ("\C-c=" org-table-eval-formula) + ("\C-c'" org-table-edit-formulas) + ("\C-c`" org-table-edit-field) + ("\C-c*" org-table-recalculate) + ("\C-c^" org-table-sort-lines) + ("\M-a" org-table-beginning-of-field) + ("\M-e" org-table-end-of-field) + ([(control ?#)] org-table-rotate-recalc-marks))) elt key fun cmd) (while (setq elt (pop bindings)) (setq nfunc (1+ nfunc)) @@ -3619,7 +3735,8 @@ With prefix arg, also recompute table." (call-interactively 'org-table-recalculate) (org-table-maybe-recalculate-line)) (call-interactively 'org-table-align) - (orgtbl-send-table 'maybe)) + (when (orgtbl-send-table 'maybe) + (run-hooks 'orgtbl-after-send-table-hook))) ((eq action 'recalc) (save-excursion (beginning-of-line 1) @@ -3731,13 +3848,13 @@ overwritten, and the table is not marked as requiring realignment." (funcall func table nil))) (defun orgtbl-gather-send-defs () - "Gathers a plist of :name, :transform, :params for each destination before + "Gather a plist of :name, :transform, :params for each destination before a radio table." (save-excursion (goto-char (org-table-begin)) (let (rtn) (beginning-of-line 0) - (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") + (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") (let ((name (org-no-properties (match-string 1))) (transform (intern (match-string 2))) (params (if (match-end 3) @@ -3833,7 +3950,10 @@ this table." (orgtbl-send-replace-tbl name txt)) (setq ntbl (1+ ntbl))) (message "Table converted and installed at %d receiver location%s" - ntbl (if (> ntbl 1) "s" ""))))) + ntbl (if (> ntbl 1) "s" "")) + (if (> ntbl 0) + ntbl + nil)))) (defun org-remove-by-index (list indices &optional i0) "Remove the elements in LIST with indices in INDICES. @@ -3888,17 +4008,17 @@ First element has index 0, or I0 if given." (defvar *orgtbl-rtn* nil "Formatting routines push the output lines here.") ;; Formatting parameters for the current table section. -(defvar *orgtbl-hline* nil "Text used for horizontal lines") -(defvar *orgtbl-sep* nil "Text used as a column separator") -(defvar *orgtbl-default-fmt* nil "Default format for each entry") -(defvar *orgtbl-fmt* nil "Format for each entry") -(defvar *orgtbl-efmt* nil "Format for numbers") -(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt") -(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row") -(defvar *orgtbl-lstart* nil "Text starting a row") -(defvar *orgtbl-llstart* nil "Specializes lstart for the last row") -(defvar *orgtbl-lend* nil "Text ending a row") -(defvar *orgtbl-llend* nil "Specializes lend for the last row") +(defvar *orgtbl-hline* nil "Text used for horizontal lines.") +(defvar *orgtbl-sep* nil "Text used as a column separator.") +(defvar *orgtbl-default-fmt* nil "Default format for each entry.") +(defvar *orgtbl-fmt* nil "Format for each entry.") +(defvar *orgtbl-efmt* nil "Format for numbers.") +(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.") +(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.") +(defvar *orgtbl-lstart* nil "Text starting a row.") +(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.") +(defvar *orgtbl-lend* nil "Text ending a row.") +(defvar *orgtbl-llend* nil "Specializes lend for the last row.") (defsubst orgtbl-get-fmt (fmt i) "Retrieve the format from FMT corresponding to the Ith column." @@ -4018,6 +4138,7 @@ directly by `orgtbl-send-table'. See manual." (let* ((splicep (plist-get params :splice)) (hline (plist-get params :hline)) (remove-nil-linesp (plist-get params :remove-nil-lines)) + (remove-newlines (plist-get params :remove-newlines)) (*orgtbl-hline* hline) (*orgtbl-table* table) (*orgtbl-sep* (plist-get params :sep)) @@ -4072,9 +4193,13 @@ directly by `orgtbl-send-table'. See manual." (let ((tend (orgtbl-eval-str (plist-get params :tend)))) (if tend (push tend *orgtbl-rtn*))))) - (mapconcat 'identity (nreverse (if remove-nil-linesp - (remq nil *orgtbl-rtn*) - *orgtbl-rtn*)) "\n"))) + (mapconcat (if remove-newlines + (lambda (tend) + (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend)) + 'identity) + (nreverse (if remove-nil-linesp + (remq nil *orgtbl-rtn*) + *orgtbl-rtn*)) "\n"))) (defun orgtbl-to-tsv (table params) "Convert the orgtbl-mode table to TAB separated material." @@ -4125,7 +4250,7 @@ this function is called." (orgtbl-to-generic table (org-combine-plists params2 params)))) (defun orgtbl-to-html (table params) - "Convert the orgtbl-mode TABLE to LaTeX. + "Convert the orgtbl-mode TABLE to HTML. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. PARAMS is a property list of parameters that can influence the conversion. @@ -4147,7 +4272,7 @@ so you cannot specify parameters for it." (lambda (x) (if (eq x 'hline) "|----+----|" - (concat "| " (mapconcat 'identity x " | ") " |"))) + (concat "| " (mapconcat 'org-html-expand x " | ") " |"))) table) splicep)) (if (string-match "\n+\\'" html) @@ -4200,6 +4325,7 @@ and :tend suppress strings without splicing; they can be set to provide ORGTBL directives for the generated table." (let* ((params2 (list + :remove-newlines t :tstart nil :tend nil :hline "|---" :sep " | " @@ -4247,23 +4373,23 @@ list of the fields in the rectangle ." (setq buffer (marker-buffer id-loc) loc (marker-position id-loc)) (move-marker id-loc nil))) - (switch-to-buffer buffer) - (save-excursion - (save-restriction - (widen) - (goto-char loc) - (forward-char 1) - (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) - (not (match-beginning 1))) - (error "Cannot find a table at NAME or ID %s" name-or-id)) - (setq tbeg (point-at-bol)) - (org-table-get-specials) - (setq form (org-table-formula-substitute-names form)) - (if (and (string-match org-table-range-regexp form) - (> (length (match-string 0 form)) 1)) - (save-match-data - (org-table-get-range (match-string 0 form) tbeg 1)) - form)))))))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char loc) + (forward-char 1) + (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) + (not (match-beginning 1))) + (error "Cannot find a table at NAME or ID %s" name-or-id)) + (setq tbeg (point-at-bol)) + (org-table-get-specials) + (setq form (org-table-formula-substitute-names form)) + (if (and (string-match org-table-range-regexp form) + (> (length (match-string 0 form)) 1)) + (save-match-data + (org-table-get-range (match-string 0 form) tbeg 1)) + form))))))))) (provide 'org-table) diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el new file mode 100644 index 00000000000..d78e10d56a8 --- /dev/null +++ b/lisp/org/org-taskjuggler.el @@ -0,0 +1,648 @@ +;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode +;; +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; +;; Emacs Lisp Archive Entry +;; Filename: org-taskjuggler.el +;; Version: 7.4 +;; Author: Christian Egli +;; Maintainer: Christian Egli +;; Keywords: org, taskjuggler, project planning +;; Description: Converts an org-mode buffer into a taskjuggler project plan +;; URL: + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;; Commentary: +;; +;; This library implements a TaskJuggler exporter for org-mode. +;; TaskJuggler uses a text format to define projects, tasks and +;; resources, so it is a natural fit for org-mode. It can produce all +;; sorts of reports for tasks or resources in either HTML, CSV or PDF. +;; The current version of TaskJuggler requires KDE but the next +;; version is implemented in Ruby and should therefore run on any +;; platform. +;; +;; The exporter is a bit different from other exporters, such as the +;; HTML and LaTeX exporters for example, in that it does not export +;; all the nodes of a document or strictly follow the order of the +;; nodes in the document. +;; +;; Instead the TaskJuggler exporter looks for a tree that defines the +;; tasks and a optionally tree that defines the resources for this +;; project. It then creates a TaskJuggler file based on these trees +;; and the attributes defined in all the nodes. +;; +;; * Installation +;; +;; Put this file into your load-path and the following line into your +;; ~/.emacs: +;; +;; (require 'org-taskjuggler) +;; +;; The interactive functions are similar to those of the HTML and LaTeX +;; exporters: +;; +;; M-x `org-export-as-taskjuggler' +;; M-x `org-export-as-taskjuggler-and-open' +;; +;; * Tasks +;; +;; Let's illustrate the usage with a small example. Create your tasks +;; as you usually do with org-mode. Assign efforts to each task using +;; properties (it's easiest to do this in the column view). You should +;; end up with something similar to the example by Peter Jones in +;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org. +;; Now mark the top node of your tasks with a tag named +;; "taskjuggler_project" (or whatever you customized +;; `org-export-taskjuggler-project-tag' to). You are now ready to +;; export the project plan with `org-export-as-taskjuggler-and-open' +;; which will export the project plan and open a gant chart in +;; TaskJugglerUI. +;; +;; * Resources +;; +;; Next you can define resources and assign those to work on specific +;; tasks. You can group your resources hierarchically. Tag the top +;; node of the resources with "taskjuggler_resource" (or whatever you +;; customized `org-export-taskjuggler-resource-tag' to). You can +;; optionally assign an identifier (named "resource_id") to the +;; resources (using the standard org properties commands) or you can +;; let the exporter generate identifiers automatically (the exporter +;; picks the first word of the headline as the identifier as long as +;; it is unique, see the documentation of +;; `org-taskjuggler-get-unique-id'). Using that identifier you can +;; then allocate resources to tasks. This is again done with the +;; "allocate" property on the tasks. Do this in column view or when on +;; the task type +;; +;; C-c C-x p allocate RET <resource_id> RET +;; +;; Once the allocations are done you can again export to TaskJuggler +;; and check in the Resource Allocation Graph which person is working +;; on what task at what time. +;; +;; * Export of properties +;; +;; The exporter also takes TODO state information into consideration, +;; i.e. if a task is marked as done it will have the corresponding +;; attribute in TaskJuggler ("complete 100"). Also it will export any +;; property on a task resource or resource node which is known to +;; TaskJuggler, such as limits, vacation, shift, booking, efficiency, +;; journalentry, rate for resources or account, start, note, duration, +;; end, journalentry, milestone, reference, responsible, scheduling, +;; etc for tasks. +;; +;; * Dependencies +;; +;; The exporter will handle dependencies that are defined in the tasks +;; either with the ORDERED attribute (see TODO dependencies in the Org +;; mode manual) or with the BLOCKER attribute (see org-depend.el) or +;; alternatively with a depends attribute. Both the BLOCKER and the +;; depends attribute can be either "previous-sibling" or a reference +;; to an identifier (named "task_id") which is defined for another +;; task in the project. BLOCKER and the depends attribute can define +;; multiple dependencies separated by either space or comma. You can +;; also specify optional attributes on the dependency by simply +;; appending it. The following examples should illustrate this: +;; +;; * Training material +;; :PROPERTIES: +;; :task_id: training_material +;; :ORDERED: t +;; :END: +;; ** Markup Guidelines +;; :PROPERTIES: +;; :Effort: 2.0 +;; :END: +;; ** Workflow Guidelines +;; :PROPERTIES: +;; :Effort: 2.0 +;; :END: +;; * Presentation +;; :PROPERTIES: +;; :Effort: 2.0 +;; :BLOCKER: training_material { gapduration 1d } some_other_task +;; :END: +;; +;;;; * TODO +;; - Use SCHEDULED and DEADLINE information (not just start and end +;; properties). +;; - Look at org-file-properties, org-global-properties and +;; org-global-properties-fixed +;; - What about property inheritance and org-property-inherit-p? +;; - Use TYPE_TODO as an way to assign resources +;; - Make sure multiple dependency definitions (i.e. BLOCKER on +;; previous-sibling and on a specific task_id) in multiple +;; attributes are properly exported. +;; +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'org) +(require 'org-exp) + +;;; User variables: + +(defgroup org-export-taskjuggler nil + "Options for exporting Org-mode files to TaskJuggler." + :tag "Org Export TaskJuggler" + :group 'org-export) + +(defcustom org-export-taskjuggler-extension ".tjp" + "Extension of TaskJuggler files." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-export-taskjuggler-project-tag "taskjuggler_project" + "Tag, property or todo used to find the tree containing all +the tasks for the project." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-export-taskjuggler-resource-tag "taskjuggler_resource" + "Tag, property or todo used to find the tree containing all the +resources for the project." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-export-taskjuggler-default-project-version "1.0" + "Default version string for the project." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-export-taskjuggler-default-project-duration 280 + "Default project duration if no start and end date have been defined +in the root node of the task tree, i.e. the tree that has been marked +with `org-export-taskjuggler-project-tag'" + :group 'org-export-taskjuggler + :type 'integer) + +(defcustom org-export-taskjuggler-default-reports + '("taskreport \"Gantt Chart\" { + headline \"Project Gantt Chart\" + columns hierarchindex, name, start, end, effort, duration, completed, chart + timeformat \"%Y-%m-%d\" + hideresource 1 + loadunit shortauto +}" +"resourcereport \"Resource Graph\" { + headline \"Resource Allocation Graph\" + columns no, name, utilization, freeload, chart + loadunit shortauto + sorttasks startup + hidetask ~isleaf() +}") + "Default reports for the project." + :group 'org-export-taskjuggler + :type '(repeat (string :tag "Report"))) + +(defcustom org-export-taskjuggler-default-global-properties + "shift s40 \"Part time shift\" { + workinghours wed, thu, fri off +} +" + "Default global properties for the project. Here you typically +define global properties such as shifts, accounts, rates, +vacation, macros and flags. Any property that is allowed within +the TaskJuggler file can be inserted. You could for example +include another TaskJuggler file. + +The global properties are inserted after the project declaration +but before any resource and task declarations." + :group 'org-export-taskjuggler + :type '(string :tag "Preamble")) + +;;; Hooks + +(defvar org-export-taskjuggler-final-hook nil + "Hook run at the end of TaskJuggler export, in the new buffer.") + +;;; Autoload functions: + +;; avoid compiler warning about free variable +(defvar org-export-taskjuggler-old-level) + +;;;###autoload +(defun org-export-as-taskjuggler () + "Export parts of the current buffer as a TaskJuggler file. +The exporter looks for a tree with tag, property or todo that +matches `org-export-taskjuggler-project-tag' and takes this as +the tasks for this project. The first node of this tree defines +the project properties such as project name and project period. +If there is a tree with tag, property or todo that matches +`org-export-taskjuggler-resource-tag' this three is taken as +resources for the project. If no resources are specified, a +default resource is created and allocated to the project. Also +the taskjuggler project will be created with default reports as +defined in `org-export-taskjuggler-default-reports'." + (interactive) + + (message "Exporting...") + (setq-default org-done-keywords org-done-keywords) + (let* ((tasks + (org-taskjuggler-resolve-dependencies + (org-taskjuggler-assign-task-ids + (org-map-entries + '(org-taskjuggler-components) + org-export-taskjuggler-project-tag nil 'archive 'comment)))) + (resources + (org-taskjuggler-assign-resource-ids + (org-map-entries + '(org-taskjuggler-components) + org-export-taskjuggler-resource-tag nil 'archive 'comment))) + (filename (expand-file-name + (concat + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + org-export-taskjuggler-extension))) + (buffer (find-file-noselect filename)) + (org-export-taskjuggler-old-level 0) + task resource) + (unless tasks + (error "No tasks specified")) + ;; add a default resource + (unless resources + (setq resources + `((("resource_id" . ,(user-login-name)) + ("headline" . ,user-full-name) + ("level" . 1))))) + ;; add a default allocation to the first task if none was given + (unless (assoc "allocate" (car tasks)) + (let ((task (car tasks)) + (resource-id (cdr (assoc "resource_id" (car resources))))) + (setcar tasks (push (cons "allocate" resource-id) task)))) + ;; add a default start date to the first task if none was given + (unless (assoc "start" (car tasks)) + (let ((task (car tasks)) + (time-string (format-time-string "%Y-%m-%d"))) + (setcar tasks (push (cons "start" time-string) task)))) + ;; add a default version if none was given + (unless (assoc "version" (car tasks)) + (let ((task (car tasks)) + (version org-export-taskjuggler-default-project-version)) + (setcar tasks (push (cons "version" version) task)))) + (with-current-buffer buffer + (erase-buffer) + (org-taskjuggler-open-project (car tasks)) + (insert org-export-taskjuggler-default-global-properties) + (insert "\n") + (dolist (resource resources) + (let ((level (cdr (assoc "level" resource)))) + (org-taskjuggler-close-maybe level) + (org-taskjuggler-open-resource resource) + (setq org-export-taskjuggler-old-level level))) + (org-taskjuggler-close-maybe 1) + (setq org-export-taskjuggler-old-level 0) + (dolist (task tasks) + (let ((level (cdr (assoc "level" task)))) + (org-taskjuggler-close-maybe level) + (org-taskjuggler-open-task task) + (setq org-export-taskjuggler-old-level level))) + (org-taskjuggler-close-maybe 1) + (org-taskjuggler-insert-reports) + (save-buffer) + (or (org-export-push-to-kill-ring "TaskJuggler") + (message "Exporting... done")) + (current-buffer)))) + +;;;###autoload +(defun org-export-as-taskjuggler-and-open () + "Export the current buffer as a TaskJuggler file and open it +with the TaskJuggler GUI." + (interactive) + (let* ((file-name (buffer-file-name (org-export-as-taskjuggler))) + (process-name "TaskJugglerUI") + (command (concat process-name " " file-name))) + (start-process-shell-command process-name nil command))) + +(defun org-taskjuggler-parent-is-ordered-p () + "Return true if the parent of the current node has a property +\"ORDERED\". Return nil otherwise." + (save-excursion + (and (org-up-heading-safe) (org-entry-get (point) "ORDERED")))) + +(defun org-taskjuggler-components () + "Return an alist containing all the pertinent information for +the current node such as the headline, the level, todo state +information, all the properties, etc." + (let* ((props (org-entry-properties)) + (components (org-heading-components)) + (level (nth 1 components)) + (headline (nth 4 components)) + (parent-ordered (org-taskjuggler-parent-is-ordered-p))) + (push (cons "level" level) props) + (push (cons "headline" headline) props) + (push (cons "parent-ordered" parent-ordered) props))) + +(defun org-taskjuggler-assign-task-ids (tasks) + "Given a list of tasks return the same list assigning a unique id +and the full path to each task. Taskjuggler takes hierarchical ids. +For that reason we have to make ids locally unique and we have to keep +a path to the current task." + (let ((previous-level 0) + unique-ids unique-id + path + task resolved-tasks tmp) + (dolist (task tasks resolved-tasks) + (let ((level (cdr (assoc "level" task)))) + (cond + ((< previous-level level) + (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) + (dotimes (tmp (- level previous-level)) + (push (list unique-id) unique-ids) + (push unique-id path))) + ((= previous-level level) + (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) + (push unique-id (car unique-ids)) + (setcar path unique-id)) + ((> previous-level level) + (dotimes (tmp (- previous-level level)) + (pop unique-ids) + (pop path)) + (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) + (push unique-id (car unique-ids)) + (setcar path unique-id))) + (push (cons "unique-id" unique-id) task) + (push (cons "path" (mapconcat 'identity (reverse path) ".")) task) + (setq previous-level level) + (setq resolved-tasks (append resolved-tasks (list task))))))) + +(defun org-taskjuggler-assign-resource-ids (resources &optional unique-ids) + "Given a list of resources return the same list, assigning a +unique id to each resource." + (cond + ((null resources) nil) + (t + (let* ((resource (car resources)) + (unique-id (org-taskjuggler-get-unique-id resource unique-ids))) + (push (cons "unique-id" unique-id) resource) + (cons resource + (org-taskjuggler-assign-resource-ids (cdr resources) + (cons unique-id unique-ids))))))) + +(defun org-taskjuggler-resolve-dependencies (tasks) + (let ((previous-level 0) + siblings + task resolved-tasks) + (dolist (task tasks resolved-tasks) + (let* ((level (cdr (assoc "level" task))) + (depends (cdr (assoc "depends" task))) + (parent-ordered (cdr (assoc "parent-ordered" task))) + (blocker (cdr (assoc "BLOCKER" task))) + (blocked-on-previous + (and blocker (string-match "previous-sibling" blocker))) + (dependencies + (org-taskjuggler-resolve-explicit-dependencies + (append + (and depends (org-taskjuggler-tokenize-dependencies depends)) + (and blocker (org-taskjuggler-tokenize-dependencies blocker))) + tasks)) + previous-sibling) + ; update previous sibling info + (cond + ((< previous-level level) + (dotimes (tmp (- level previous-level)) + (push task siblings))) + ((= previous-level level) + (setq previous-sibling (car siblings)) + (setcar siblings task)) + ((> previous-level level) + (dotimes (tmp (- previous-level level)) + (pop siblings)) + (setq previous-sibling (car siblings)) + (setcar siblings task))) + ; insert a dependency on previous sibling if the parent is + ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling" + (when (or (and previous-sibling parent-ordered) blocked-on-previous) + (push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies)) + ; store dependency information + (when dependencies + (push (cons "depends" (mapconcat 'identity dependencies ", ")) task)) + (setq previous-level level) + (setq resolved-tasks (append resolved-tasks (list task))))))) + +(defun org-taskjuggler-tokenize-dependencies (dependencies) + "Split a dependency property value DEPENDENCIES into the +individual dependencies and return them as a list while keeping +the optional arguments (such as gapduration) for the +dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'." + (cond + ((string-match "^ *$" dependencies) nil) + ((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies) + (cons + (substring dependencies (match-beginning 1) (match-end 1)) + (org-taskjuggler-tokenize-dependencies (substring dependencies (match-end 0))))) + (t (error (format "invalid dependency id %s" dependencies))))) + +(defun org-taskjuggler-resolve-explicit-dependencies (dependencies tasks) + "For each dependency in DEPENDENCIES try to find a +corresponding task with a matching property \"task_id\" in TASKS. +Return a list containing the resolved links for all DEPENDENCIES +where a matching tasks was found. If the dependency is +\"previous-sibling\" it is ignored (as this is dealt with in +`org-taskjuggler-resolve-dependencies'). If there is no matching +task the dependency is ignored and a warning is displayed ." + (unless (null dependencies) + (let* + ;; the dependency might have optional attributes such as "{ + ;; gapduration 5d }", so only use the first string as id for the + ;; dependency + ((dependency (car dependencies)) + (id (car (split-string dependency))) + (optional-attributes + (mapconcat 'identity (cdr (split-string dependency)) " ")) + (path (org-taskjuggler-find-task-with-id id tasks))) + (cond + ;; ignore previous sibling dependencies + ((equal (car dependencies) "previous-sibling") + (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)) + ;; if the id is found in another task use its path + ((not (null path)) + (cons (mapconcat 'identity (list path optional-attributes) " ") + (org-taskjuggler-resolve-explicit-dependencies + (cdr dependencies) tasks))) + ;; warn about dangling dependency but otherwise ignore it + (t (display-warning + 'org-export-taskjuggler + (format "No task with matching property \"task_id\" found for id %s" id)) + (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)))))) + +(defun org-taskjuggler-find-task-with-id (id tasks) + "Find ID in tasks. If found return the path of task. Otherwise +return nil." + (let ((task-id (cdr (assoc "task_id" (car tasks)))) + (path (cdr (assoc "path" (car tasks))))) + (cond + ((null tasks) nil) + ((equal task-id id) path) + (t (org-taskjuggler-find-task-with-id id (cdr tasks)))))) + +(defun org-taskjuggler-get-unique-id (item unique-ids) + "Return a unique id for an ITEM which can be a task or a resource. +The id is derived from the headline and made unique against +UNIQUE-IDS. If the (downcased) first token of the headline is not +unique try to add more (downcased) tokens of the headline or +finally add more underscore characters (\"_\")." + (let* ((headline (cdr (assoc "headline" item))) + (parts (split-string headline)) + (id (org-taskjuggler-clean-id (downcase (pop parts))))) + ; try to add more parts of the headline to make it unique + (while (and (member id unique-ids) (car parts)) + (setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts)))))) + ; if its still not unique add "_" + (while (member id unique-ids) + (setq id (concat id "_"))) + id)) + +(defun org-taskjuggler-clean-id (id) + "Clean and return ID to make it acceptable for taskjuggler." + (and id (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" id))) + +(defun org-taskjuggler-open-project (project) + "Insert the beginning of a project declaration. All valid +attributes from the PROJECT alist are inserted. If no end date is +specified it is calculated +`org-export-taskjuggler-default-project-duration' days from now." + (let* ((unique-id (cdr (assoc "unique-id" project))) + (headline (cdr (assoc "headline" project))) + (version (cdr (assoc "version" project))) + (start (cdr (assoc "start" project))) + (end (cdr (assoc "end" project)))) + (insert + (format "project %s \"%s\" \"%s\" %s +%sd {\n }\n" + unique-id headline version start + org-export-taskjuggler-default-project-duration)))) + +(defun org-taskjuggler-filter-and-join (items) + "Filter all nil elements from ITEMS and join the remaining ones +with separator \"\n\"." + (let ((filtered-items (remq nil items))) + (and filtered-items (mapconcat 'identity filtered-items "\n")))) + +(defun org-taskjuggler-get-attributes (item attributes) + "Return all attribute as a single formated string. ITEM is an +alist representing either a resource or a task. ATTRIBUTES is a +list of symbols. Only entries from ITEM are considered that are +listed in ATTRIBUTES." + (org-taskjuggler-filter-and-join + (mapcar + (lambda (attribute) + (org-taskjuggler-filter-and-join + (org-taskjuggler-get-attribute item attribute))) + attributes))) + +(defun org-taskjuggler-get-attribute (item attribute) + "Return a list of strings containing the properly formatted +taskjuggler declaration for a given ATTRIBUTE in ITEM (an alist). +If the ATTRIBUTE is not in ITEM return nil." + (cond + ((null item) nil) + ((equal (symbol-name attribute) (car (car item))) + (cons (format "%s %s" (symbol-name attribute) (cdr (car item))) + (org-taskjuggler-get-attribute (cdr item) attribute))) + (t (org-taskjuggler-get-attribute (cdr item) attribute)))) + +(defun org-taskjuggler-open-resource (resource) + "Insert the beginning of a resource declaration. All valid +attributes from the RESOURCE alist are inserted. If the RESOURCE +defines a property \"resource_id\" it will be used as the id for +this resource. Otherwise it will use the ID property. If neither +is defined it will calculate a unique id for the resource using +`org-taskjuggler-get-unique-id'." + (let ((id (org-taskjuggler-clean-id + (or (cdr (assoc "resource_id" resource)) + (cdr (assoc "ID" resource)) + (cdr (assoc "unique-id" resource))))) + (headline (cdr (assoc "headline" resource))) + (attributes '(limits vacation shift booking efficiency journalentry rate))) + (insert + (concat + "resource " id " \"" headline "\" {\n " + (org-taskjuggler-get-attributes resource attributes) "\n")))) + +(defun org-taskjuggler-clean-effort (effort) + "Translate effort strings into a format acceptable to taskjuggler, +i.e. REAL UNIT. If the effort string is something like 5:30 it +will be assumed to be hours and will be translated into 5.5h. +Otherwise if it contains something like 3.0 it is assumed to be +days and will be translated into 3.0d. Other formats that +taskjuggler supports (like weeks, months and years) are currently +not supported." + (cond + ((null effort) effort) + ((string-match "\\([0-9]+\\):\\([0-9]+\\)" effort) + (let ((hours (string-to-number (match-string 1 effort))) + (minutes (string-to-number (match-string 2 effort)))) + (format "%dh" (+ hours (/ minutes 60.0))))) + ((string-match "\\([0-9]+\\).\\([0-9]+\\)" effort) (concat effort "d")) + (t (error "Not a valid effort (%s)" effort)))) + +(defun org-taskjuggler-get-priority (priority) + "Return a priority between 1 and 1000 based on PRIORITY, an +org-mode priority string." + (max 1 (/ (* 1000 (- org-lowest-priority (string-to-char priority))) + (- org-lowest-priority org-highest-priority)))) + +(defun org-taskjuggler-open-task (task) + (let* ((unique-id (cdr (assoc "unique-id" task))) + (headline (cdr (assoc "headline" task))) + (effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task)))) + (depends (cdr (assoc "depends" task))) + (allocate (cdr (assoc "allocate" task))) + (priority-raw (cdr (assoc "PRIORITY" task))) + (priority (and priority-raw (org-taskjuggler-get-priority priority-raw))) + (state (cdr (assoc "TODO" task))) + (complete (or (and (member state org-done-keywords) "100") + (cdr (assoc "complete" task)))) + (parent-ordered (cdr (assoc "parent-ordered" task))) + (previous-sibling (cdr (assoc "previous-sibling" task))) + (attributes + '(account start note duration endbuffer endcredit end + flags journalentry length maxend maxstart milestone + minend minstart period reference responsible + scheduling startbuffer startcredit statusnote))) + (insert + (concat + "task " unique-id " \"" headline "\" {\n" + (if (and parent-ordered previous-sibling) + (format " depends %s\n" previous-sibling) + (and depends (format " depends %s\n" depends))) + (and allocate (format " purge allocations\n allocate %s\n" allocate)) + (and complete (format " complete %s\n" complete)) + (and effort (format " effort %s\n" effort)) + (and priority (format " priority %s\n" priority)) + + (org-taskjuggler-get-attributes task attributes) + "\n")))) + +(defun org-taskjuggler-close-maybe (level) + (while (> org-export-taskjuggler-old-level level) + (insert "}\n") + (setq org-export-taskjuggler-old-level (1- org-export-taskjuggler-old-level))) + (when (= org-export-taskjuggler-old-level level) + (insert "}\n"))) + +(defun org-taskjuggler-insert-reports () + (let (report) + (dolist (report org-export-taskjuggler-default-reports) + (insert report "\n")))) + +(provide 'org-taskjuggler) + +;;; org-taskjuggler.el ends here diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index 3d869c3bdeb..ccac0790af3 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -27,9 +27,11 @@ ;; This file contains the relative timer code for Org-mode +;;; Code: + (require 'org) -(declare-function org-show-notification "org-clock" (parameters)) +(declare-function org-notify "org-clock" (notification &optional play-sound)) (declare-function org-agenda-error "org-agenda" ()) (defvar org-timer-start-time nil @@ -48,6 +50,30 @@ the value of the relative timer." :group 'org-time :type 'string) +(defcustom org-timer-default-timer 0 + "The default timer when a timer is set. +When 0, the user is prompted for a value." + :group 'org-time + :type 'number) + +(defvar org-timer-start-hook nil + "Hook run after relative timer is started.") + +(defvar org-timer-stop-hook nil + "Hook run before relative timer is stopped.") + +(defvar org-timer-pause-hook nil + "Hook run before relative timer is paused.") + +(defvar org-timer-set-hook nil + "Hook run after countdown timer is set.") + +(defvar org-timer-done-hook nil + "Hook run after countdown timer reaches zero.") + +(defvar org-timer-cancel-hook nil + "Hook run before countdown timer is canceled.") + ;;;###autoload (defun org-timer-start (&optional offset) "Set the starting time for the relative timer to now. @@ -78,14 +104,16 @@ the region 0:00:00." (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) (setq org-timer-start-time (seconds-to-time - (- (org-float-time) (org-timer-hms-to-secs s))))) + (- (org-float-time) delta)))) (org-timer-set-mode-line 'on) (message "Timer start time set to %s, current value is %s" (format-time-string "%T" org-timer-start-time) - (org-timer-secs-to-hms (or delta 0)))))) + (org-timer-secs-to-hms (or delta 0))) + (run-hooks 'org-timer-start-hook)))) (defun org-timer-pause-or-continue (&optional stop) - "Pause or continue the relative timer. With prefix arg, stop it entirely." + "Pause or continue the relative timer. +With prefix arg STOP, stop it entirely." (interactive "P") (cond (stop (org-timer-stop)) @@ -103,6 +131,7 @@ the region 0:00:00." (message "Timer continues at %s" (org-timer-value-string))) (t ;; pause timer + (run-hooks 'org-timer-pause-hook) (setq org-timer-pause-time (current-time)) (org-timer-set-mode-line 'pause) (message "Timer paused at %s" (org-timer-value-string))))) @@ -110,29 +139,39 @@ the region 0:00:00." (defun org-timer-stop () "Stop the relative timer." (interactive) + (run-hooks 'org-timer-stop-hook) (setq org-timer-start-time nil org-timer-pause-time nil) (org-timer-set-mode-line 'off)) ;;;###autoload -(defun org-timer (&optional restart) +(defun org-timer (&optional restart no-insert-p) "Insert a H:MM:SS string from the timer into the buffer. The first time this command is used, the timer is started. When used with -a `C-u' prefix, force restarting the timer. -When used with a double prefix arg `C-u C-u', change all the timer string +a \\[universal-argument] prefix, force restarting the timer. +When used with a double prefix argument \\[universal-argument], change all the timer string in the region by a fixed amount. This can be used to recalibrate a timer -that was not started at the correct moment." +that was not started at the correct moment. + +If NO-INSERT-P is non-nil, return the string instead of inserting +it in the buffer." (interactive "P") - (if (equal restart '(4)) (org-timer-start)) - (or org-timer-start-time (org-timer-start)) - (insert (org-timer-value-string))) + (when (or (equal restart '(4)) (not org-timer-start-time)) + (org-timer-start)) + (if no-insert-p + (org-timer-value-string) + (insert (org-timer-value-string)))) (defun org-timer-value-string () (format org-timer-format (org-timer-secs-to-hms (floor (org-timer-seconds))))) +(defvar org-timer-timer-is-countdown nil) (defun org-timer-seconds () - (- (org-float-time (or org-timer-pause-time (current-time))) - (org-float-time org-timer-start-time))) + (if org-timer-timer-is-countdown + (- (org-float-time org-timer-start-time) + (org-float-time (current-time))) + (- (org-float-time (or org-timer-pause-time (current-time))) + (org-float-time org-timer-start-time)))) ;;;###autoload (defun org-timer-change-times-in-region (beg end delta) @@ -164,19 +203,22 @@ that was not started at the correct moment." (defun org-timer-item (&optional arg) "Insert a description-type item with the current timer value." (interactive "P") - (let ((ind 0)) - (save-excursion - (skip-chars-backward " \n\t") - (condition-case nil - (progn - (org-beginning-of-item) - (setq ind (org-get-indentation))) - (error nil))) - (or (bolp) (newline)) - (org-indent-line-to ind) - (insert "- ") - (org-timer (if arg '(4))) - (insert ":: "))) + (cond + ;; In a timer list, insert with `org-list-insert-item-generic'. + ((and (org-in-item-p) + (save-excursion (org-beginning-of-item) (org-at-item-timer-p))) + (org-list-insert-item-generic + (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) + ;; In a list of another type, don't break anything: throw an error. + ((org-in-item-p) + (error "This is not a timer list")) + ;; Else, insert the timer correctly indented at bol. + (t + (beginning-of-line) + (org-indent-line-function) + (insert "- ") + (org-timer (when arg '(4))) + (insert ":: ")))) (defun org-timer-fix-incomplete (hms) "If hms is a H:MM:SS string with missing hour or hour and minute, fix it." @@ -254,45 +296,59 @@ VALUE can be `on', `off', or `pause'." (concat " <" (substring (org-timer-value-string) 0 -1) ">")) (force-mode-line-update))) -(defvar org-timer-timer1 nil) -(defvar org-timer-timer2 nil) -(defvar org-timer-timer3 nil) -(defvar org-timer-last-timer nil) - -(defun org-timer-cancel-timers () - "Reset all timers." +(defvar org-timer-current-timer nil) +(defun org-timer-cancel-timer () + "Cancel the current timer." (interactive) - (mapc (lambda(timer) - (when (eval timer) - (cancel-timer timer) - (setq timer nil))) - '(org-timer-timer1 - org-timer-timer2 - org-timer-timer3)) - (message "All timers reset")) + (when (eval org-timer-current-timer) + (run-hooks 'org-timer-cancel-hook) + (cancel-timer org-timer-current-timer) + (setq org-timer-current-timer nil) + (setq org-timer-timer-is-countdown nil) + (org-timer-set-mode-line 'off)) + (message "Last timer canceled")) (defun org-timer-show-remaining-time () "Display the remaining time before the timer ends." (interactive) (require 'time) - (if (and (not org-timer-timer1) - (not org-timer-timer2) - (not org-timer-timer3)) + (if (not org-timer-current-timer) (message "No timer set") (let* ((rtime (decode-time - (time-subtract (timer--time org-timer-last-timer) + (time-subtract (timer--time org-timer-current-timer) (current-time)))) (rsecs (nth 0 rtime)) (rmins (nth 1 rtime))) - (message "%d minutes %d seconds left before next time out" + (message "%d minute(s) %d seconds left before next time out" rmins rsecs)))) ;;;###autoload -(defun org-timer-set-timer (minutes) - "Set a timer." - (interactive "sTime out in (min)? ") - (if (not (string-match "[0-9]+" minutes)) - (org-timer-show-remaining-time) +(defun org-timer-set-timer (&optional opt) + "Prompt for a duration and set a timer. + +If `org-timer-default-timer' is not zero, suggest this value as +the default duration for the timer. If a timer is already set, +prompt the user if she wants to replace it. + +Called with a numeric prefix argument, use this numeric value as +the duration of the timer. + +Called with a `C-u' prefix arguments, use `org-timer-default-timer' +without prompting the user for a duration. + +With two `C-u' prefix arguments, use `org-timer-default-timer' +without prompting the user for a duration and automatically +replace any running timer." + (interactive "P") + (let ((minutes (or (and (numberp opt) (number-to-string opt)) + (and (listp opt) (not (null opt)) + (number-to-string org-timer-default-timer)) + (read-from-minibuffer + "How many minutes left? " + (if (not (eq org-timer-default-timer 0)) + (number-to-string org-timer-default-timer)))))) + (if (not (string-match "[0-9]+" minutes)) + (org-timer-show-remaining-time) (let* ((mins (string-to-number (match-string 0 minutes))) (secs (* mins 60)) (hl (cond @@ -306,21 +362,35 @@ VALUE can be `on', `off', or `pause'." (widen) (goto-char pos) (org-show-entry) - (org-get-heading)))) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))))) ((eq major-mode 'org-mode) - (org-get-heading)) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))) (t (error "Not in an Org buffer")))) timer-set) - (mapcar (lambda(timer) - (when (not (or (eval timer) timer-set)) - (setq timer-set t) - (setq org-timer-last-timer - (run-with-timer - secs nil 'org-notify (format "%s: time out" hl) t)) - (set timer org-timer-last-timer))) - '(org-timer-timer1 - org-timer-timer2 - org-timer-timer3))))) + (if (or (and org-timer-current-timer + (or (equal opt '(16)) + (y-or-n-p "Replace current timer? "))) + (not org-timer-current-timer)) + (progn + (require 'org-clock) + (when org-timer-current-timer + (cancel-timer org-timer-current-timer)) + (setq org-timer-current-timer + (run-with-timer + secs nil `(lambda () + (setq org-timer-current-timer nil) + (org-notify ,(format "%s: time out" hl) t) + (setq org-timer-timer-is-countdown nil) + (org-timer-set-mode-line 'off) + (run-hooks 'org-timer-done-hook)))) + (run-hooks 'org-timer-set-hook) + (setq org-timer-timer-is-countdown t + org-timer-start-time + (time-add (current-time) (seconds-to-time (* mins 60)))) + (org-timer-set-mode-line 'on)) + (message "No timer set")))))) (provide 'org-timer) diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el index 4e49ffdaa26..f1fbca7aaa1 100644 --- a/lisp/org/org-vm.el +++ b/lisp/org/org-vm.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -66,9 +66,19 @@ (to (vm-get-header-contents message "To")) (from (vm-get-header-contents message "From")) (message-id (vm-su-message-id message)) + (date (vm-get-header-contents message "Date")) + (date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) desc link) (org-store-link-props :type "vm" :from from :to to :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (setq message-id (org-remove-angle-brackets message-id)) (setq folder (abbreviate-file-name folder)) (if (and vm-folder-directory diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index d370b564f6b..759f6eefd63 100644 --- a/lisp/org/org-w3m.el +++ b/lisp/org/org-w3m.el @@ -5,7 +5,7 @@ ;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -28,11 +28,11 @@ ;; This file implements copying HTML content from a w3m buffer and ;; transforming the text on the fly so that it can be pasted into ;; an org-mode buffer with hot links. It will also work for regions -;; in gnus buffers that have ben washed with w3m. +;; in gnus buffers that have been washed with w3m. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -;;; Acknowledgements: +;;; Acknowledgments: ;; Richard Riley <rileyrgdev at googlemail dot com> ;; @@ -40,8 +40,9 @@ ;; proposed by Richard, I'm just coding it. ;; +;;; Code: + (require 'org) -(declare-function w3m-anchor "ext:w3m-util" (position)) (defun org-w3m-copy-for-org-mode () "Copy current buffer content or active region with `org-mode' style links. @@ -68,7 +69,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." ;; store current point before jump next anchor (setq temp-position (point)) ;; move to next anchor when current point is not at anchor - (or (w3m-anchor (point)) (org-w3m-get-next-link-start)) + (or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start)) (if (<= (point) transform-end) ; if point is inside transform bound (progn ;; get content between two links. @@ -77,7 +78,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (buffer-substring temp-position (point))))) ;; get link location at current point. - (setq link-location (w3m-anchor (point))) + (setq link-location (get-text-property (point) 'w3m-href-anchor)) ;; get link title at current point. (setq link-title (buffer-substring (point) (org-w3m-get-anchor-end))) @@ -115,7 +116,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (while (next-single-property-change (point) 'w3m-anchor-sequence) ;; jump to next anchor (goto-char (next-single-property-change (point) 'w3m-anchor-sequence)) - (when (w3m-anchor (point)) + (when (get-text-property (point) 'w3m-href-anchor) ;; return point when current is valid link (throw 'reach nil)))) (point)) @@ -126,7 +127,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (while (previous-single-property-change (point) 'w3m-anchor-sequence) ;; jump to previous anchor (goto-char (previous-single-property-change (point) 'w3m-anchor-sequence)) - (when (w3m-anchor (point)) + (when (get-text-property (point) 'w3m-href-anchor) ;; return point when current is valid link (throw 'reach nil)))) (point)) diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index 47df0aacde6..3b1c895f2b0 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -4,9 +4,10 @@ ;; Free Software Foundation, Inc. ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> +;; David Maus <dmaus at ictsoc dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -40,9 +41,36 @@ :group 'org-link) (defcustom org-wl-link-to-refile-destination t - "Create a link to the refile destination if the message is marked as refile." - :group 'org-wl - :type 'boolean) + "Create a link to the refile destination if the message is marked as refile." + :group 'org-wl + :type 'boolean) + +(defcustom org-wl-link-remove-filter nil + "Remove filter condition if message is filter folder." + :group 'org-wl + :type 'boolean) + +(defcustom org-wl-shimbun-prefer-web-links nil + "If non-nil create web links for shimbun messages." + :group 'org-wl + :type 'boolean) + +(defcustom org-wl-nntp-prefer-web-links nil + "If non-nil create web links for nntp messages. +When folder name contains string \"gmane\" link to gmane, +googlegroups otherwise." + :type 'boolean + :group 'org-wl) + +(defcustom org-wl-disable-folder-check t + "Disable check for new messages when open a link." + :type 'boolean + :group 'org-wl) + +(defcustom org-wl-namazu-default-index nil + "Default namazu search index." + :type 'directory + :group 'org-wl) ;; Declare external functions and variables (declare-function elmo-folder-exists-p "ext:elmo" (folder) t) @@ -56,6 +84,8 @@ (declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t) (declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) +(declare-function wl-summary-jump-to-msg "ext:wl-summary" + (&optional number beg end)) (declare-function wl-summary-line-from "ext:wl-summary" ()) (declare-function wl-summary-line-subject "ext:wl-summary" ()) (declare-function wl-summary-message-number "ext:wl-summary" ()) @@ -63,80 +93,220 @@ (declare-function wl-summary-registered-temp-mark "ext:wl-action" (number)) (declare-function wl-folder-goto-folder-subr "ext:wl-folder" (&optional folder sticky)) +(declare-function wl-folder-get-petname "ext:wl-folder" (name)) +(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder" + (&optional getid)) +(declare-function wl-folder-buffer-group-p "ext:wl-folder") (defvar wl-init) (defvar wl-summary-buffer-elmo-folder) (defvar wl-summary-buffer-folder-name) +(defvar wl-folder-group-regexp) +(defvar wl-auto-check-folder-name) +(defvar elmo-nntp-default-server) + +(defconst org-wl-folder-types + '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool) + ("$" . archive) ("&" . pop) ("@" . shimbun) ("[" . search) + ("*" . multi) ("/" . filter) ("|" . pipe) ("'" . internal)) + "List of folder indicators. See Wanderlust manual, section 3.") ;; Install the link type (org-add-link-type "wl" 'org-wl-open) (add-hook 'org-store-link-functions 'org-wl-store-link) ;; Implementation + +(defun org-wl-folder-type (folder) + "Return symbol that indicates the type of FOLDER. +FOLDER is the wanderlust folder name. The first character of the +folder name determines the the folder type." + (let* ((indicator (substring folder 0 1)) + (type (cdr (assoc indicator org-wl-folder-types)))) + ;; maybe access or file folder + (when (not type) + (setq type + (cond + ((and (>= (length folder) 5) + (string= (substring folder 0 5) "file:")) + 'file) + ((and (>= (length folder) 7) + (string= (substring folder 0 7) "access:")) + 'access) + (t + nil)))) + type)) + +(defun org-wl-message-field (field entity) + "Return content of FIELD in ENTITY. +FIELD is a symbol of a rfc822 message header field. +ENTITY is a message entity." + (let ((content (elmo-message-entity-field entity field 'string))) + (if (listp content) (car content) content))) + (defun org-wl-store-link () - "Store a link to a WL folder or message." - (when (eq major-mode 'wl-summary-mode) - (let* ((msgnum (wl-summary-message-number)) - (mark-info (wl-summary-registered-temp-mark msgnum)) - (folder-name - (if (and org-wl-link-to-refile-destination - mark-info - (equal (nth 1 mark-info) "o")) ; marked as refile - (nth 2 mark-info) - wl-summary-buffer-folder-name)) - (message-id (elmo-message-field wl-summary-buffer-elmo-folder - msgnum 'message-id)) - (wl-message-entity - (if (fboundp 'elmo-message-entity) - (elmo-message-entity - wl-summary-buffer-elmo-folder msgnum) - (elmo-msgdb-overview-get-entity - msgnum (wl-summary-buffer-msgdb)))) - (from (let ((from-field (elmo-message-entity-field wl-message-entity - 'from))) - (if (listp from-field) - (car from-field) - from-field))) - (to (let ((to-field (elmo-message-entity-field wl-message-entity - 'to))) - (if (listp to-field) - (car to-field) - to-field))) - (subject (let (wl-thr-indent-string wl-parent-message-entity) - (wl-summary-line-subject))) - desc link) - (org-store-link-props :type "wl" :from from :to to - :subject subject :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq desc (org-email-link-description)) - (setq link (org-make-link "wl:" folder-name - "#" message-id)) - (org-add-link-props :link link :description desc) - link))) + "Store a link to a WL message or folder." + (unless (eobp) + (cond + ((memq major-mode '(wl-summary-mode mime-view-mode)) + (org-wl-store-link-message)) + ((eq major-mode 'wl-folder-mode) + (org-wl-store-link-folder)) + (t + nil)))) + +(defun org-wl-store-link-folder () + "Store a link to a WL folder." + (let* ((folder (wl-folder-get-entity-from-buffer)) + (petname (wl-folder-get-petname folder)) + (link (org-make-link "wl:" folder))) + (save-excursion + (beginning-of-line) + (unless (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) + (org-store-link-props :type "wl" :description petname + :link link) + link)))) + +(defun org-wl-store-link-message () + "Store a link to a WL message." + (save-excursion + (let ((buf (if (eq major-mode 'wl-summary-mode) + (current-buffer) + (and (boundp 'wl-message-buffer-cur-summary-buffer) + wl-message-buffer-cur-summary-buffer)))) + (when buf + (with-current-buffer buf + (let* ((msgnum (wl-summary-message-number)) + (mark-info (wl-summary-registered-temp-mark msgnum)) + (folder-name + (if (and org-wl-link-to-refile-destination + mark-info + (equal (nth 1 mark-info) "o")) ; marked as refile + (nth 2 mark-info) + wl-summary-buffer-folder-name)) + (folder-type (org-wl-folder-type folder-name)) + (wl-message-entity + (if (fboundp 'elmo-message-entity) + (elmo-message-entity + wl-summary-buffer-elmo-folder msgnum) + (elmo-msgdb-overview-get-entity + msgnum (wl-summary-buffer-msgdb)))) + (message-id + (org-wl-message-field 'message-id wl-message-entity)) + (message-id-no-brackets + (org-remove-angle-brackets message-id)) + (from (org-wl-message-field 'from wl-message-entity)) + (to (org-wl-message-field 'to wl-message-entity)) + (xref (org-wl-message-field 'xref wl-message-entity)) + (subject (org-wl-message-field 'subject wl-message-entity)) + (date (org-wl-message-field 'date wl-message-entity)) + (date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) + desc link) + + ;; remove text properties of subject string to avoid possible bug + ;; when formatting the subject + ;; (Emacs bug #5306, fixed) + (set-text-properties 0 (length subject) nil subject) + + ;; maybe remove filter condition + (when (and (eq folder-type 'filter) org-wl-link-remove-filter) + (while (eq (org-wl-folder-type folder-name) 'filter) + (setq folder-name + (replace-regexp-in-string "^/[^/]+/" "" folder-name)))) + + ;; maybe create http link + (cond + ((and (eq folder-type 'shimbun) + org-wl-shimbun-prefer-web-links xref) + (org-store-link-props :type "http" :link xref :description subject + :from from :to to :message-id message-id + :message-id-no-brackets message-id-no-brackets + :subject subject)) + ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links) + (setq link + (format + (if (string-match "gmane\\." folder-name) + "http://mid.gmane.org/%s" + "http://groups.google.com/groups/search?as_umsgid=%s") + (org-fixup-message-id-for-http message-id))) + (org-store-link-props :type "http" :link link :description subject + :from from :to to :message-id message-id + :message-id-no-brackets message-id-no-brackets + :subject subject)) + (t + (org-store-link-props :type "wl" :from from :to to + :subject subject :message-id message-id + :message-id-no-brackets message-id-no-brackets) + (setq desc (org-email-link-description)) + (setq link (org-make-link "wl:" folder-name "#" message-id-no-brackets)) + (org-add-link-props :link link :description desc))) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) + (or link xref))))))) + +(defun org-wl-open-nntp (path) + "Follow the nntp: link specified by PATH." + (let* ((spec (split-string path "/")) + (server (split-string (nth 2 spec) "@")) + (group (nth 3 spec)) + (article (nth 4 spec))) + (org-wl-open + (concat "-" group ":" (if (cdr server) + (car (split-string (car server) ":")) + "") + (if (string= elmo-nntp-default-server (nth 2 spec)) + "" + (concat "@" (or (cdr server) (car server)))) + (if article (concat "#" article) ""))))) (defun org-wl-open (path) - "Follow the WL message link specified by PATH." - (require 'wl) - (unless wl-init (wl)) - ;; XXX: The imap-uw's MH folder names start with "%#". - (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in Wanderlust link")) - (let ((folder (match-string 1 path)) - (article (match-string 3 path))) - (if (not (elmo-folder-exists-p (org-no-warnings - (wl-folder-get-elmo-folder folder)))) - (error "No such folder: %s" folder)) - (let ((old-buf (current-buffer)) - (old-point (point-marker))) - (wl-folder-goto-folder-subr folder) - (save-excursion - ;; XXX: `wl-folder-goto-folder-subr' moves point to the - ;; beginning of the current line. So, restore the point - ;; in the old buffer. - (set-buffer old-buf) - (goto-char old-point)) - (and (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets - article)) - (wl-summary-redisplay))))) + "Follow the WL message link specified by PATH. +When called with one prefix, open message in namazu search folder +with `org-wl-namazu-default-index' as search index. When called +with two prefixes or `org-wl-namazu-default-index' is nil, ask +for namazu index." + (require 'wl) + (let ((wl-auto-check-folder-name + (if org-wl-disable-folder-check + 'none + wl-auto-check-folder-name))) + (unless wl-init (wl)) + ;; XXX: The imap-uw's MH folder names start with "%#". + (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in Wanderlust link")) + (let ((folder (match-string 1 path)) + (article (match-string 3 path))) + ;; maybe open message in namazu search folder + (when current-prefix-arg + (setq folder (concat "[" article "]" + (if (and (equal current-prefix-arg '(4)) + org-wl-namazu-default-index) + org-wl-namazu-default-index + (read-directory-name "Namazu index: "))))) + (if (not (elmo-folder-exists-p (org-no-warnings + (wl-folder-get-elmo-folder folder)))) + (error "No such folder: %s" folder)) + (let ((old-buf (current-buffer)) + (old-point (point-marker))) + (wl-folder-goto-folder-subr folder) + (with-current-buffer old-buf + ;; XXX: `wl-folder-goto-folder-subr' moves point to the + ;; beginning of the current line. So, restore the point + ;; in the old buffer. + (goto-char old-point)) + (when article + (if (org-string-match-p "@" article) + (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets + article)) + (or (wl-summary-jump-to-msg (string-to-number article)) + (error "No such message: %s" article))) + (wl-summary-redisplay)))))) (provide 'org-wl) diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el index 8f131bbf788..f1ce87a2fb9 100644 --- a/lisp/org/org-xoxo.el +++ b/lisp/org/org-xoxo.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -25,10 +25,11 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: +;; XOXO export -(require 'org-exp) +;;; Code: -;;; XOXO export +(require 'org-exp) (defvar org-export-xoxo-final-hook nil "Hook run after XOXO export, in the new buffer.") @@ -43,6 +44,7 @@ "Export the org buffer as XOXO. The XOXO buffer is named *xoxo-<source buffer name>*" (interactive (list (current-buffer))) + (run-hooks 'org-export-first-hook) ;; A quickie abstraction ;; Output everything as XOXO diff --git a/lisp/org/org.el b/lisp/org/org.el index 6fe3c96bec2..33d01e48967 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -72,30 +72,123 @@ (eval-when-compile (require 'cl) - (require 'gnus-sum) - (require 'calendar)) -;; For XEmacs, noutline is not yet provided by outline.el, so arrange for -;; the file noutline.el being loaded. -(if (featurep 'xemacs) (condition-case nil (require 'noutline))) -;; We require noutline, which might be provided in outline.el + (require 'gnus-sum)) + +(require 'calendar) + +;; Emacs 22 calendar compatibility: Make sure the new variables are available +(when (fboundp 'defvaralias) + (unless (boundp 'calendar-view-holidays-initially-flag) + (defvaralias 'calendar-view-holidays-initially-flag + 'view-calendar-holidays-initially)) + (unless (boundp 'calendar-view-diary-initially-flag) + (defvaralias 'calendar-view-diary-initially-flag + 'view-diary-entries-initially)) + (unless (boundp 'diary-fancy-buffer) + (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))) + (require 'outline) (require 'noutline) ;; Other stuff we need. (require 'time-date) (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) (require 'easymenu) +(require 'overlay) (require 'org-macs) +(require 'org-entities) (require 'org-compat) (require 'org-faces) (require 'org-list) +(require 'org-complete) (require 'org-src) (require 'org-footnote) +;; babel +(require 'ob) +(require 'ob-table) +(require 'ob-lob) +(require 'ob-ref) +(require 'ob-tangle) +(require 'ob-comint) +(require 'ob-keys) + +;; load languages based on value of `org-babel-load-languages' +(defvar org-babel-load-languages) +;;;###autoload +(defun org-babel-do-load-languages (sym value) + "Load the languages defined in `org-babel-load-languages'." + (set-default sym value) + (mapc (lambda (pair) + (let ((active (cdr pair)) (lang (symbol-name (car pair)))) + (if active + (progn + (require (intern (concat "ob-" lang)))) + (progn + (funcall 'fmakunbound + (intern (concat "org-babel-execute:" lang))) + (funcall 'fmakunbound + (intern (concat "org-babel-expand-body:" lang))))))) + org-babel-load-languages)) + +(defcustom org-babel-load-languages '((emacs-lisp . t)) + "Languages which can be evaluated in Org-mode buffers. +This list can be used to load support for any of the languages +below, note that each language will depend on a different set of +system executables and/or Emacs modes. When a language is +\"loaded\", then code blocks in that language can be evaluated +with `org-babel-execute-src-block' bound by default to C-c +C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can +be set to remove code block evaluation from the C-c C-c +keybinding. By default only Emacs Lisp (which has no +requirements) is loaded." + :group 'org-babel + :set 'org-babel-do-load-languages + :type '(alist :tag "Babel Languages" + :key-type + (choice + (const :tag "C" C) + (const :tag "R" R) + (const :tag "Asymptote" asymptote) + (const :tag "Calc" calc) + (const :tag "Clojure" clojure) + (const :tag "CSS" css) + (const :tag "Ditaa" ditaa) + (const :tag "Dot" dot) + (const :tag "Emacs Lisp" emacs-lisp) + (const :tag "Gnuplot" gnuplot) + (const :tag "Haskell" haskell) + (const :tag "Javascript" js) + (const :tag "Latex" latex) + (const :tag "Ledger" ledger) + (const :tag "Matlab" matlab) + (const :tag "Mscgen" mscgen) + (const :tag "Ocaml" ocaml) + (const :tag "Octave" octave) + (const :tag "Org" org) + (const :tag "Perl" perl) + (const :tag "PlantUML" plantuml) + (const :tag "Python" python) + (const :tag "Ruby" ruby) + (const :tag "Sass" sass) + (const :tag "Scheme" scheme) + (const :tag "Screen" screen) + (const :tag "Shell Script" sh) + (const :tag "Sql" sql) + (const :tag "Sqlite" sqlite)) + :value-type (boolean :tag "Activate" :value t))) + ;;;; Customization variables +(defcustom org-clone-delete-id nil + "Remove ID property of clones of a subtree. +When non-nil, clones of a subtree don't inherit the ID property. +Otherwise they inherit the ID property with a new unique +identifier." + :type 'boolean + :group 'org-id) ;;; Version -(defconst org-version "6.33x" +(defconst org-version "7.4" "The version number of the file org.el.") (defun org-version (&optional here) @@ -134,7 +227,6 @@ With prefix arg HERE, insert it at point." "Outline-based notes management and organizer." :tag "Org" :group 'outlines - :group 'hypermedia :group 'calendar) (defcustom org-mode-hook nil @@ -170,7 +262,7 @@ With prefix arg HERE, insert it at point." (let ((a (member 'org-infojs org-modules))) (and a (setcar a 'org-jsinfo)))) -(defcustom org-modules '(org-bbdb org-bibtex org-gnus org-info org-jsinfo org-irc org-mew org-mhe org-rmail org-vm org-w3m org-wl) +(defcustom org-modules '(org-bbdb org-bibtex org-docview org-gnus org-info org-jsinfo org-irc org-mew org-mhe org-rmail org-vm org-w3m org-wl) "Modules that should always be loaded together with org.el. If a description starts with <C>, the file is not part of Emacs and loading it will require that you have downloaded and properly installed @@ -189,6 +281,8 @@ to add the symbol `xyz', and the package must have a call to (const :tag " bbdb: Links to BBDB entries" org-bbdb) (const :tag " bibtex: Links to BibTeX entries" org-bibtex) (const :tag " crypt: Encryption of subtrees" org-crypt) + (const :tag " ctags: Access to Emacs tags with links" org-ctags) + (const :tag " docview: Links to doc-view buffers" org-docview) (const :tag " gnus: Links to GNUS folders/messages" org-gnus) (const :tag " id: Global IDs for identifying entries" org-id) (const :tag " info: Links to Info nodes" org-info) @@ -205,6 +299,7 @@ to add the symbol `xyz', and the package must have a call to (const :tag " wl: Links to Wanderlust folders/messages" org-wl) (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) (const :tag " mouse: Additional mouse support" org-mouse) + (const :tag " TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler) (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark) @@ -226,24 +321,27 @@ to add the symbol `xyz', and the package must have a call to (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) + (const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber) (const :tag "C man: Support for links to manpages in Org-mode" org-man) (const :tag "C mtags: Support for muse-like tags" org-mtags) (const :tag "C panel: Simple routines for us with bad memory" org-panel) - (const :tag "C R: Computation using the R language" org-R) (const :tag "C registry: A registry for Org-mode links" org-registry) (const :tag "C org2rem: Convert org appointments into reminders" org2rem) (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) + (const :tag "C secretary: Team management with org-mode" org-secretary) (const :tag "C special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks) (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) (const :tag "C track: Keep up with Org-mode development" org-track) + (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) + (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) (defcustom org-support-shift-select nil - "Non-nil means, make shift-cursor commands select text when possible. + "Non-nil means make shift-cursor commands select text when possible. In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start -selecting a region, or enlarge thusly regions started in this way. +selecting a region, or enlarge regions started in this way. In Org-mode, in special contexts, these same keys are used for other purposes, important enough to compete with shift selection. Org tries to balance these needs by supporting `shift-select-mode' outside these @@ -288,7 +386,7 @@ is Emacs 23 only." :group 'org) (defcustom org-startup-folded t - "Non-nil means, entering Org-mode will switch to OVERVIEW. + "Non-nil means entering Org-mode will switch to OVERVIEW. This can also be configured on a per-file basis by adding one of the following lines anywhere in the buffer: @@ -304,14 +402,14 @@ the following lines anywhere in the buffer: (const :tag "show everything, even drawers" showeverything))) (defcustom org-startup-truncated t - "Non-nil means, entering Org-mode will set `truncate-lines'. + "Non-nil means entering Org-mode will set `truncate-lines'. This is useful since some lines containing links can be very long and uninteresting. Also tables look terrible when wrapped." :group 'org-startup :type 'boolean) (defcustom org-startup-indented nil - "Non-nil means, turn on `org-indent-mode' on startup. + "Non-nil means turn on `org-indent-mode' on startup. This can also be configured on a per-file basis by adding one of the following lines anywhere in the buffer: @@ -322,8 +420,51 @@ the following lines anywhere in the buffer: (const :tag "Not" nil) (const :tag "Globally (slow on startup in large files)" t))) +(defcustom org-use-sub-superscripts t + "Non-nil means interpret \"_\" and \"^\" for export. +When this option is turned on, you can use TeX-like syntax for sub- and +superscripts. Several characters after \"_\" or \"^\" will be +considered as a single item - so grouping with {} is normally not +needed. For example, the following things will be parsed as single +sub- or superscripts. + + 10^24 or 10^tau several digits will be considered 1 item. + 10^-12 or 10^-tau a leading sign with digits or a word + x^2-y^3 will be read as x^2 - y^3, because items are + terminated by almost any nonword/nondigit char. + x_{i^2} or x^(2-i) braces or parenthesis do grouping. + +Still, ambiguity is possible - so when in doubt use {} to enclose the +sub/superscript. If you set this variable to the symbol `{}', +the braces are *required* in order to trigger interpretations as +sub/superscript. This can be helpful in documents that need \"_\" +frequently in plain text. + +Not all export backends support this, but HTML does. + +This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." + :group 'org-startup + :group 'org-export-translation + :type '(choice + (const :tag "Always interpret" t) + (const :tag "Only with braces" {}) + (const :tag "Never interpret" nil))) + +(if (fboundp 'defvaralias) + (defvaralias 'org-export-with-sub-superscripts 'org-use-sub-superscripts)) + + +(defcustom org-startup-with-beamer-mode nil + "Non-nil means turn on `org-beamer-mode' on startup. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: beamer" + :group 'org-startup + :type 'boolean) + (defcustom org-startup-align-all-tables nil - "Non-nil means, align all tables when visiting a file. + "Non-nil means align all tables when visiting a file. This is useful when the column width in tables is forced with <N> cookies in table fields. Such tables will look correct only after the first re-align. This can also be configured on a per-file basis by adding one of @@ -333,6 +474,15 @@ the following lines anywhere in the buffer: :group 'org-startup :type 'boolean) +(defcustom org-startup-with-inline-images nil + "Non-nil means show inline images when loading a new Org file. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + #+STARTUP: inlineimages + #+STARTUP: noinlineimages" + :group 'org-startup + :type 'boolean) + (defcustom org-insert-mode-line-in-empty-file nil "Non-nil means insert the first line setting Org-mode in empty files. When the function `org-mode' is called interactively in an empty file, this @@ -360,10 +510,10 @@ become effective." :type 'boolean) (defcustom org-use-extra-keys nil - "Non-nil means use extra key sequence definitions for certain -commands. This happens automatically if you run XEmacs or if -window-system is nil. This variable lets you do the same -manually. You must set it before loading org. + "Non-nil means use extra key sequence definitions for certain commands. +This happens automatically if you run XEmacs or if `window-system' +is nil. This variable lets you do the same manually. You must +set it before loading org. Example: on Carbon Emacs 22 running graphically, with an external keyboard on a Powerbook, the default way of setting M-left might @@ -394,14 +544,17 @@ therefore you'll have to restart Emacs to apply it after changing." (defun org-key (key) "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. -Or return the original if not disputed." - (if org-replace-disputed-keys - (let* ((nkey (key-description key)) - (x (org-find-if (lambda (x) - (equal (key-description (car x)) nkey)) - org-disputed-keys))) - (if x (cdr x) key)) - key)) +Or return the original if not disputed. +Also apply the translations defined in `org-xemacs-key-equivalents'." + (when org-replace-disputed-keys + (let* ((nkey (key-description key)) + (x (org-find-if (lambda (x) + (equal (key-description (car x)) nkey)) + org-disputed-keys))) + (setq key (if x (cdr x) key)))) + (when (featurep 'xemacs) + (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key))) + key) (defun org-find-if (predicate seq) (catch 'exit @@ -514,7 +667,7 @@ After a match, group 1 contains the repeat expression.") "Contexts for the reveal options.") (defcustom org-show-hierarchy-above '((default . t)) - "Non-nil means, show full hierarchy when revealing a location. + "Non-nil means show full hierarchy when revealing a location. Org-mode often shows locations in an org-mode file which might have been invisible before. When this is set, the hierarchy of headings above the exposed location is shown. @@ -534,7 +687,7 @@ contexts. Valid contexts are :type org-context-choice) (defcustom org-show-following-heading '((default . nil)) - "Non-nil means, show following heading when revealing a location. + "Non-nil means show following heading when revealing a location. Org-mode often shows locations in an org-mode file which might have been invisible before. When this is set, the heading following the match is shown. @@ -547,7 +700,7 @@ contexts. See `org-show-hierarchy-above' for valid contexts." :type org-context-choice) (defcustom org-show-siblings '((default . nil) (isearch t)) - "Non-nil means, show all sibling heading when revealing a location. + "Non-nil means show all sibling heading when revealing a location. Org-mode often shows locations in an org-mode file which might have been invisible before. When this is set, the sibling of the current entry heading are all made visible. If `org-show-hierarchy-above' is t, @@ -563,7 +716,7 @@ contexts. See `org-show-hierarchy-above' for valid contexts." :type org-context-choice) (defcustom org-show-entry-below '((default . nil)) - "Non-nil means, show the entry below a headline when revealing a location. + "Non-nil means show the entry below a headline when revealing a location. Org-mode often shows locations in an org-mode file which might have been invisible before. When this is set, the text below the headline that is exposed is also shown. @@ -594,7 +747,7 @@ new-frame Make a new frame each time. Note that in this case (const :tag "One dedicated frame" dedicated-frame))) (defcustom org-use-speed-commands nil - "Non-nil means, activate single letter commands at beginning of a headline. + "Non-nil means activate single letter commands at beginning of a headline. This may also be a function to test for appropriate locations where speed commands should be active." :group 'org-structure @@ -614,7 +767,7 @@ The cdr is either a command to be called interactively, a function to be called, or a form to be evaluated. An entry that is just a list with a single string will be interpreted as a descriptive headline that will be added when listing the speed -copmmands in the Help buffer using the `?' speed command." +commands in the Help buffer using the `?' speed command." :group 'org-structure :type '(repeat :value ("k" . ignore) (choice :value ("k" . ignore) @@ -631,7 +784,7 @@ copmmands in the Help buffer using the `?' speed command." :group 'org-structure) (defcustom org-cycle-skip-children-state-if-no-children t - "Non-nil means, skip CHILDREN state in entries that don't have any." + "Non-nil means skip CHILDREN state in entries that don't have any." :group 'org-cycle :type 'boolean) @@ -668,7 +821,7 @@ Drawers can be defined on the per-file basis with a line like: :type '(repeat (string :tag "Drawer Name"))) (defcustom org-hide-block-startup nil - "Non-nil means, , entering Org-mode will fold all blocks. + "Non-nil means entering Org-mode will fold all blocks. This can also be set in on a per-file basis with #+STARTUP: hideblocks @@ -680,7 +833,8 @@ This can also be set in on a per-file basis with (defcustom org-cycle-global-at-bob nil "Cycle globally if cursor is at beginning of buffer and not at a headline. This makes it possible to do global cycling without having to use S-TAB or -C-u TAB. For this special case to work, the first line of the buffer +\\[universal-argument] TAB. For this special case to work, the first line \ +of the buffer must not be a headline - it may be empty or some other text. When used in this way, `org-cycle-hook' is disables temporarily, to make sure the cursor stays at the beginning of the buffer. @@ -690,11 +844,11 @@ of the buffer." :type 'boolean) (defcustom org-cycle-level-after-item/entry-creation t - "Non-nil means, cycle entry level or item indentation in new empty entries. + "Non-nil means cycle entry level or item indentation in new empty entries. When the cursor is at the end of an empty headline, i.e with only stars and maybe a TODO keyword, TAB will then switch the entry to become a child, -and then all possible anchestor states, before returning to the original state. +and then all possible ancestor states, before returning to the original state. This makes data entry extremely fast: M-RET to create a new headline, on TAB to make it a child, two or more tabs to make it a (grand-)uncle. @@ -727,7 +881,7 @@ If you leave an empty line between the end of a subtree and the following headline, this empty line is hidden when the subtree is folded. Org-mode will leave (exactly) one empty line visible if the number of empty lines is equal or larger to the number given in this variable. -So the default 2 means, at least 2 empty lines after the end of a subtree +So the default 2 means at least 2 empty lines after the end of a subtree are needed to produce free space between a collapsed subtree and the following headline. @@ -768,7 +922,7 @@ the values `folded', `children', or `subtree'." :group 'org-structure) (defcustom org-odd-levels-only nil - "Non-nil means, skip even levels and only use odd levels for the outline. + "Non-nil means skip even levels and only use odd levels for the outline. This has the effect that two stars are being added/taken away in promotion/demotion commands. It also influences how levels are handled by the exporters. @@ -780,11 +934,11 @@ lines to the buffer: #+STARTUP: odd #+STARTUP: oddeven" :group 'org-edit-structure - :group 'org-font-lock + :group 'org-appearance :type 'boolean) (defcustom org-adapt-indentation t - "Non-nil means, adapt indentation to outline node level. + "Non-nil means adapt indentation to outline node level. When this variable is set, Org assumes that you write outlines by indenting text in each node to align with the headline (after the stars). @@ -857,8 +1011,20 @@ When t, the following will happen while the cursor is in the headline: :group 'org-edit-structure :type 'boolean) +(defcustom org-ctrl-k-protect-subtree nil + "Non-nil means, do not delete a hidden subtree with C-k. +When set to the symbol `error', simply throw an error when C-k is +used to kill (part-of) a headline that has hidden text behind it. +Any other non-nil value will result in a query to the user, if it is +OK to kill that hidden subtree. When nil, kill without remorse." + :group 'org-edit-structure + :type '(choice + (const :tag "Do not protect hidden subtrees" nil) + (const :tag "Protect hidden subtrees with a security query" t) + (const :tag "Never kill a hidden subtree with C-k" error))) + (defcustom org-yank-folded-subtrees t - "Non-nil means, when yanking subtrees, fold them. + "Non-nil means when yanking subtrees, fold them. If the kill is a single subtree, or a sequence of subtrees, i.e. if it starts with a heading and all other headings in it are either children or siblings, then fold all the subtrees. However, do this only if no @@ -867,14 +1033,14 @@ text after the yank would be swallowed into a folded tree by this action." :type 'boolean) (defcustom org-yank-adjusted-subtrees nil - "Non-nil means, when yanking subtrees, adjust the level. + "Non-nil means when yanking subtrees, adjust the level. With this setting, `org-paste-subtree' is used to insert the subtree, see this function for details." :group 'org-edit-structure :type 'boolean) (defcustom org-M-RET-may-split-line '((default . t)) - "Non-nil means, M-RET will split the line at the cursor position. + "Non-nil means M-RET will split the line at the cursor position. When nil, it will go to the end of the line before making a new line. You may also set this option in a different way for different @@ -901,7 +1067,7 @@ default the value to be used for all contexts not explicitly (defcustom org-insert-heading-respect-content nil - "Non-nil means, insert new headings after the current subtree. + "Non-nil means insert new headings after the current subtree. When nil, the new heading is created directly after the current line. The commands \\[org-insert-heading-respect-content] and \\[org-insert-todo-heading-respect-content] turn this variable on @@ -913,9 +1079,13 @@ for the duration of the command." (plain-list-item . auto)) "Should `org-insert-heading' leave a blank line before new heading/item? The value is an alist, with `heading' and `plain-list-item' as car, -and a boolean flag as cdr. For plain lists, if the variable -`org-empty-line-terminates-plain-lists' is set, the setting here -is ignored and no empty line is inserted, to keep the list in tact." +and a boolean flag as cdr. The cdr may lso be the symbol `auto', and then +Org will look at the surrounding headings/items and try to make an +intelligent decision wether to insert a blank line or not. + +For plain lists, if the variable `org-empty-line-terminates-plain-lists' is +set, the setting here is ignored and no empty line is inserted, to avoid +breaking the list structure." :group 'org-edit-structure :type '(list (cons (const heading) @@ -933,16 +1103,15 @@ is ignored and no empty line is inserted, to keep the list in tact." :type 'hook) (defcustom org-enable-fixed-width-editor t - "Non-nil means, lines starting with \":\" are treated as fixed-width. -This currently only means, they are never auto-wrapped. + "Non-nil means lines starting with \":\" are treated as fixed-width. +This currently only means they are never auto-wrapped. When nil, such lines will be treated like ordinary lines. See also the QUOTE keyword." :group 'org-edit-structure :type 'boolean) - (defcustom org-goto-auto-isearch t - "Non-nil means, typing characters in org-goto starts incremental search." + "Non-nil means typing characters in `org-goto' starts incremental search." :group 'org-edit-structure :type 'boolean) @@ -952,14 +1121,14 @@ See also the QUOTE keyword." :group 'org-structure) (defcustom org-highlight-sparse-tree-matches t - "Non-nil means, highlight all matches that define a sparse tree. + "Non-nil means highlight all matches that define a sparse tree. The highlights will automatically disappear the next time the buffer is changed by an edit command." :group 'org-sparse-trees :type 'boolean) (defcustom org-remove-highlights-with-change t - "Non-nil means, any change to the buffer will remove temporary highlights. + "Non-nil means any change to the buffer will remove temporary highlights. Such highlights are created by `org-occur' and `org-clock-display'. When nil, `C-c C-c needs to be used to get rid of the highlights. The highlights created by `org-preview-latex-fragment' always need @@ -993,7 +1162,7 @@ This also applied for speedbar access." :group 'org) (defcustom org-enable-table-editor 'optimized - "Non-nil means, lines starting with \"|\" are handled by the table editor. + "Non-nil means lines starting with \"|\" are handled by the table editor. When nil, such lines will be treated like ordinary lines. When equal to the symbol `optimized', the table editor will be optimized to @@ -1032,7 +1201,7 @@ This is configurable, because there is some impact on typing performance." :type 'boolean) (defcustom org-table-tab-recognizes-table.el t - "Non-nil means, TAB will automatically notice a table.el table. + "Non-nil means TAB will automatically notice a table.el table. When it sees such a table, it moves point into it and - if necessary - calls `table-recognize-table'." :group 'org-table-editing @@ -1077,7 +1246,7 @@ See the manual for examples." (function))))) (defcustom org-descriptive-links t - "Non-nil means, hide link part and only show description of bracket links. + "Non-nil means hide link part and only show description of bracket links. Bracket links are like [[link][description]]. This variable sets the initial state in new org-mode buffers. The setting can then be toggled on a per-buffer basis from the Org->Hyperlinks menu." @@ -1108,7 +1277,7 @@ type. In principle, it does not hurt to turn on most link types - there may be a small gain when turning off unused link types. The types are: bracket The recommended [[link][description]] or [[link]] links with hiding. -angular Links in angular brackets that may contain whitespace like +angle Links in angular brackets that may contain whitespace like <bbdb:Carsten Dominik>. plain Plain links in normal text, no whitespace, like http://google.com. radio Text that is matched by a radio target, see manual for details. @@ -1119,8 +1288,8 @@ footnote Footnote labels. Changing this variable requires a restart of Emacs to become effective." :group 'org-link :type '(set :greedy t - (const :tag "Double bracket links (new style)" bracket) - (const :tag "Angular bracket links (old style)" angular) + (const :tag "Double bracket links" bracket) + (const :tag "Angular bracket links" angle) (const :tag "Plain text links" plain) (const :tag "Radio target matches" radio) (const :tag "Tags" tag) @@ -1128,11 +1297,11 @@ Changing this variable requires a restart of Emacs to become effective." (const :tag "Footnotes" footnote))) (defcustom org-make-link-description-function nil - "Function to use to generate link descriptions from links. If -nil the link location will be used. This function must take two -parameters; the first is the link and the second the description -org-insert-link has generated, and should return the description -to use." + "Function to use to generate link descriptions from links. +If nil the link location will be used. This function must take +two parameters; the first is the link and the second the +description `org-insert-link' has generated, and should return the +description to use." :group 'org-link :type 'function) @@ -1174,7 +1343,7 @@ It should match if the message is from the user him/herself." :type 'regexp) (defcustom org-link-to-org-use-id 'create-if-interactive-and-no-custom-id - "Non-nil means, storing a link to an Org file will use entry IDs. + "Non-nil means storing a link to an Org file will use entry IDs. Note that before this variable is even considered, org-id must be loaded, so please customize `org-modules' and turn it on. @@ -1214,17 +1383,20 @@ nil Never use an ID to make a link, instead link using a text search for (const :tag "Do not use ID to create link" nil))) (defcustom org-context-in-file-links t - "Non-nil means, file links from `org-store-link' contain context. + "Non-nil means file links from `org-store-link' contain context. A search string will be added to the file name with :: as separator and -used to find the context when the link is activated by the command -`org-open-at-point'. +used to find the context when the link is activated by the command +`org-open-at-point'. When this option is t, the entire active region +will be placed in the search string of the file link. If set to a +positive integer, only the first n lines of context will be stored. + Using a prefix arg to the command \\[org-store-link] (`org-store-link') negates this setting for the duration of the command." :group 'org-link-store - :type 'boolean) + :type '(choice boolean integer)) (defcustom org-keep-stored-link-after-insertion nil - "Non-nil means, keep link in list for entire session. + "Non-nil means keep link in list for entire session. The command `org-store-link' adds a link pointing to the current location to an internal list. These links accumulate during a session. @@ -1261,7 +1433,7 @@ links created by planner." :type 'hook) (defcustom org-tab-follows-link nil - "Non-nil means, on links TAB will follow the link. + "Non-nil means on links TAB will follow the link. Needs to be set before org.el is loaded. This really should not be used, it does not make sense, and the implementation is bad." @@ -1269,29 +1441,40 @@ implementation is bad." :type 'boolean) (defcustom org-return-follows-link nil - "Non-nil means, on links RET will follow the link. -Needs to be set before org.el is loaded." + "Non-nil means on links RET will follow the link." :group 'org-link-follow :type 'boolean) (defcustom org-mouse-1-follows-link (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) - "Non-nil means, mouse-1 on a link will follow the link. + "Non-nil means mouse-1 on a link will follow the link. A longer mouse click will still set point. Does not work on XEmacs. Needs to be set before org.el is loaded." :group 'org-link-follow :type 'boolean) (defcustom org-mark-ring-length 4 - "Number of different positions to be recorded in the ring + "Number of different positions to be recorded in the ring. Changing this requires a restart of Emacs to work correctly." :group 'org-link-follow :type 'integer) +(defcustom org-link-search-must-match-exact-headline 'query-to-create + "Non-nil means internal links in Org files must exactly match a headline. +When nil, the link search tries to match a phrase will all words +in the search text." + :group 'org-link-follow + :type '(choice + (const :tag "Use fuzy text search" nil) + (const :tag "Match only exact headline" t) + (const :tag "Match extact headline or query to create it" + query-to-create))) + (defcustom org-link-frame-setup '((vm . vm-visit-folder-other-frame) - (gnus . gnus-other-frame) - (file . find-file-other-window)) + (gnus . org-gnus-no-new-news) + (file . find-file-other-window) + (wl . wl-other-frame)) "Setup the frame configuration for following links. When following a link with Emacs, it may often be useful to display this link in another window or frame. This variable can be used to @@ -1307,6 +1490,9 @@ For FILE, use any of `find-file' `find-file-other-window' `find-file-other-frame' +For Wanderlust use any of + `wl' + `wl-other-frame' For the calendar, use the variable `calendar-setup'. For BBDB, it is currently only possible to display the matches in another window." @@ -1326,13 +1512,18 @@ another window." (choice (const find-file) (const find-file-other-window) - (const find-file-other-frame))))) + (const find-file-other-frame))) + (cons (const wl) + (choice + (const wl) + (const wl-other-frame))))) (defcustom org-display-internal-link-with-indirect-buffer nil - "Non-nil means, use indirect buffer to display infile links. + "Non-nil means use indirect buffer to display infile links. Activating internal links (from one location in a file to another location in the same file) normally just jumps to the location. When the link is -activated with a C-u prefix (or with mouse-3), the link is displayed in +activated with a \\[universal-argument] prefix (or with mouse-3), the link \ +is displayed in another window. When this option is set, the other window actually displays an indirect buffer clone of the current buffer, to avoid any visibility changes to the current buffer." @@ -1340,7 +1531,7 @@ changes to the current buffer." :type 'boolean) (defcustom org-open-non-existing-files nil - "Non-nil means, `org-open-file' will open non-existing files. + "Non-nil means `org-open-file' will open non-existing files. When nil, an error will be generated. This variable applies only to external applications because they might choke on non-existing files. If the link is to a file that @@ -1349,7 +1540,7 @@ will be opened in Emacs, the variable is ignored." :type 'boolean) (defcustom org-open-directory-means-index-dot-org nil - "Non-nil means, a link to a directory really means to index.org. + "Non-nil means a link to a directory really means to index.org. When nil, following a directory link will run dired or open a finder/explorer window on that directory." :group 'org-link-follow @@ -1357,7 +1548,7 @@ window on that directory." (defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") "Function and arguments to call for following mailto links. -This is a list with the first element being a lisp function, and the +This is a list with the first element being a Lisp function, and the remaining elements being arguments to the function. In string arguments, %a will be replaced by the address, and %s will be replaced by the subject if one was given like in <mailto:arthur@galaxy.org::this subject>." @@ -1369,7 +1560,7 @@ if one was given like in <mailto:arthur@galaxy.org::this subject>." (cons :tag "other" (function) (repeat :tag "argument" sexp)))) (defcustom org-confirm-shell-link-function 'yes-or-no-p - "Non-nil means, ask for confirmation before executing shell links. + "Non-nil means ask for confirmation before executing shell links. Shell links can be dangerous: just think about a link [[shell:rm -rf ~/*][Google Search]] @@ -1384,9 +1575,12 @@ single keystroke rather than having to type \"yes\"." (const :tag "with yes-or-no (safer)" yes-or-no-p) (const :tag "with y-or-n (faster)" y-or-n-p) (const :tag "no confirmation (dangerous)" nil))) +(put 'org-confirm-shell-link-function + 'safe-local-variable + '(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) (defcustom org-confirm-elisp-link-function 'yes-or-no-p - "Non-nil means, ask for confirmation before executing Emacs Lisp links. + "Non-nil means ask for confirmation before executing Emacs Lisp links. Elisp links can be dangerous: just think about a link [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] @@ -1401,6 +1595,9 @@ single keystroke rather than having to type \"yes\"." (const :tag "with yes-or-no (safer)" yes-or-no-p) (const :tag "with y-or-n (faster)" y-or-n-p) (const :tag "no confirmation (dangerous)" nil))) +(put 'org-confirm-shell-link-function + 'safe-local-variable + '(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) (defconst org-file-apps-defaults-gnu '((remote . emacs) @@ -1452,9 +1649,37 @@ you can use this variable to set the application for a given file extension. The entries in this list are cons cells where the car identifies files and the cdr the corresponding command. Possible values for the file identifier are - \"regex\" Regular expression matched against the file name. For backward - compatibility, this can also be a string with only alphanumeric - characters, which is then interpreted as an extension. + \"string\" A string as a file identifier can be interpreted in different + ways, depending on its contents: + + - Alphanumeric characters only: + Match links with this file extension. + Example: (\"pdf\" . \"evince %s\") + to open PDFs with evince. + + - Regular expression: Match links where the + filename matches the regexp. If you want to + use groups here, use shy groups. + + Example: (\"\\.x?html\\'\" . \"firefox %s\") + (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\") + to open *.html and *.xhtml with firefox. + + - Regular expression which contains (non-shy) groups: + Match links where the whole link, including \"::\", and + anything after that, matches the regexp. + In a custom command string, %1, %2, etc. are replaced with + the parts of the link that were matched by the groups. + For backwards compatibility, if a command string is given + that does not use any of the group matches, this case is + handled identically to the second one (i.e. match against + file name only). + In a custom lisp form, you can access the group matches with + (match-string n link). + + Example: (\"\\.pdf::\\(\\d+\\)\\'\" . \"evince -p %1 %s\") + to open [[file:document.pdf::5]] with evince at page 5. + `directory' Matches a directory `remote' Matches a remote file, accessible through tramp or efs. Remote files most likely should be visited through Emacs @@ -1468,7 +1693,7 @@ file identifier are `system' The system command to open files, like `open' on Windows and Mac OS X, and mailcap under GNU/Linux. This is the command that will be selected if you call `C-c C-o' with a double - `C-u C-u' prefix. + \\[universal-argument] \\[universal-argument] prefix. Possible values for the command are: `emacs' The file will be visited by the current Emacs process. @@ -1507,6 +1732,8 @@ For more examples, see the system specific constants (string :tag "Command") (sexp :tag "Lisp form"))))) + + (defgroup org-refile nil "Options concerning refiling entries in Org-mode." :tag "Org Refile" @@ -1530,10 +1757,8 @@ following situations: (defcustom org-default-notes-file (convert-standard-filename "~/.notes") "Default target for storing notes. -Used by the hooks for remember.el. This can be a string, or nil to mean -the value of `remember-data-file'. -You can set this on a per-template basis with the variable -`org-remember-templates'." +Used as a fall back file for org-remember.el and org-capture.el, for +templates that do not specify a target file." :group 'org-refile :group 'org-remember :type '(choice @@ -1555,12 +1780,12 @@ outline-path-completion Headlines in the current buffer are offered via (const :tag "Outline-path-completion" outline-path-completion))) (defcustom org-goto-max-level 5 - "Maximum level to be considered when running org-goto with refile interface." + "Maximum target level when running `org-goto' with refile interface." :group 'org-refile :type 'integer) (defcustom org-reverse-note-order nil - "Non-nil means, store new notes at the beginning of a file or entry. + "Non-nil means store new notes at the beginning of a file or entry. When nil, new notes will be filed to the end of a file or entry. This can also be a list with cons cells of regular expressions that are matched against file names, and values." @@ -1572,13 +1797,40 @@ are matched against file names, and values." (repeat :tag "By file name regexp" (cons regexp boolean)))) +(defcustom org-log-refile nil + "Information to record when a task is refiled. + +Possible values are: + +nil Don't add anything +time Add a time stamp to the task +note Prompt for a note and add it with template `org-log-note-headings' + +This option can also be set with on a per-file-basis with + + #+STARTUP: nologrefile + #+STARTUP: logrefile + #+STARTUP: lognoterefile + +You can have local logging settings for a subtree by setting the LOGGING +property to one or more of these keywords. + +When bulk-refiling from the agenda, the value `note' is forbidden and +will temporarily be changed to `time'." + :group 'org-refile + :group 'org-progress + :type '(choice + (const :tag "No logging" nil) + (const :tag "Record timestamp" time) + (const :tag "Record timestamp with note." note))) + (defcustom org-refile-targets nil "Targets for refiling entries with \\[org-refile]. This is list of cons cells. Each cell contains: - a specification of the files to be considered, either a list of files, or a symbol whose function or variable value will be used to retrieve a file name or a list of file names. If you use `org-agenda-files' for - that, all agenda files will be scanned for targets. Nil means, consider + that, all agenda files will be scanned for targets. Nil means consider headings in the current buffer. - A specification of how to find candidate refile targets. This may be any of: @@ -1597,7 +1849,7 @@ This is list of cons cells. Each cell contains: order in hierarchy, not to the number of stars. You can set the variable `org-refile-target-verify-function' to a function -to verify each headline found by the simple critery above. +to verify each headline found by the simple criteria above. When this variable is nil, all top-level headlines in the current buffer are used, equivalent to the value `((nil . (:level . 1))'." @@ -1629,8 +1881,19 @@ of the subtree." :group 'org-refile :type 'function) +(defcustom org-refile-use-cache nil + "Non-nil means cache refile targets to speed up the process. +The cache for a particular file will be updated automatically when +the buffer has been killed, or when any of the marker used for flagging +refile targets no longer points at a live buffer. +If you have added new entries to a buffer that might themselves be targets, +you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you +find that easier, `C-u C-u C-u C-c C-w'." + :group 'org-refile + :type 'boolean) + (defcustom org-refile-use-outline-path nil - "Non-nil means, provide refile targets as paths. + "Non-nil means provide refile targets as paths. So a level 3 headline will be available as level1/level2/level3. When the value is `file', also include the file name (without directory) @@ -1646,7 +1909,7 @@ the file name, to get entries inserted as top level in the file. (const :tag "Start with full file path" full-file-path))) (defcustom org-outline-path-complete-in-steps t - "Non-nil means, complete the outline path in hierarchical steps. + "Non-nil means complete the outline path in hierarchical steps. When Org-mode uses the refile interface to select an outline path \(see variable `org-refile-use-outline-path'), the completion of the path can be done is a single go, or if can be done in steps down @@ -1658,7 +1921,7 @@ fast, while still showing the whole path to the entry." :type 'boolean) (defcustom org-refile-allow-creating-parent-nodes nil - "Non-nil means, allow to create new nodes as refile targets. + "Non-nil means allow to create new nodes as refile targets. New nodes are then created by adding \"/new node name\" to the completion of an existing node. When the value of this variable is `confirm', new node creation must be confirmed by the user (recommended) @@ -1688,9 +1951,8 @@ heading." '( (:tag "Sequence (cycling hits every state)" sequence) (:tag "Type (cycling directly to DONE)" type)) - "The available interpretation symbols for customizing - `org-todo-keywords'. - Interested libraries should add to this list.") + "The available interpretation symbols for customizing `org-todo-keywords'. +Interested libraries should add to this list.") (defcustom org-todo-keywords '((sequence "TODO" "DONE")) "List of TODO entry keyword sequences and their interpretation. @@ -1701,7 +1963,7 @@ indicating if the keywords should be interpreted as a sequence of action steps, or as different types of TODO items. The first keywords are states requiring action - these states will select a headline for inclusion into the global TODO list Org-mode produces. If one of -the \"keywords\" is the vertical bat \"|\" the remaining keywords +the \"keywords\" is the vertical bar, \"|\", the remaining keywords signify that no further action is necessary. If \"|\" is not found, the last keyword is treated as the only DONE state of the sequence. @@ -1716,7 +1978,7 @@ Each keyword can optionally specify a character for fast state selection \(in combination with the variable `org-use-fast-todo-selection') and specifiers for state change logging, using the same syntax that is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says -that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" +that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" indicates to record a time stamp each time this state is selected. Each keyword may also specify if a timestamp or a note should be @@ -1794,7 +2056,7 @@ more information." (const type))) (defcustom org-use-fast-todo-selection t - "Non-nil means, use the fast todo selection scheme with C-c C-t. + "Non-nil means use the fast todo selection scheme with C-c C-t. This variable describes if and under what circumstances the cycling mechanism for TODO keywords will be replaced by a single-key, direct selection scheme. @@ -1818,7 +2080,7 @@ by a letter in parenthesis, like TODO(t)." (const :tag "Only with C-u C-c C-t" prefix))) (defcustom org-provide-todo-statistics t - "Non-nil means, update todo statistics after insert and toggle. + "Non-nil means update todo statistics after insert and toggle. ALL-HEADLINES means update todo statistics by including headlines with no TODO keyword as well, counting them as not done. A list of TODO keywords means the same, but skip keywords that are @@ -1835,7 +2097,7 @@ current entry each time a todo state is changed." (other :tag "No TODO statistics" nil))) (defcustom org-hierarchical-todo-statistics t - "Non-nil means, TODO statistics covers just direct children. + "Non-nil means TODO statistics covers just direct children. When nil, all entries in the subtree are considered. This has only an effect if `org-provide-todo-statistics' is set. To set this to nil for only a single subtree, use a COOKIE_DATA @@ -1880,7 +2142,7 @@ TODO state changes :to new state, like in :from") (defcustom org-enforce-todo-dependencies nil - "Non-nil means, undone TODO entries will block switching the parent to DONE. + "Non-nil means undone TODO entries will block switching the parent to DONE. Also, if a parent has an :ORDERED: property, switching an entry to DONE will be blocked if any prior sibling is not yet done. Finally, if the parent is blocked because of ordered siblings of its own, @@ -1899,7 +2161,7 @@ to change is while Emacs is running is through the customize interface." :type 'boolean) (defcustom org-enforce-todo-checkbox-dependencies nil - "Non-nil means, unchecked boxes will block switching the parent to DONE. + "Non-nil means unchecked boxes will block switching the parent to DONE. When this is nil, checkboxes have no influence on switching TODO states. When non-nil, you first need to check off all check boxes before the TODO entry can be switched to DONE. @@ -1917,7 +2179,7 @@ to change is while Emacs is running is through the customize interface." :type 'boolean) (defcustom org-treat-insert-todo-heading-as-state-change nil - "Non-nil means, inserting a TODO heading is treated as state change. + "Non-nil means inserting a TODO heading is treated as state change. So when the command \\[org-insert-todo-heading] is used, state change logging will apply if appropriate. When nil, the new TODO item will be inserted directly, and no logging will take place." @@ -1925,7 +2187,7 @@ be inserted directly, and no logging will take place." :type 'boolean) (defcustom org-treat-S-cursor-todo-selection-as-state-change t - "Non-nil means, switching TODO states with S-cursor counts as state change. + "Non-nil means switching TODO states with S-cursor counts as state change. This is the default behavior. However, setting this to nil allows a convenient way to select a TODO state and bypass any logging associated with that." @@ -2029,7 +2291,7 @@ property to one or more of these keywords." (const :tag "Record timestamp with note." note))) (defcustom org-log-note-clock-out nil - "Non-nil means, record a note when clocking out of an item. + "Non-nil means record a note when clocking out of an item. This can also be configured on a per-file basis by adding one of the following lines anywhere in the buffer: @@ -2040,7 +2302,7 @@ the following lines anywhere in the buffer: :type 'boolean) (defcustom org-log-done-with-time t - "Non-nil means, the CLOSED time stamp will contain date and time. + "Non-nil means the CLOSED time stamp will contain date and time. When nil, only the date will be recorded." :group 'org-progress :type 'boolean) @@ -2050,17 +2312,24 @@ When nil, only the date will be recorded." (state . "State %-12s from %-12S %t") (note . "Note taken on %t") (reschedule . "Rescheduled from %S on %t") + (delschedule . "Not scheduled, was %S on %t") (redeadline . "New deadline from %S on %t") + (deldeadline . "Removed deadline, was %S on %t") + (refile . "Refiled on %t") (clock-out . "")) "Headings for notes added to entries. The value is an alist, with the car being a symbol indicating the note context, and the cdr is the heading to be used. The heading may also be the empty string. %t in the heading will be replaced by a time stamp. +%T will be an active time stamp instead the default inactive one %s will be replaced by the new TODO state, in double quotes. %S will be replaced by the old TODO state, in double quotes. %u will be replaced by the user name. -%U will be replaced by the full user name." +%U will be replaced by the full user name. + +In fact, it is not a good idea to change the `state' entry, because +agenda log mode depends on the format of these entries." :group 'org-todo :group 'org-progress :type '(list :greedy t @@ -2070,14 +2339,17 @@ empty string. state) string) (cons (const :tag "Heading when just taking a note" note) string) (cons (const :tag "Heading when clocking out" clock-out) string) + (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) (cons (const :tag "Heading when rescheduling" reschedule) string) - (cons (const :tag "Heading when changing deadline" redeadline) string))) + (cons (const :tag "Heading when changing deadline" redeadline) string) + (cons (const :tag "Heading when deleting a deadline" deldeadline) string) + (cons (const :tag "Heading when refiling" refile) string))) (unless (assq 'note org-log-note-headings) (push '(note . "%t") org-log-note-headings)) (defcustom org-log-into-drawer nil - "Non-nil means, insert state change notes and time stamps into a drawer. + "Non-nil means insert state change notes and time stamps into a drawer. When nil, state changes notes will be inserted after the headline and any scheduling and clock lines, but not inside a drawer. @@ -2113,7 +2385,7 @@ used instead of the default value." (t p)))) (defcustom org-log-state-notes-insert-after-drawers nil - "Non-nil means, insert state change notes after any drawers in entry. + "Non-nil means insert state change notes after any drawers in entry. Only the drawers that *immediately* follow the headline and the deadline/scheduled line are skipped. When nil, insert notes right after the heading and perhaps the line @@ -2126,16 +2398,25 @@ set." :type 'boolean) (defcustom org-log-states-order-reversed t - "Non-nil means, the latest state change note will be directly after heading. -When nil, the notes will be orderer according to time." + "Non-nil means the latest state note will be directly after heading. +When nil, the state change notes will be ordered according to time." :group 'org-todo :group 'org-progress :type 'boolean) +(defcustom org-todo-repeat-to-state nil + "The TODO state to which a repeater should return the repeating task. +By default this is the first task in a TODO sequence, or the previous state +in a TODO_TYP set. But you can specify another task here. +alternatively, set the :REPEAT_TO_STATE: property of the entry." + :group 'org-todo + :type '(choice (const :tag "Head of sequence" nil) + (string :tag "Specific state"))) + (defcustom org-log-repeat 'time - "Non-nil means, record moving through the DONE state when triggering repeat. + "Non-nil means record moving through the DONE state when triggering repeat. An auto-repeating task is immediately switched back to TODO when -marked DONE. If you are not logging state changes (by adding \"@\" +marked DONE. If you are not logging state changes (by adding \"@\" or \"!\" to the TODO keyword definition), or set `org-log-done' to record a closing note, there will be no record of the task moving through DONE. This variable forces taking a note anyway. @@ -2166,7 +2447,7 @@ property to one or more of these keywords." :group 'org-todo) (defcustom org-enable-priority-commands t - "Non-nil means, priority commands are active. + "Non-nil means priority commands are active. When nil, these commands will be disabled, so that you never accidentally set a priority." :group 'org-priorities @@ -2191,19 +2472,29 @@ This is the priority an item get if no explicit priority is given." :type 'character) (defcustom org-priority-start-cycle-with-default t - "Non-nil means, start with default priority when starting to cycle. + "Non-nil means start with default priority when starting to cycle. When this is nil, the first step in the cycle will be (depending on the command used) one higher or lower that the default priority." :group 'org-priorities :type 'boolean) +(defcustom org-get-priority-function nil + "Function to extract the priority from a string. +The string is normally the headline. If this is nil Org computes the +priority from the priority cookie like [#A] in the headline. It returns +an integer, increasing by 1000 for each priority level. +The user can set a different function here, which should take a string +as an argument and return the numeric priority." + :group 'org-priorities + :type 'function) + (defgroup org-time nil "Options concerning time stamps and deadlines in Org-mode." :tag "Org Time" :group 'org) (defcustom org-insert-labeled-timestamps-at-point nil - "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point. + "Non-nil means SCHEDULED and DEADLINE timestamps are inserted at point. When nil, these labeled time stamps are forces into the second line of an entry, just after the headline. When scheduling from the global TODO list, the time stamp will always be forced into the second line." @@ -2224,12 +2515,12 @@ of N minutes, as given by the second value. When a setting is 0 or 1, insert the time unmodified. Useful rounding numbers should be factors of 60, so for example 5, 10, 15. -When this is larger than 1, you can still force an exact time-stamp by using -a double prefix argument to a time-stamp command like `C-c .' or `C-c !', +When this is larger than 1, you can still force an exact time stamp by using +a double prefix argument to a time stamp command like `C-c .' or `C-c !', and by using a prefix arg to `S-up/down' to specify the exact number of minutes to shift." :group 'org-time - :get '(lambda (var) ; Make sure all entries have 5 elements + :get '(lambda (var) ; Make sure both elements are there (if (integerp (default-value var)) (list (default-value var) 5) (default-value var))) @@ -2244,7 +2535,7 @@ of minutes to shift." org-time-stamp-rounding-minutes))) (defcustom org-display-custom-times nil - "Non-nil means, overlay custom formats over all time stamps. + "Non-nil means overlay custom formats over all time stamps. The formats are defined through the variable `org-time-stamp-custom-formats'. To turn this on on a per-file basis, insert anywhere in the file: #+STARTUP: customtime" @@ -2272,8 +2563,8 @@ commands, if custom time display is turned on at the time of export." f))) (defcustom org-time-clocksum-format "%d:%02d" - "The format string used when creating CLOCKSUM lines, or when -org-mode generates a time duration." + "The format string used when creating CLOCKSUM lines. +This is also used when org-mode generates a time duration." :group 'org-time :type 'string) @@ -2301,11 +2592,11 @@ Custom commands can set this variable in the options section." :type 'integer) (defcustom org-read-date-prefer-future t - "Non-nil means, assume future for incomplete date input from user. + "Non-nil means assume future for incomplete date input from user. This affects the following situations: 1. The user gives a month but not a year. - For example, if it is april and you enter \"feb 2\", this will be read - as feb 2, *next* year. \"May 5\", however, will be this year. + For example, if it is April and you enter \"feb 2\", this will be read + as Feb 2, *next* year. \"May 5\", however, will be this year. 2. The user gives a day, but no month. For example, if today is the 15th, and you enter \"3\", Org-mode will read this as the third of *next* month. However, if you enter \"17\", @@ -2320,21 +2611,36 @@ will work: Currently none of this works for ISO week specifications. When this option is nil, the current day, month and year will always be -used as defaults." +used as defaults. + +See also `org-agenda-jump-prefer-future'." :group 'org-time :type '(choice (const :tag "Never" nil) (const :tag "Check month and day" t) (const :tag "Check month, day, and time" time))) +(defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future + "Should the agenda jump command prefer the future for incomplete dates? +The default is to do the same as configured in `org-read-date-prefer-future'. +But you can alse set a deviating value here. +This may t or nil, or the symbol `org-read-date-prefer-future'." + :group 'org-agenda + :group 'org-time + :type '(choice + (const :tag "Use org-read-date-prefer-future" + org-read-date-prefer-future) + (const :tag "Never" nil) + (const :tag "Always" t))) + (defcustom org-read-date-display-live t - "Non-nil means, display current interpretation of date prompt live. + "Non-nil means display current interpretation of date prompt live. This display will be in an overlay, in the minibuffer." :group 'org-time :type 'boolean) (defcustom org-read-date-popup-calendar t - "Non-nil means, pop up a calendar when prompting for a date. + "Non-nil means pop up a calendar when prompting for a date. In the calendar, the date can be selected with mouse-1. However, the minibuffer will also be active, and you can simply enter the date as well. When nil, only the minibuffer will be available." @@ -2367,13 +2673,13 @@ be the favorite working time of John Wiegley :-)" :type 'integer) (defcustom org-edit-timestamp-down-means-later nil - "Non-nil means, S-down will increase the time in a time stamp. + "Non-nil means S-down will increase the time in a time stamp. When nil, S-up will increase." :group 'org-time :type 'boolean) (defcustom org-calendar-follow-timestamp-change t - "Non-nil means, make the calendar window follow timestamp changes. + "Non-nil means make the calendar window follow timestamp changes. When a timestamp is modified and the calendar window is visible, it will be moved to the new date." :group 'org-time @@ -2425,6 +2731,20 @@ To disable these tags on a per-file basis, insert anywhere in the file: (const :tag "End radio group" (:endgroup)) (const :tag "New line" (:newline))))) +(defcustom org-complete-tags-always-offer-all-agenda-tags nil + "If non-nil, always offer completion for all tags of all agenda files. +Instead of customizing this variable directly, you might want to +set it locally for capture buffers, because there no list of +tags in that file can be created dynamically (there are none). + + (add-hook 'org-capture-mode-hook + (lambda () + (set (make-local-variable + 'org-complete-tags-always-offer-all-agenda-tags) + t)))" + :group 'org-tags + :type 'boolean) + (defvar org-file-tags nil "List of tags that can be inherited by all entries in the file. The tags will be inherited if the variable `org-use-tag-inheritance' @@ -2432,7 +2752,7 @@ says they should be. This variable is populated from #+FILETAGS lines.") (defcustom org-use-fast-tag-selection 'auto - "Non-nil means, use fast tag selection scheme. + "Non-nil means use fast tag selection scheme. This is a special interface to select and deselect tags with single keys. When nil, fast selection is never used. When the symbol `auto', fast selection is used if and only if selection @@ -2447,7 +2767,7 @@ automatically if necessary." (const :tag "When selection characters are configured" 'auto))) (defcustom org-fast-tag-selection-single-key nil - "Non-nil means, fast tag selection exits after first change. + "Non-nil means fast tag selection exits after first change. When nil, you have to press RET to exit it. During fast tag selection, you can toggle this flag with `C-c'. This variable can also have the value `expert'. In this case, the window @@ -2459,7 +2779,7 @@ displaying the tags menu is not even shown, until you press C-c again." (const :tag "Expert" expert))) (defvar org-fast-tag-selection-include-todo nil - "Non-nil means, fast tags selection interface will also offer TODO states. + "Non-nil means fast tags selection interface will also offer TODO states. This is an undocumented feature, you should not rely on it.") (defcustom org-tags-column (if (featurep 'xemacs) -76 -77) @@ -2471,7 +2791,7 @@ it means that the tags should be flushright to that column. For example, :type 'integer) (defcustom org-auto-align-tags t - "Non-nil means, realign tags after pro/demotion of TODO state change. + "Non-nil means realign tags after pro/demotion of TODO state change. These operations change the length of a headline and therefore shift the tags around. With this options turned on, after each such operation the tags are again aligned to `org-tags-column'." @@ -2479,7 +2799,7 @@ the tags are again aligned to `org-tags-column'." :type 'boolean) (defcustom org-use-tag-inheritance t - "Non-nil means, tags in levels apply also for sublevels. + "Non-nil means tags in levels apply also for sublevels. When nil, only the tags directly given in a specific line apply there. This may also be a list of tags that should be inherited, or a regexp that matches tags that should be inherited. Additional control is possible @@ -2541,7 +2861,7 @@ is better to limit inheritance to certain tags using the variables (const :tag "List them, indented with leading dots" indented))) (defcustom org-tags-sort-function nil - "When set, tags are sorted using this function as a comparator" + "When set, tags are sorted using this function as a comparator." :group 'org-tags :type '(choice (const :tag "No sorting" nil) @@ -2570,9 +2890,9 @@ lined-up with respect to each other." :type 'string) (defcustom org-use-property-inheritance nil - "Non-nil means, properties apply also for sublevels. + "Non-nil means properties apply also for sublevels. -This setting is chiefly used during property searches. Turning it on can +This setting is chiefly used during property searches. Turning it on can cause significant overhead when doing a search, which is why it is not on by default. @@ -2714,7 +3034,9 @@ If an entry is a directory, all files in that directory that are matched by If the value of the variable is not a list but a single file name, then the list of agenda files is actually stored and maintained in that file, one -agenda file per line." +agenda file per line. In this file paths can be given relative to +`org-directory'. Tilde expansion and environment variable substitution +are also made." :group 'org-agenda :type '(choice (repeat :tag "List of files and directories" file) @@ -2810,15 +3132,15 @@ points to a file, `org-agenda-diary-entry' will be used instead." (defcustom org-format-latex-options '(:foreground default :background default :scale 1.0 - :html-foreground "Black" :html-background "Transparent" :html-scale 1.0 - :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) + :html-foreground "Black" :html-background "Transparent" + :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) "Options for creating images from LaTeX fragments. This is a property list with the following properties: :foreground the foreground color for images embedded in Emacs, e.g. \"Black\". `default' means use the foreground of the default face. :background the background color, or \"Transparent\". `default' means use the background of the default face. -:scale a scaling factor for the size of the images. +:scale a scaling factor for the size of the images, to get more pixels :html-foreground, :html-background, :html-scale the same numbers for HTML export. :matchers a list indicating which matchers should be used to @@ -2832,13 +3154,19 @@ This is a property list with the following properties: :group 'org-latex :type 'plist) +(defcustom org-format-latex-signal-error t + "Non-nil means signal an error when image creation of LaTeX snippets fails. +When nil, just push out a message." + :group 'org-latex + :type 'boolean) + (defcustom org-format-latex-header "\\documentclass{article} -\\usepackage{amssymb} \\usepackage[usenames]{color} \\usepackage{amsmath} -\\usepackage{latexsym} \\usepackage[mathscr]{eucal} \\pagestyle{empty} % do not remove +\[PACKAGES] +\[DEFAULT-PACKAGES] % The settings below are copied from fullpage.sty \\setlength{\\textwidth}{\\paperwidth} \\addtolength{\\textwidth}{-3cm} @@ -2854,25 +3182,110 @@ This is a property list with the following properties: \\addtolength{\\topmargin}{-2.54cm}" "The document header used for processing LaTeX fragments. It is imperative that this header make sure that no page number -appears on the page." +appears on the page. The package defined in the variables +`org-export-latex-default-packages-alist' and `org-export-latex-packages-alist' +will either replace the placeholder \"[PACKAGES]\" in this header, or they +will be appended." :group 'org-latex :type 'string) -;; The following variable is defined here because is it also used +(defvar org-format-latex-header-extra nil) + +(defun org-set-packages-alist (var val) + "Set the packages alist and make sure it has 3 elements per entry." + (set var (mapcar (lambda (x) + (if (and (consp x) (= (length x) 2)) + (list (car x) (nth 1 x) t) + x)) + val))) + +(defun org-get-packages-alist (var) + + "Get the packages alist and make sure it has 3 elements per entry." + (mapcar (lambda (x) + (if (and (consp x) (= (length x) 2)) + (list (car x) (nth 1 x) t) + x)) + (default-value var))) + +;; The following variables are defined here because is it also used ;; when formatting latex fragments. Originally it was part of the ;; LaTeX exporter, which is why the name includes "export". +(defcustom org-export-latex-default-packages-alist + '(("AUTO" "inputenc" t) + ("T1" "fontenc" t) + ("" "fixltx2e" nil) + ("" "graphicx" t) + ("" "longtable" nil) + ("" "float" nil) + ("" "wrapfig" nil) + ("" "soul" t) + ("" "textcomp" t) + ("" "marvosym" t) + ("" "wasysym" t) + ("" "latexsym" t) + ("" "amssymb" t) + ("" "hyperref" nil) + "\\tolerance=1000" + ) + "Alist of default packages to be inserted in the header. +Change this only if one of the packages here causes an incompatibility +with another package you are using. +The packages in this list are needed by one part or another of Org-mode +to function properly. + +- inputenc, fontenc: for basic font and character selection +- textcomp, marvosymb, wasysym, latexsym, amssym: for various symbols used + for interpreting the entities in `org-entities'. You can skip some of these + packages if you don't use any of the symbols in it. +- graphicx: for including images +- float, wrapfig: for figure placement +- longtable: for long tables +- hyperref: for cross references + +Therefore you should not modify this variable unless you know what you +are doing. The one reason to change it anyway is that you might be loading +some other package that conflicts with one of the default packages. +Each cell is of the format \( \"options\" \"package\" snippet-flag\). +If SNIPPET-FLAG is t, the package also needs to be included when +compiling LaTeX snippets into images for inclusion into HTML." + :group 'org-export-latex + :set 'org-set-packages-alist + :get 'org-get-packages-alist + :type '(repeat + (choice + (list :tag "options/package pair" + (string :tag "options") + (string :tag "package") + (boolean :tag "Snippet")) + (string :tag "A line of LaTeX")))) + (defcustom org-export-latex-packages-alist nil - "Alist of packages to be inserted in the header. -Each cell is of the format \( \"option\" . \"package\" \)." + "Alist of packages to be inserted in every LaTeX header. +These will be inserted after `org-export-latex-default-packages-alist'. +Each cell is of the format \( \"options\" \"package\" snippet-flag \). +SNIPPET-FLAG, when t, indicates that this package is also needed when +turning LaTeX snippets into images for inclusion into HTML. +Make sure that you only list packages here which: +- you want in every file +- do not conflict with the default packages in + `org-export-latex-default-packages-alist' +- do not conflict with the setup in `org-format-latex-header'." :group 'org-export-latex + :set 'org-set-packages-alist + :get 'org-get-packages-alist :type '(repeat - (list - (string :tag "option") - (string :tag "package")))) + (choice + (list :tag "options/package pair" + (string :tag "options") + (string :tag "package") + (boolean :tag "Snippet")) + (string :tag "A line of LaTeX")))) -(defgroup org-font-lock nil - "Font-lock settings for highlighting in Org-mode." - :tag "Org Font Lock" + +(defgroup org-appearance nil + "Settings for Org-mode appearance." + :tag "Org Appearance" :group 'org) (defcustom org-level-color-stars-only nil @@ -2880,11 +3293,11 @@ Each cell is of the format \( \"option\" . \"package\" \)." When nil, the entire headline is fontified. Changing it requires restart of `font-lock-mode' to become effective also in regions already fontified." - :group 'org-font-lock + :group 'org-appearance :type 'boolean) (defcustom org-hide-leading-stars nil - "Non-nil means, hide the first N-1 stars in a headline. + "Non-nil means hide the first N-1 stars in a headline. This works by using the face `org-hide' for these stars. This face is white for a light background, and black for a dark background. You may have to customize the face `org-hide' to @@ -2896,42 +3309,72 @@ lines to the buffer: #+STARTUP: hidestars #+STARTUP: showstars" - :group 'org-font-lock + :group 'org-appearance :type 'boolean) +(defcustom org-hidden-keywords nil + "List of keywords that should be hidden when typed in the org buffer. +For example, add #+TITLE to this list in order to make the +document title appear in the buffer without the initial #+TITLE: +keyword." + :group 'org-appearance + :type '(set (const :tag "#+AUTHOR" author) + (const :tag "#+DATE" date) + (const :tag "#+EMAIL" email) + (const :tag "#+TITLE" title))) + (defcustom org-fontify-done-headline nil - "Non-nil means, change the face of a headline if it is marked DONE. + "Non-nil means change the face of a headline if it is marked DONE. Normally, only the TODO/DONE keyword indicates the state of a headline. When this is non-nil, the headline after the keyword is set to the `org-headline-done' as an additional indication." - :group 'org-font-lock + :group 'org-appearance :type 'boolean) (defcustom org-fontify-emphasized-text t "Non-nil means fontify *bold*, /italic/ and _underlined_ text. Changing this variable requires a restart of Emacs to take effect." - :group 'org-font-lock + :group 'org-appearance :type 'boolean) (defcustom org-fontify-whole-heading-line nil "Non-nil means fontify the whole line for headings. This is useful when setting a background color for the org-level-* faces." - :group 'org-font-lock + :group 'org-appearance :type 'boolean) (defcustom org-highlight-latex-fragments-and-specials nil - "Non-nil means, fontify what is treated specially by the exporters." - :group 'org-font-lock + "Non-nil means fontify what is treated specially by the exporters." + :group 'org-appearance :type 'boolean) (defcustom org-hide-emphasis-markers nil "Non-nil mean font-lock should hide the emphasis marker characters." - :group 'org-font-lock + :group 'org-appearance + :type 'boolean) + +(defcustom org-pretty-entities nil + "Non-nil means show entities as UTF8 characters. +When nil, the \\name form remains in the buffer." + :group 'org-appearance + :type 'boolean) + +(defcustom org-pretty-entities-include-sub-superscripts t + "Non-nil means, pretty entity display includes formatting sub/superscripts." + :group 'org-appearance :type 'boolean) (defvar org-emph-re nil - "Regular expression for matching emphasis.") + "Regular expression for matching emphasis. +After a match, the match groups contain these elements: +0 The match of the full regular expression, including the characters + before and after the proper match +1 The character before the proper match, or empty at beginning of line +2 The proper match, including the leading and trailing markers +3 The leading marker like * or /, indicating the type of highlighting +4 The text between the emphasis markers, not including the markers +5 The character after the match, empty at the end of a line") (defvar org-verbatim-re nil "Regular expression for matching verbatim text.") (defvar org-emphasis-regexp-components) ; defined just below @@ -2994,7 +3437,7 @@ org-level-* faces." (defcustom org-emphasis-regexp-components '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1) "Components used to build the regular expression for emphasis. -This is a list with 6 entries. Terminology: In an emphasis string +This is a list with five entries. Terminology: In an emphasis string like \" *strong word* \", we call the initial space PREMATCH, the final space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters and \"trong wor\" is the body. The different components in this variable @@ -3008,7 +3451,7 @@ body-regexp A regexp like \".\" to match a body character. Don't use newline The maximum number of newlines allowed in an emphasis exp. Use customize to modify this, or restart Emacs after changing it." - :group 'org-font-lock + :group 'org-appearance :set 'org-set-emph-re :type '(list (sexp :tag "Allowed chars in pre ") @@ -3033,8 +3476,9 @@ example *bold*, _underlined_ and /italic/. This variable sets the marker characters, the face to be used by font-lock for highlighting in Org-mode Emacs buffers, and the HTML tags to be used for this. For LaTeX export, see the variable `org-export-latex-emphasis-alist'. +For DocBook export, see the variable `org-export-docbook-emphasis-alist'. Use customize to modify this, or restart Emacs after changing it." - :group 'org-font-lock + :group 'org-appearance :set 'org-set-emph-re :type '(repeat (list @@ -3059,7 +3503,7 @@ This is needed for font-lock setup.") :group 'org) (defcustom org-completion-use-ido nil - "Non-nil means, use ido completion wherever possible. + "Non-nil means use ido completion wherever possible. Note that `ido-mode' must be active for this variable to be relevant. If you decide to turn this variable on, you might well want to turn off `org-outline-path-complete-in-steps'. @@ -3068,7 +3512,7 @@ See also `org-completion-use-iswitchb'." :type 'boolean) (defcustom org-completion-use-iswitchb nil - "Non-nil means, use iswitchb completion wherever possible. + "Non-nil means use iswitchb completion wherever possible. Note that `iswitchb-mode' must be active for this variable to be relevant. If you decide to turn this variable on, you might well want to turn off `org-outline-path-complete-in-steps'. @@ -3077,7 +3521,7 @@ Note that this variable has only an effect if `org-completion-use-ido' is nil." :type 'boolean) (defcustom org-completion-fallback-command 'hippie-expand - "The expansion command called by \\[org-complete] in normal context. + "The expansion command called by \\[pcomplete] in normal context. Normal means, no org-mode-specific context." :group 'org-completion :type 'function) @@ -3125,9 +3569,14 @@ Normal means, no org-mode-specific context." (declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" (&optional end)) (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-goto-end "org-inlinetask" ()) (declare-function org-indent-mode "org-indent" (&optional arg)) (declare-function parse-time-string "parse-time" (string)) (declare-function org-attach-reveal "org-attach" (&optional if-exists)) +(declare-function org-export-latex-fix-inputenc "org-latex" ()) +(declare-function orgtbl-send-table "org-table" (&optional maybe)) (defvar remember-data-file) (defvar texmathp-why) (declare-function speedbar-line-directory "speedbar" (&optional depth)) @@ -3144,18 +3593,18 @@ Normal means, no org-mode-specific context." ;; by the functions setting up org-mode or checking for table context. (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" - "Detects an org-type or table-type table.") + "Detect an org-type or table-type table.") (defconst org-table-line-regexp "^[ \t]*|" - "Detects an org-type table line.") + "Detect an org-type table line.") (defconst org-table-dataline-regexp "^[ \t]*|[^-]" - "Detects an org-type table line.") + "Detect an org-type table line.") (defconst org-table-hline-regexp "^[ \t]*|-" - "Detects an org-type table hline.") + "Detect an org-type table hline.") (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" - "Detects a table-type table hline.") + "Detect a table-type table hline.") (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") + "Detect the first line outside a table when searching from within it. +This works for both table types.") ;; Autoload the functions in org-table.el that are needed by functions here. @@ -3182,7 +3631,9 @@ outside the table.") org-table-rotate-recalc-marks org-table-sort-lines org-table-sum org-table-toggle-coordinate-overlays org-table-toggle-formula-debugger org-table-wrap-region - orgtbl-mode turn-on-orgtbl org-table-to-lisp))) + orgtbl-mode turn-on-orgtbl org-table-to-lisp + orgtbl-to-generic orgtbl-to-tsv orgtbl-to-csv orgtbl-to-latex + orgtbl-to-orgtbl orgtbl-to-html orgtbl-to-texinfo))) (defun org-at-table-p (&optional table-type) "Return t if the cursor is inside an org-type table. @@ -3222,7 +3673,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (message "recognizing table.el table...") (table-recognize-table) (message "recognizing table.el table...done"))) - (error "This should not happen...")) + (error "This should not happen")) t) nil) nil)) @@ -3237,21 +3688,22 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (defvar org-table-clean-did-remove-column nil) -(defun org-table-map-tables (function) +(defun org-table-map-tables (function &optional quietly) "Apply FUNCTION to the start of all tables in the buffer." (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (re-search-forward org-table-any-line-regexp nil t) - (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) + (unless quietly + (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))) (beginning-of-line 1) (when (looking-at org-table-line-regexp) (save-excursion (funcall function)) (or (looking-at org-table-line-regexp) (forward-char 1))) (re-search-forward org-table-any-border-regexp nil 1)))) - (message "Mapping tables: done")) + (unless quietly (message "Mapping tables: done"))) ;; Declare and autoload functions from org-exp.el & Co @@ -3267,16 +3719,27 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." '(org-export-as-ascii org-export-ascii-preprocess org-export-as-ascii-to-buffer org-replace-region-by-ascii org-export-region-as-ascii)) + (org-autoload "org-latex" + '(org-export-as-latex-batch org-export-as-latex-to-buffer + org-replace-region-by-latex org-export-region-as-latex + org-export-as-latex org-export-as-pdf + org-export-as-pdf-and-open)) (org-autoload "org-html" '(org-export-as-html-and-open org-export-as-html-batch org-export-as-html-to-buffer org-replace-region-by-html org-export-region-as-html org-export-as-html)) + (org-autoload "org-docbook" + '(org-export-as-docbook-batch org-export-as-docbook-to-buffer + org-replace-region-by-docbook org-export-region-as-docbook + org-export-as-docbook-pdf org-export-as-docbook-pdf-and-open + org-export-as-docbook)) (org-autoload "org-icalendar" '(org-export-icalendar-this-file org-export-icalendar-all-agenda-files org-export-icalendar-combine-agenda-files)) - (org-autoload "org-xoxo" '(org-export-as-xoxo))) + (org-autoload "org-xoxo" '(org-export-as-xoxo)) + (org-autoload "org-beamer" '(org-beamer-mode org-beamer-sectioning))) ;; Declare and autoload functions from org-agenda.el @@ -3294,8 +3757,12 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." '(org-remember-insinuate org-remember-annotation org-remember-apply-template org-remember org-remember-handler))) -;; Autoload org-clock.el +(eval-and-compile + (org-autoload "org-capture" + '(org-capture org-capture-insert-template-here + org-capture-import-remember-templates))) +;; Autoload org-clock.el (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end)) @@ -3487,7 +3954,7 @@ get the proper fontification." :type 'string) (defcustom org-agenda-skip-archived-trees t - "Non-nil means, the agenda will skip any items located in archived trees. + "Non-nil means the agenda will skip any items located in archived trees. An archived tree is a tree marked with the tag ARCHIVE. The use of this variable is no longer recommended, you should leave it at the value t. Instead, use the key `v' to cycle the archives-mode in the agenda." @@ -3496,13 +3963,13 @@ Instead, use the key `v' to cycle the archives-mode in the agenda." :type 'boolean) (defcustom org-columns-skip-archived-trees t - "Non-nil means, ignore archived trees when creating column view." + "Non-nil means ignore archived trees when creating column view." :group 'org-archive :group 'org-properties :type 'boolean) (defcustom org-cycle-open-archived-trees nil - "Non-nil means, `org-cycle' will open archived trees. + "Non-nil means `org-cycle' will open archived trees. An archived tree is a tree marked with the tag ARCHIVE. When nil, archived trees will stay folded. You can still open them with normal outline commands like `show-all', but not with the cycling commands." @@ -3545,8 +4012,9 @@ collapsed state." (let* ((re (concat ":" org-archive-tag ":"))) (goto-char beg) (while (re-search-forward re end t) - (and (org-on-heading-p) (org-flag-subtree t)) - (org-end-of-subtree t))))) + (when (org-on-heading-p) + (org-flag-subtree t) + (org-end-of-subtree t)))))) (defun org-flag-subtree (flag) (save-excursion @@ -3585,7 +4053,7 @@ collapsed state." (org-autoload "org-id" '(org-id-get-create org-id-new org-id-copy org-id-get org-id-get-with-outline-path-completion - org-id-get-with-outline-drilling + org-id-get-with-outline-drilling org-id-store-link org-id-goto org-id-find org-id-store-link)) ;; Autoload Plotting Code @@ -3618,7 +4086,11 @@ group 3: Priority cookie group 4: True headline group 5: Tags") (make-variable-buffer-local 'org-complex-heading-regexp) -(defvar org-complex-heading-regexp-format nil) +(defvar org-complex-heading-regexp-format nil + "Printf format to make regexp to match an exact headline. +This regexp will match the headline of any node which hase the exact +headline text that is put into the format, but may have any TODO state, +priority and tags.") (make-variable-buffer-local 'org-complex-heading-regexp-format) (defvar org-todo-line-tags-regexp nil "Matches a headline and puts TODO state into group 2 if present. @@ -3659,11 +4131,14 @@ Also put tags into group 4 if tags are present.") "Matches any of the 3 keywords, together with the time stamp.") (make-variable-buffer-local 'org-keyword-time-not-clock-regexp) (defvar org-maybe-keyword-time-regexp nil - "Matches a timestamp, possibly preceeded by a keyword.") + "Matches a timestamp, possibly preceded by a keyword.") (make-variable-buffer-local 'org-maybe-keyword-time-regexp) (defvar org-planning-or-clock-line-re nil "Matches a line with planning or clock info.") (make-variable-buffer-local 'org-planning-or-clock-line-re) +(defvar org-all-time-keywords nil + "List of time keywords.") +(make-variable-buffer-local 'org-all-time-keywords) (defconst org-plain-time-of-day-regexp (concat @@ -3720,6 +4195,8 @@ After a match, the following groups carry important information: ("oddeven" org-odd-levels-only nil) ("align" org-startup-align-all-tables t) ("noalign" org-startup-align-all-tables nil) + ("inlineimages" org-startup-with-inline-images t) + ("noinlineimages" org-startup-with-inline-images nil) ("customtime" org-display-custom-times t) ("logdone" org-log-done time) ("lognotedone" org-log-done note) @@ -3735,6 +4212,9 @@ After a match, the following groups carry important information: ("logredeadline" org-log-redeadline time) ("lognoteredeadline" org-log-redeadline note) ("nologredeadline" org-log-redeadline nil) + ("logrefile" org-log-refile time) + ("lognoterefile" org-log-refile note) + ("nologrefile" org-log-refile nil) ("fninline" org-footnote-define-inline t) ("nofninline" org-footnote-define-inline nil) ("fnlocal" org-footnote-section nil) @@ -3748,7 +4228,10 @@ After a match, the following groups carry important information: ("constSI" constants-unit-system SI) ("noptag" org-tag-persistent-alist nil) ("hideblocks" org-hide-block-startup t) - ("nohideblocks" org-hide-block-startup nil)) + ("nohideblocks" org-hide-block-startup nil) + ("beamer" org-startup-with-beamer-mode t) + ("entitiespretty" org-pretty-entities t) + ("entitiesplain" org-pretty-entities nil)) "Variable associated with STARTUP options for org-mode. Each element is a list of three items: The startup options as written in the #+STARTUP line, the corresponding variable, and the value to @@ -3771,11 +4254,13 @@ means to push this value onto the list in the variable.") (let ((re (org-make-options-regexp '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" - "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE") + "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE" "LATEX_CLASS" + "OPTIONS") "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)")) (splitre "[ \t]+") + (scripts org-use-sub-superscripts) kwds kws0 kwsa key log value cat arch tags const links hw dws - tail sep kws1 prio props ftags drawers + tail sep kws1 prio props ftags drawers beamer-p ext-setup-or-nil setup-contents (start 0)) (save-excursion (save-restriction @@ -3788,10 +4273,9 @@ means to push this value onto the list in the variable.") (re-search-forward re nil t))) (setq key (upcase (match-string 1 ext-setup-or-nil)) value (org-match-string-no-properties 2 ext-setup-or-nil)) + (if (stringp value) (setq value (org-trim value))) (cond ((equal key "CATEGORY") - (if (string-match "[ \t]+$" value) - (setq value (replace-match "" t t value))) (setq cat value)) ((member key '("SEQ_TODO" "TODO")) (push (cons 'sequence (org-split-string value splitre)) kwds)) @@ -3842,10 +4326,14 @@ means to push this value onto the list in the variable.") (set (make-local-variable var) (symbol-value var)) (add-to-list var val)))))) ((equal key "ARCHIVE") - (string-match " *$" value) - (setq arch (replace-match "" t t value)) + (setq arch value) (remove-text-properties 0 (length arch) '(face t fontified t) arch)) + ((equal key "LATEX_CLASS") + (setq beamer-p (equal value "beamer"))) + ((equal key "OPTIONS") + (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value) + (setq scripts (read (match-string 2 value))))) ((equal key "SETUPFILE") (setq setup-contents (org-file-contents (expand-file-name @@ -3858,6 +4346,7 @@ means to push this value onto the list in the variable.") "\n" setup-contents "\n" (substring ext-setup-or-nil start))))) )))) + (org-set-local 'org-use-sub-superscripts scripts) (when cat (org-set-local 'org-category (intern cat)) (push (cons "CATEGORY" cat) props)) @@ -3936,7 +4425,7 @@ means to push this value onto the list in the variable.") ((equal e "{") (push '(:startgroup) tgs)) ((equal e "}") (push '(:endgroup) tgs)) ((equal e "\\n") (push '(:newline) tgs)) - ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) + ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) (push (cons (match-string 1 e) (string-to-char (match-string 2 e))) tgs)) @@ -3980,12 +4469,16 @@ means to push this value onto the list in the variable.") (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)" - "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") + "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$") org-complex-heading-regexp-format (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(%s\\)" - "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") + "\\)\\>\\)?" + "\\(?:[ \t]*\\(\\[#.\\]\\)\\)?" + "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie + "[ \t]*\\(%s\\)" + "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie + "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?[ \t]*$") org-nl-done-regexp (concat "\n\\*+[ \t]+" "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") @@ -3994,7 +4487,7 @@ means to push this value onto the list in the variable.") (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re - "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) + "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@#%]+:[ \t]*\\)?$\\)")) org-looking-at-done-regexp (concat "^" "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" @@ -4033,6 +4526,10 @@ means to push this value onto the list in the variable.") "\\|" org-deadline-string "\\|" org-closed-string "\\|" org-clock-string "\\)\\>\\)") + org-all-time-keywords + (mapcar (lambda (w) (substring w 0 -1)) + (list org-scheduled-string org-deadline-string + org-clock-string org-closed-string)) ) (org-compute-latex-and-specials-regexp) (org-set-font-lock-defaults)))) @@ -4043,10 +4540,10 @@ means to push this value onto the list in the variable.") (not (file-readable-p file))) (if noerror (progn - (message "Cannot read file %s" file) + (message "Cannot read file \"%s\"" file) (ding) (sit-for 2) "") - (error "Cannot read file %s" file)) + (error "Cannot read file \"%s\"" file)) (with-temp-buffer (insert-file-contents file) (buffer-string)))) @@ -4073,30 +4570,24 @@ This will extract info from a string like \"WAIT(w@/!)\"." x)) list)) -;; FIXME: this could be done much better, using second characters etc. (defun org-assign-fast-keys (alist) "Assign fast keys to a keyword-key alist. Respect keys that are already there." - (let (new e k c c1 c2 (char ?a)) + (let (new e (alt ?0)) (while (setq e (pop alist)) - (cond - ((equal e '(:startgroup)) (push e new)) - ((equal e '(:endgroup)) (push e new)) - ((equal e '(:newline)) (push e new)) - (t - (setq k (car e) c2 nil) - (if (cdr e) - (setq c (cdr e)) - ;; automatically assign a character. - (setq c1 (string-to-char - (downcase (substring - k (if (= (string-to-char k) ?@) 1 0))))) - (if (or (rassoc c1 new) (rassoc c1 alist)) - (while (or (rassoc char new) (rassoc char alist)) - (setq char (1+ char))) - (setq c2 c1)) - (setq c (or c2 char))) - (push (cons k c) new)))) + (if (or (memq (car e) '(:newline :endgroup :startgroup)) + (cdr e)) ;; Key already assigned. + (push e new) + (let ((clist (string-to-list (downcase (car e)))) + (used (append new alist))) + (when (= (car clist) ?@) + (pop clist)) + (while (and clist (rassoc (car clist) used)) + (pop clist)) + (unless clist + (while (rassoc alt used) + (incf alt))) + (push (cons (car e) (or (car clist) alt)) new)))) (nreverse new))) ;;; Some variables used in various places @@ -4117,7 +4608,7 @@ This is for getting out of special buffers like remember.") (defvar date) ;; Defined somewhere in this file, but used before definition. -(defvar org-html-entities) +(defvar org-entities) ;; defined in org-entities.el (defvar org-struct-menu) (defvar org-org-menu) (defvar org-tbl-menu) @@ -4125,7 +4616,7 @@ This is for getting out of special buffers like remember.") ;;;; Define the Org-mode (if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22.")) + (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22")) ;; We use a before-change function to check if a table might need @@ -4139,6 +4630,7 @@ This variable is set by `org-before-change-function'. (setq org-table-may-need-update t)) (defvar org-mode-map) (defvar org-inhibit-startup nil) ; Dynamically-scoped param. +(defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. (defvar org-inhibit-logging nil) ; Dynamically-scoped param. (defvar org-inhibit-blocking nil) ; Dynamically-scoped param. @@ -4171,7 +4663,7 @@ The following commands are available: ;; we switch another buffer into org-mode. (if (featurep 'xemacs) (when (boundp 'outline-mode-menu-heading) - ;; Assume this is Greg's port, it used easymenu + ;; Assume this is Greg's port, it uses easymenu (easy-menu-remove outline-mode-menu-heading) (easy-menu-remove outline-mode-menu-show) (easy-menu-remove outline-mode-menu-hide)) @@ -4183,9 +4675,9 @@ The following commands are available: (easy-menu-add org-org-menu) (easy-menu-add org-tbl-menu) (org-install-agenda-files-menu) - (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) - (org-add-to-invisibility-spec '(org-cwidth)) - (org-add-to-invisibility-spec '(org-hide-block . t)) + (if org-descriptive-links (add-to-invisibility-spec '(org-link))) + (add-to-invisibility-spec '(org-cwidth)) + (add-to-invisibility-spec '(org-hide-block . t)) (when (featurep 'xemacs) (org-set-local 'line-move-ignore-invisible t)) (org-set-local 'outline-regexp org-outline-regexp) @@ -4208,7 +4700,6 @@ The following commands are available: (org-set-tag-faces 'org-tag-faces org-tag-faces)) ;; Calc embedded (org-set-local 'calc-embedded-open-mode "# ") - (modify-syntax-entry ?# "<") (modify-syntax-entry ?@ "w") (if org-startup-truncated (setq truncate-lines t)) (org-set-local 'font-lock-unfontify-region-function @@ -4223,6 +4714,9 @@ The following commands are available: (org-set-autofill-regexps) (setq indent-line-function 'org-indent-line-function) (org-update-radio-target-regexp) + ;; Beginning/end of defun + (org-set-local 'beginning-of-defun-function 'org-beginning-of-defun) + (org-set-local 'end-of-defun-function 'org-end-of-defun) ;; Make sure dependence stuff works reliably, even for users who set it ;; too late :-( (if org-enforce-todo-dependencies @@ -4237,7 +4731,7 @@ The following commands are available: 'org-block-todo-from-checkboxes)) ;; Comment characters -; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping + (org-set-local 'comment-start "#") (org-set-local 'comment-padding " ") ;; Align options lines @@ -4260,21 +4754,37 @@ The following commands are available: (org-set-local 'outline-isearch-open-invisible-function (lambda (&rest ignore) (org-show-context 'isearch)))) + ;; Turn on org-beamer-mode? + (and org-startup-with-beamer-mode (org-beamer-mode 1)) + + ;; Setup the pcomplete hooks + (set (make-local-variable 'pcomplete-command-completion-function) + 'org-complete-initial) + (set (make-local-variable 'pcomplete-command-name-function) + 'org-command-at-point) + (set (make-local-variable 'pcomplete-default-completion-function) + 'ignore) + (set (make-local-variable 'pcomplete-parse-arguments-function) + 'org-parse-arguments) + (set (make-local-variable 'pcomplete-termination-string) "") + ;; If empty file that did not turn on org-mode automatically, make it to. (if (and org-insert-mode-line-in-empty-file (interactive-p) (= (point-min) (point-max))) (insert "# -*- mode: org -*-\n\n")) - (unless org-inhibit-startup (when org-startup-align-all-tables (let ((bmp (buffer-modified-p))) - (org-table-map-tables 'org-table-align) + (org-table-map-tables 'org-table-align 'quietly) (set-buffer-modified-p bmp))) + (when org-startup-with-inline-images + (org-display-inline-images)) (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) - (org-set-startup-visibility))) + (unless org-inhibit-startup-visibility-stuff + (org-set-startup-visibility)))) (when (fboundp 'abbrev-table-put) (abbrev-table-put org-mode-abbrev-table @@ -4292,13 +4802,17 @@ The following commands are available: (nthcdr 2 time)))) (current-time))) +(defun org-today () + "Return today date, considering `org-extend-today-until'." + (time-to-days + (time-subtract (current-time) + (list 0 (* 3600 org-extend-today-until) 0)))) + ;;;; Font-Lock stuff, including the activators (defvar org-mouse-map (make-sparse-keymap)) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse) +(org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse) +(org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse) (when org-mouse-1-follows-link (org-defkey org-mouse-map [follow-link] 'mouse-face)) (when org-tab-follows-link @@ -4309,7 +4823,7 @@ The following commands are available: (defconst org-non-link-chars "]\t\n\r<>") (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" - "shell" "elisp")) + "shell" "elisp" "doi" "message")) (defvar org-link-types-re nil "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil @@ -4333,49 +4847,91 @@ Here is what the match groups contain after a match: 4: [desc] 5: desc") (defvar org-bracket-link-analytic-regexp++ nil - "Like org-bracket-link-analytic-regexp, but include coderef internal type.") + "Like `org-bracket-link-analytic-regexp', but include coderef internal type.") (defvar org-any-link-re nil "Regular expression matching any link.") +(defcustom org-match-sexp-depth 3 + "Number of stacked braces for sub/superscript matching. +This has to be set before loading org.el to be effective." + :group 'org-export-translation ; ??????????????????????????/ + :type 'integer) + +(defun org-create-multibrace-regexp (left right n) + "Create a regular expression which will match a balanced sexp. +Opening delimiter is LEFT, and closing delimiter is RIGHT, both given +as single character strings. +The regexp returned will match the entire expression including the +delimiters. It will also define a single group which contains the +match except for the outermost delimiters. The maximum depth of +stacked delimiters is N. Escaping delimiters is not possible." + (let* ((nothing (concat "[^" left right "]*?")) + (or "\\|") + (re nothing) + (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) + (while (> n 1) + (setq n (1- n) + re (concat re or next) + next (concat "\\(?:" nothing left next right "\\)+" nothing))) + (concat left "\\(" re "\\)" right))) + +(defvar org-match-substring-regexp + (concat + "\\([^\\]\\)\\([_^]\\)\\(" + "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" + "\\|" + "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" + "\\|" + "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") + "The regular expression matching a sub- or superscript.") + +(defvar org-match-substring-with-braces-regexp + (concat + "\\([^\\]\\)\\([_^]\\)\\(" + "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" + "\\)") + "The regular expression matching a sub- or superscript, forcing braces.") + (defun org-make-link-regexps () "Update the link regular expressions. This should be called after the variable `org-link-types' has changed." (setq org-link-types-re (concat - "\\`\\(" (mapconcat 'identity org-link-types "\\|") "\\):") + "\\`\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):") org-link-re-with-space (concat - "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" + "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" "\\([^" org-non-link-chars " ]" "[^" org-non-link-chars "]*" "[^" org-non-link-chars " ]\\)>?") org-link-re-with-space2 (concat - "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" + "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" "\\([^" org-non-link-chars " ]" "[^\t\n\r]*" "[^" org-non-link-chars " ]\\)>?") org-link-re-with-space3 (concat - "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" + "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" "\\([^" org-non-link-chars " ]" "[^\t\n\r]*\\)") org-angle-link-re (concat - "<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" + "<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" "\\([^" org-non-link-chars " ]" "[^" org-non-link-chars "]*" "\\)>") org-plain-link-re (concat - "\\<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" - "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") + "\\<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" + (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")) + ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") org-bracket-link-regexp "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" org-bracket-link-analytic-regexp (concat "\\[\\[" - "\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?" + "\\(\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):\\)?" "\\([^]]+\\)" "\\]" "\\(\\[" "\\([^]]+\\)" "\\]\\)?" @@ -4383,7 +4939,7 @@ This should be called after the variable `org-link-types' has changed." org-bracket-link-analytic-regexp++ (concat "\\[\\[" - "\\(\\(" (mapconcat 'identity (cons "coderef" org-link-types) "\\|") "\\):\\)?" + "\\(\\(" (mapconcat 'regexp-quote (cons "coderef" org-link-types) "\\|") "\\):\\)?" "\\([^]]+\\)" "\\]" "\\(\\[" "\\([^]]+\\)" "\\]\\)?" @@ -4440,7 +4996,7 @@ The time stamps may be either active or inactive.") (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))) (add-text-properties (match-beginning 2) (match-end 2) - '(font-lock-multiline t)) + '(font-lock-multiline t org-emphasis t)) (when org-hide-emphasis-markers (add-text-properties (match-end 4) (match-beginning 5) '(invisible org-link)) @@ -4495,8 +5051,9 @@ will be prompted for." (string-match (concat "[" (nth 0 erc) "\n]") (char-to-string (char-before (point))))) (insert " ")) - (unless (string-match (concat "[" (nth 1 erc) "\n]") - (char-to-string (char-after (point)))) + (unless (or (eobp) + (string-match (concat "[" (nth 1 erc) "\n]") + (char-to-string (char-after (point))))) (insert " ") (backward-char 1)) (insert string) (and move (backward-char 1)))) @@ -4533,13 +5090,22 @@ will be prompted for." '(display t invisible t intangible t)) t))) +(defcustom org-src-fontify-natively nil + "When non-nil, fontify code in code blocks." + :type 'boolean + :group 'org-appearance + :group 'org-babel) + (defun org-fontify-meta-lines-and-blocks (limit) "Fontify #+ lines and blocks, in the correct ways." (let ((case-fold-search t)) (if (re-search-forward - "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)\\(.*\\)\\)" + "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" limit t) (let ((beg (match-beginning 0)) + (block-start (match-end 0)) + (block-end nil) + (lang (match-string 7)) (beg1 (line-beginning-position 2)) (dc1 (downcase (match-string 2))) (dc3 (downcase (match-string 3))) @@ -4552,17 +5118,19 @@ will be prompted for." '(display t invisible t intangible t)) (add-text-properties (match-beginning 1) (match-end 3) '(font-lock-fontified t face org-meta-line)) - (add-text-properties (match-beginning 6) (match-end 6) + (add-text-properties (match-beginning 6) (+ (match-end 6) 1) '(font-lock-fontified t face org-block)) + ; for backend-specific code t) ((and (match-end 4) (equal dc3 "begin")) - ;; Truely a block + ;; Truly a block (setq block-type (downcase (match-string 5)) quoting (member block-type org-protecting-blocks)) (when (re-search-forward (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") nil t) ;; on purpose, we look further than LIMIT (setq end (match-end 0) end1 (1- (match-beginning 0))) + (setq block-end (match-beginning 0)) (when quoting (remove-text-properties beg end '(display t invisible t intangible t))) @@ -4570,15 +5138,32 @@ will be prompted for." beg end '(font-lock-fontified t font-lock-multiline t)) (add-text-properties beg beg1 '(face org-meta-line)) - (add-text-properties end1 end '(face org-meta-line)) + (add-text-properties end1 (+ end 1) '(face org-meta-line)) + ; for end_src (cond + ((and lang org-src-fontify-natively) + (org-src-font-lock-fontify-block lang block-start block-end)) (quoting - (add-text-properties beg1 end1 '(face org-block))) + (add-text-properties beg1 (+ end1 1) '(face + org-block))) + ; end of source block + ((not org-fontify-quote-and-verse-blocks)) ((string= block-type "quote") (add-text-properties beg1 end1 '(face org-quote))) ((string= block-type "verse") (add-text-properties beg1 end1 '(face org-verse)))) t)) + ((member dc1 '("title:" "author:" "email:" "date:")) + (add-text-properties + beg (match-end 3) + (if (member (intern (substring dc1 0 -1)) org-hidden-keywords) + '(font-lock-fontified t invisible t) + '(font-lock-fontified t face org-document-info-keyword))) + (add-text-properties + (match-beginning 6) (match-end 6) + (if (string-equal dc1 "title:") + '(font-lock-fontified t face org-document-title) + '(font-lock-fontified t face org-document-info)))) ((not (member (char-after beg) '(?\ ?\t))) ;; just any other in-buffer setting, but not indented (add-text-properties @@ -4586,7 +5171,8 @@ will be prompted for." '(font-lock-fontified t face org-meta-line)) t) ((or (member dc1 '("begin:" "end:" "caption:" "label:" - "orgtbl:" "tblfm:" "tblname:")) + "orgtbl:" "tblfm:" "tblname:" "result:" + "results:" "source:" "srcname:" "call:")) (and (match-end 4) (equal dc3 "attr"))) (add-text-properties beg (match-end 0) @@ -4742,6 +5328,7 @@ will be prompted for." ((matchers (plist-get org-format-latex-options :matchers)) (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x)) org-latex-regexps))) + (org-export-allow-BIND nil) (options (org-combine-plists (org-default-export-plist) (org-infile-export-plist))) (org-export-with-sub-superscripts (plist-get options :sub-superscript)) @@ -4763,12 +5350,17 @@ will be prompted for." (if org-export-with-TeX-macros (list (concat "\\\\" (regexp-opt - (append (mapcar 'car org-html-entities) - (if (boundp 'org-latex-entities) - (mapcar (lambda (x) - (or (car-safe x) x)) - org-latex-entities) - nil)) + (append + + (delq nil + (mapcar 'car-safe + (append org-entities-user + org-entities))) + (if (boundp 'org-latex-entities) + (mapcar (lambda (x) + (or (car-safe x) x)) + org-latex-entities) + nil)) 'words))) ; FIXME )) ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) @@ -4807,7 +5399,7 @@ will be prompted for." rtn))) (defun org-restart-font-lock () - "Restart font-lock-mode, to force refontification." + "Restart `font-lock-mode', to force refontification." (when (and (boundp 'font-lock-mode) font-lock-mode) (font-lock-mode -1) (font-lock-mode 1))) @@ -4840,9 +5432,9 @@ between words." "\\)\\>"))) (defun org-activate-tags (limit) - (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) + (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t) (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) (add-text-properties (match-beginning 1) (match-end 1) (list 'mouse-face 'highlight 'keymap org-mouse-map)) @@ -4852,7 +5444,7 @@ between words." (defun org-outline-level () "Compute the outline level of the heading at point. This function assumes that the cursor is at the beginning of a line matched -by outline-regexp. Otherwise it returns garbage. +by `outline-regexp'. Otherwise it returns garbage. If this is called at a normal headline, the level is the number of stars. Use `org-reduced-level' to remove the effect of `org-odd-levels'. For plain list items, if they are matched by `outline-regexp', this returns @@ -4871,6 +5463,12 @@ For plain list items, if they are matched by `outline-regexp', this returns (defvar org-font-lock-hook nil "Functions to be called for special font lock stuff.") +(defvar org-font-lock-set-keywords-hook nil + "Functions that can manipulate `org-font-lock-extra-keywords'. +This is calles after `org-font-lock-extra-keywords' is defined, but before +it is installed to be used by font lock. This can be useful if something +needs to be inserted at a specific position in the font-lock sequence.") + (defun org-font-lock-hook (limit) (run-hook-with-args 'org-font-lock-hook limit)) @@ -4895,7 +5493,7 @@ For plain list items, if they are matched by `outline-regexp', this returns '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) - '("| *\\(<[lr]?[0-9]*>\\)" (1 'org-formula t)) + '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t)) ;; Drawers (list org-drawer-regexp '(0 'org-special-keyword t)) (list "^[ \t]*:END:" '(0 'org-special-keyword t)) @@ -4939,19 +5537,21 @@ For plain list items, if they are matched by `outline-regexp', this returns '(org-do-emphasis-faces (0 nil append)) '(org-do-emphasis-faces))) ;; Checkboxes - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" - 2 'org-checkbox prepend) - (if org-provide-checkbox-statistics + '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" + 1 'org-checkbox prepend) + (if (cdr (assq 'checkbox org-list-automatic-rules)) '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" (0 (org-get-checkbox-statistics-face) t))) ;; Description list items - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(.*? ::\\)" + '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(.*? ::\\)" 2 'bold prepend) ;; ARCHIVEd headings (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") '(1 'org-archived prepend)) ;; Specials '(org-do-latex-and-special-faces) + '(org-fontify-entities) + '(org-raise-scripts) ;; Code '(org-activate-code (1 'org-code t)) ;; COMMENT @@ -4963,14 +5563,48 @@ For plain list items, if they are matched by `outline-regexp', this returns '(org-fontify-meta-lines-and-blocks) ))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) + (run-hooks 'org-font-lock-set-keywords-hook) ;; Now set the full font-lock-keywords (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) (org-set-local 'font-lock-defaults '(org-font-lock-keywords t nil nil backward-paragraph)) (kill-local-variable 'font-lock-keywords) nil)) +(defun org-toggle-pretty-entities () + "Toggle the composition display of entities as UTF8 characters." + (interactive) + (org-set-local 'org-pretty-entities (not org-pretty-entities)) + (org-restart-font-lock) + (if org-pretty-entities + (message "Entities are displayed as UTF8 characers") + (save-restriction + (widen) + (org-decompose-region (point-min) (point-max)) + (message "Entities are displayed plain")))) + +(defun org-fontify-entities (limit) + "Find an entity to fontify." + (let (ee) + (when org-pretty-entities + (catch 'match + (while (re-search-forward + "\\\\\\([a-zA-Z][a-zA-Z0-9]*\\)\\($\\|[^[:alnum:]\n]\\)" + limit t) + (if (and (not (org-in-indented-comment-line)) + (setq ee (org-entity-get (match-string 1))) + (= (length (nth 6 ee)) 1)) + (progn + (add-text-properties + (match-beginning 0) (match-end 1) + (list 'font-lock-fontified t)) + (compose-region (match-beginning 0) (match-end 1) + (nth 6 ee) nil) + (backward-char 1) + (throw 'match t)))) + nil)))) + (defun org-fontify-like-in-org-mode (s &optional odd-levels) - "Fontify string S like in Org-mode" + "Fontify string S like in Org-mode." (with-temp-buffer (insert s) (let ((org-odd-levels-only odd-levels)) @@ -4982,23 +5616,36 @@ For plain list items, if they are matched by `outline-regexp', this returns (defvar org-l nil) (defvar org-f nil) (defun org-get-level-face (n) - "Get the right face for match N in font-lock matching of headlines." - (setq org-l (- (match-end 2) (match-beginning 1) 1)) - (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) - (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) - (cond - ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) - ((eq n 2) org-f) - (t (if org-level-color-stars-only nil org-f)))) + "Get the right face for match N in font-lock matching of headlines." + (setq org-l (- (match-end 2) (match-beginning 1) 1)) + (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) + (if org-cycle-level-faces + (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) + (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces))) + (cond + ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) + ((eq n 2) org-f) + (t (if org-level-color-stars-only nil org-f)))) + (defun org-get-todo-face (kwd) "Get the right face for a TODO keyword KWD. If KWD is a number, get the corresponding match group." (if (numberp kwd) (setq kwd (match-string kwd))) - (or (cdr (assoc kwd org-todo-keyword-faces)) + (or (org-face-from-face-or-color + 'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces))) (and (member kwd org-done-keywords) 'org-done) 'org-todo)) +(defun org-face-from-face-or-color (context inherit face-or-color) + "Create a face list that inherits INHERIT, but sets the foreground color. +When FACE-OR-COLOR is not a string, just return it." + (if (stringp face-or-color) + (list :inherit inherit + (cdr (assoc context org-faces-easy-properties)) + face-or-color) + face-or-color)) + (defun org-font-lock-add-tag-faces (limit) "Add the special tag faces." (when (and org-tag-faces org-tags-special-faces-re) @@ -5013,8 +5660,10 @@ If KWD is a number, get the corresponding match group." (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t) (add-text-properties (match-beginning 0) (match-end 0) - (list 'face (or (cdr (assoc (char-after (match-beginning 1)) - org-priority-faces)) + (list 'face (or (org-face-from-face-or-color + 'priority 'org-special-keyword + (cdr (assoc (char-after (match-beginning 1)) + org-priority-faces))) 'org-special-keyword) 'font-lock-fontified t)))) @@ -5022,7 +5671,8 @@ If KWD is a number, get the corresponding match group." "Get the right face for a TODO keyword KWD. If KWD is a number, get the corresponding match group." (if (numberp kwd) (setq kwd (match-string kwd))) - (or (cdr (assoc kwd org-tag-faces)) + (or (org-face-from-face-or-color + 'tag 'org-tag (cdr (assoc kwd org-tag-faces))) 'org-tag)) (defun org-unfontify-region (beg end &optional maybe_loudly) @@ -5032,6 +5682,7 @@ If KWD is a number, get the corresponding match group." (inhibit-read-only t) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) + (org-decompose-region beg end) (remove-text-properties beg end (if org-indent-mode @@ -5039,10 +5690,69 @@ If KWD is a number, get the corresponding match group." '(mouse-face t keymap t org-linked-text t invisible t intangible t line-prefix t wrap-prefix t - org-no-flyspell t) + org-no-flyspell t org-emphasis t) '(mouse-face t keymap t org-linked-text t invisible t intangible t - org-no-flyspell t))))) + org-no-flyspell t org-emphasis t))) + (org-remove-font-lock-display-properties beg end))) + +(defconst org-script-display '(((raise -0.3) (height 0.7)) + ((raise 0.3) (height 0.7)) + ((raise -0.5)) + ((raise 0.5))) + "Display properties for showing superscripts and subscripts.") + +(defun org-remove-font-lock-display-properties (beg end) + "Remove specific display properties that have been added by font lock. +The will remove the raise properties that are used to show superscripts +and subscripts." + (let (next prop) + (while (< beg end) + (setq next (next-single-property-change beg 'display nil end) + prop (get-text-property beg 'display)) + (if (member prop org-script-display) + (put-text-property beg next 'display nil)) + (setq beg next)))) + +(defun org-raise-scripts (limit) + "Add raise properties to sub/superscripts." + (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts) + (if (re-search-forward + (if (eq org-use-sub-superscripts t) + org-match-substring-regexp + org-match-substring-with-braces-regexp) + limit t) + (let* ((pos (point)) table-p comment-p + (mpos (match-beginning 3)) + (emph-p (get-text-property mpos 'org-emphasis)) + (link-p (get-text-property mpos 'mouse-face)) + (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) + (goto-char (point-at-bol)) + (setq table-p (org-looking-at-p org-table-dataline-regexp) + comment-p (org-looking-at-p "[ \t]*#")) + (goto-char pos) + ;; FIXME: Should we go back one character here, for a_b^c + ;; (goto-char (1- pos)) ;???????????????????? + (if (or comment-p emph-p link-p keyw-p) + t + (put-text-property (match-beginning 3) (match-end 0) + 'display + (if (equal (char-after (match-beginning 2)) ?^) + (nth (if table-p 3 1) org-script-display) + (nth (if table-p 2 0) org-script-display))) + (add-text-properties (match-beginning 2) (match-end 2) + (list 'invisible t + 'org-dwidth t 'org-dwidth-n 1)) + (if (and (eq (char-after (match-beginning 3)) ?{) + (eq (char-before (match-end 3)) ?})) + (progn + (add-text-properties + (match-beginning 3) (1+ (match-beginning 3)) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)) + (add-text-properties + (1- (match-end 3)) (match-end 3) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))) + t))))) ;;;; Visibility cycling, including org-goto and indirect buffer @@ -5086,6 +5796,12 @@ in special contexts. 3. SUBTREE: Show the entire subtree, including body text. If there is no subtree, switch directly from CHILDREN to FOLDED. +- When point is at the beginning of an empty headline and the variable + `org-cycle-level-after-item/entry-creation' is set, cycle the level + of the headline by demoting and promoting it to likely levels. This + speeds up creation document structure by pressing TAB once or several + times right after creating a new headline. + - When there is a numeric prefix, go up to a heading with level ARG, do a `show-subtree' and return to the previous cursor position. If ARG is negative, go up that many levels. @@ -5095,7 +5811,8 @@ in special contexts. `org-cycle-emulate-tab' for details. - Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg. + no headline in line 1, this function will act as if called with prefix arg + (C-u TAB, same as S-TAB) also when called without prefix arg. But only if also the variable `org-cycle-global-at-bob' is t." (interactive "P") (org-load-modules-maybe) @@ -5121,7 +5838,7 @@ in special contexts. (if nstars (format "\\{1,%d\\}" nstars) "+") " \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)")) (t (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))) - (bob-special (and org-cycle-global-at-bob (bobp) + (bob-special (and org-cycle-global-at-bob (not arg) (bobp) (not (looking-at outline-regexp)))) (org-cycle-hook (if bob-special @@ -5137,6 +5854,7 @@ in special contexts. (cond ((equal arg '(16)) + (setq last-command 'dummy) (org-set-startup-visibility) (message "Startup visibility, plus VISIBILITY properties")) @@ -5146,11 +5864,11 @@ in special contexts. ((org-at-table-p 'any) ;; Enter the table or move to the next field in the table - (or (org-table-recognize-table.el) - (progn - (if arg (org-table-edit-field t) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-field))))) + (if (org-at-table.el-p) + (message "Use C-c ' to edit table.el tables") + (if arg (org-table-edit-field t) + (org-table-justify-field-maybe) + (call-interactively 'org-table-next-field)))) ((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook)) @@ -5244,7 +5962,6 @@ in special contexts. (defun org-cycle-internal-local () "Do the local cycling action." - (org-back-to-heading) (let ((goal-column 0) eoh eol eos level has-children children-skipped) ;; First, some boundaries (save-excursion @@ -5261,7 +5978,6 @@ in special contexts. (while (and (not (eobp)) ;; this is like `next-line' (get-char-property (1- (point)) 'invisible)) (goto-char (next-single-char-property-change (point) 'invisible)) -;;;??? (or (bolp) (beginning-of-line 2)))) (and (eolp) (beginning-of-line 2)))) (setq eol (point))) (outline-end-of-heading) (setq eoh (point)) @@ -5269,12 +5985,15 @@ in special contexts. (outline-next-heading) (setq has-children (and (org-at-heading-p t) (> (funcall outline-level) level)))) - (org-end-of-subtree t) - (unless (eobp) - (skip-chars-forward " \t\n") - (beginning-of-line 1) ; in case this is an item - ) - (setq eos (if (eobp) (point) (1- (point))))) + ;; if we're in a list, org-end-of-subtree is in fact org-end-of-item. + (if (org-at-item-p) + (setq eos (if (and (org-end-of-item) (bolp)) + (1- (point)) + (point))) + (org-end-of-subtree t) + (unless (eobp) + (skip-chars-forward " \t\n")) + (setq eos (if (eobp) (point) (1- (point)))))) ;; Find out what to do next and set `this-command' (cond ((= eos eoh) @@ -5308,14 +6027,14 @@ in special contexts. ;; We just showed the children, or no children are there, ;; now show everything. (run-hook-with-args 'org-pre-cycle-hook 'subtree) - (org-show-subtree) + (outline-flag-region eoh eos nil) (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) (setq org-cycle-subtree-status 'subtree) (run-hook-with-args 'org-cycle-hook 'subtree)) (t ;; Default action: hide the subtree. (run-hook-with-args 'org-pre-cycle-hook 'folded) - (hide-subtree) + (outline-flag-region eoh eos t) (message "FOLDED") (setq org-cycle-subtree-status 'folded) (run-hook-with-args 'org-cycle-hook 'folded))))) @@ -5323,7 +6042,7 @@ in special contexts. ;;;###autoload (defun org-global-cycle (&optional arg) "Cycle the global visibility. For details see `org-cycle'. -With C-u prefix arg, switch to startup visibility. +With \\[universal-argument] prefix arg, switch to startup visibility. With a numeric prefix, show all headlines up to that level." (interactive "P") (let ((org-cycle-include-plain-lists @@ -5352,7 +6071,7 @@ With a numeric prefix, show all headlines up to that level." (org-set-visibility-according-to-property 'no-cleanup) (org-cycle-hide-archived-subtrees 'all) (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines 'all))) + (org-cycle-show-empty-lines t))) (defun org-set-visibility-according-to-property (&optional no-cleanup) "Switch subtree visibilities according to :VISIBILITY: property." @@ -5436,11 +6155,11 @@ This function is the default value of the hook `org-cycle-hook'." "Remove outline overlays that do not contain non-white stuff." (mapc (lambda (o) - (and (eq 'outline (org-overlay-get o 'invisible)) - (not (string-match "\\S-" (buffer-substring (org-overlay-start o) - (org-overlay-end o)))) - (org-delete-overlay o))) - (org-overlays-at pos))) + (and (eq 'outline (overlay-get o 'invisible)) + (not (string-match "\\S-" (buffer-substring (overlay-start o) + (overlay-end o)))) + (delete-overlay o))) + (overlays-at pos))) (defun org-clean-visibility-after-subtree-move () "Fix visibility issues after moving a subtree." @@ -5466,7 +6185,9 @@ This function is the default value of the hook `org-cycle-hook'." ;; Properly fold already folded siblings (goto-char (point-min)) (while (re-search-forward re nil t) - (if (save-excursion (goto-char (point-at-eol)) (org-invisible-p)) + (if (and (not (org-invisible-p)) + (save-excursion + (goto-char (point-at-eol)) (org-invisible-p))) (hide-entry)))) (org-cycle-show-empty-lines 'overview) (org-cycle-hide-drawers 'overview))))) @@ -5580,12 +6301,49 @@ open and agenda-wise Org files." (defun org-first-headline-recenter (&optional N) "Move cursor to the first headline and recenter the headline. -Optional argument N means, put the headline into the Nth line of the window." +Optional argument N means put the headline into the Nth line of the window." (goto-char (point-min)) (when (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t) (beginning-of-line) (recenter (prefix-numeric-value N)))) +;;; Saving and restoring visibility + +(defun org-outline-overlay-data (&optional use-markers) + "Return a list of the locations of all outline overlays. +These are overlays with the `invisible' property value `outline'. +The return value is a list of cons cells, with start and stop +positions for each overlay. +If USE-MARKERS is set, return the positions as markers." + (let (beg end) + (save-excursion + (save-restriction + (widen) + (delq nil + (mapcar (lambda (o) + (when (eq (overlay-get o 'invisible) 'outline) + (setq beg (overlay-start o) + end (overlay-end o)) + (and beg end (> end beg) + (if use-markers + (cons (move-marker (make-marker) beg) + (move-marker (make-marker) end)) + (cons beg end))))) + (overlays-in (point-min) (point-max)))))))) + +(defun org-set-outline-overlay-data (data) + "Create visibility overlays for all positions in DATA. +DATA should have been made by `org-outline-overlay-data'." + (let (o) + (save-excursion + (save-restriction + (widen) + (show-all) + (mapc (lambda (c) + (setq o (make-overlay (car c) (cdr c))) + (overlay-put o 'invisible 'outline)) + data))))) + ;;; Folding of blocks (defconst org-block-regexp @@ -5598,9 +6356,8 @@ Optional argument N means, put the headline into the Nth line of the window." (make-variable-buffer-local 'org-hide-block-overlays) (defun org-block-map (function &optional start end) - "Call func at the head of all source blocks in the current -buffer. Optional arguments START and END can be used to limit -the range." + "Call FUNCTION at the head of all source blocks in the current buffer. +Optional arguments START and END can be used to limit the range." (let ((start (or start (point-min))) (end (or end (point-max)))) (save-excursion @@ -5623,7 +6380,8 @@ the range." (defun org-show-block-all () "Unfold all blocks in the current buffer." - (mapc 'org-delete-overlay org-hide-block-overlays) + (interactive) + (mapc 'delete-overlay org-hide-block-overlays) (setq org-hide-block-overlays nil)) (defun org-hide-block-toggle-maybe () @@ -5647,30 +6405,30 @@ the range." (end (match-end 0)) ;; end of entire body ov) (if (memq t (mapcar (lambda (overlay) - (eq (org-overlay-get overlay 'invisible) + (eq (overlay-get overlay 'invisible) 'org-hide-block)) - (org-overlays-at start))) + (overlays-at start))) (if (or (not force) (eq force 'off)) (mapc (lambda (ov) (when (member ov org-hide-block-overlays) (setq org-hide-block-overlays (delq ov org-hide-block-overlays))) - (when (eq (org-overlay-get ov 'invisible) + (when (eq (overlay-get ov 'invisible) 'org-hide-block) - (org-delete-overlay ov))) - (org-overlays-at start))) - (setq ov (org-make-overlay start end)) - (org-overlay-put ov 'invisible 'org-hide-block) + (delete-overlay ov))) + (overlays-at start))) + (setq ov (make-overlay start end)) + (overlay-put ov 'invisible 'org-hide-block) ;; make the block accessible to isearch - (org-overlay-put + (overlay-put ov 'isearch-open-invisible (lambda (ov) (when (member ov org-hide-block-overlays) (setq org-hide-block-overlays (delq ov org-hide-block-overlays))) - (when (eq (org-overlay-get ov 'invisible) + (when (eq (overlay-get ov 'invisible) 'org-hide-block) - (org-delete-overlay ov)))) + (delete-overlay ov)))) (push ov org-hide-block-overlays))) (error "Not looking at a source block")))) @@ -5755,7 +6513,9 @@ the headline hierarchy above." (selected-point (if (eq interface 'outline) (car (org-get-location (current-buffer) org-goto-help)) - (nth 3 (org-refile-get-location "Goto: "))))) + (let ((pa (org-refile-get-location "Goto: "))) + (org-refile-check-position pa) + (nth 3 pa))))) (if selected-point (progn (org-mark-ring-push org-goto-start-pos) @@ -5776,7 +6536,11 @@ or nil." (isearch-hide-immediately nil) (isearch-search-fun-function (lambda () 'org-goto-local-search-headings)) - (org-goto-selected-point org-goto-exit-command)) + (org-goto-selected-point org-goto-exit-command) + (pop-up-frames nil) + (special-display-buffer-names nil) + (special-display-regexps nil) + (special-display-function nil)) (save-excursion (save-window-excursion (delete-other-windows) @@ -5883,10 +6647,12 @@ With numerical prefix ARG, go up to this level and then take that tree. If ARG is negative, go up that many levels. If `org-indirect-buffer-display' is not `new-frame', the command removes the indirect buffer previously made with this command, to avoid proliferation of -indirect buffers. However, when you call the command with a `C-u' prefix, or +indirect buffers. However, when you call the command with a \ +\\[universal-argument] prefix, or when `org-indirect-buffer-display' is `new-frame', the last buffer is kept so that you can work with several indirect buffers at the same time. -If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also +If `org-indirect-buffer-display' is `dedicated-frame', the \ +\\[universal-argument] prefix also requests that a new frame be made for the new buffer, so that the dedicated frame is not changed." (interactive "P") @@ -5903,7 +6669,9 @@ frame is not changed." (outline-up-heading 1 t))) (setq beg (point) heading (org-get-heading)) - (org-end-of-subtree t t) (setq end (point))) + (org-end-of-subtree t t) + (if (org-on-heading-p) (backward-char 1)) + (setq end (point))) (if (and (buffer-live-p org-last-indirect-buffer) (not (eq org-indirect-buffer-display 'new-frame)) (not arg)) @@ -5965,21 +6733,44 @@ frame is not changed." (save-match-data (looking-at "[ \t]*$"))))) -(defun org-insert-heading (&optional force-heading) +(defun org-insert-heading (&optional force-heading invisible-ok) "Insert a new heading or item with same depth at point. If point is in a plain list and FORCE-HEADING is nil, create a new list item. If point is at the beginning of a headline, insert a sibling before the -current headline. If point is not at the beginning, do not split the line, -but create the new headline after the current line." +current headline. If point is not at the beginning, split the line, +create the new headline with the text in the current line after point +\(but see also the variable `org-M-RET-may-split-line'). + +When INVISIBLE-OK is set, stop at invisible headlines when going back. +This is important for non-interactive uses of the command." (interactive "P") - (if (= (buffer-size) 0) - (insert "\n* ") + (if (or (= (buffer-size) 0) + (and (not (save-excursion + (and (ignore-errors (org-back-to-heading invisible-ok)) + (org-on-heading-p)))) + (not (org-in-item-p)))) + (progn + (insert "\n* ") + (run-hooks 'org-insert-heading-hook)) (when (or force-heading (not (org-insert-item))) (let* ((empty-line-p nil) + (level nil) + (on-heading (org-on-heading-p)) (head (save-excursion (condition-case nil (progn - (org-back-to-heading) + (org-back-to-heading invisible-ok) + (when (and (not on-heading) + (featurep 'org-inlinetask) + (integerp org-inlinetask-min-level) + (>= (length (match-string 0)) + org-inlinetask-min-level)) + ;; Find a heading level before the inline task + (while (and (setq level (org-up-heading-safe)) + (>= level org-inlinetask-min-level))) + (if (org-on-heading-p) + (org-back-to-heading invisible-ok) + (error "This should not happen"))) (setq empty-line-p (org-previous-line-empty-p)) (match-string 0)) (error "*")))) @@ -6017,6 +6808,12 @@ but create the new headline after the current line." (cond (org-insert-heading-respect-content (org-end-of-subtree nil t) + (when (featurep 'org-inlinetask) + (while (and (not (eobp)) + (looking-at "\\(\\*+\\)[ \t]+") + (>= (length (match-string 1)) + org-inlinetask-min-level)) + (org-end-of-subtree nil t))) (or (bolp) (newline)) (or (org-previous-line-empty-p) (and blank (newline))) @@ -6025,13 +6822,16 @@ but create the new headline after the current line." (when hide-previous (show-children) (org-show-entry)) - (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") + (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$") (setq tags (and (match-end 2) (match-string 2))) (and (match-end 1) (delete-region (match-beginning 1) (match-end 1))) (setq pos (point-at-bol)) (or split (end-of-line 1)) (delete-horizontal-space) + (if (string-match "\\`\\*+\\'" + (buffer-substring (point-at-bol) (point))) + (insert " ")) (newline (if blank 2 1)) (when tags (save-excursion @@ -6058,7 +6858,7 @@ but create the new headline after the current line." (org-back-to-heading t) (if (looking-at (if no-tags - (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@]+:[ \t]*\\)?$") + (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$") "\\*+[ \t]+\\([^\r\n]*\\)")) (match-string 1) ""))) @@ -6073,7 +6873,7 @@ This is a list with the following elements: - the tags string, or nil." (save-excursion (org-back-to-heading t) - (if (looking-at org-complex-heading-regexp) + (if (let (case-fold-search) (looking-at org-complex-heading-regexp)) (list (length (match-string 1)) (org-reduced-level (length (match-string 1))) (org-match-string-no-properties 2) @@ -6143,7 +6943,7 @@ Works for outline headings and for plain lists alike." (org-insert-heading arg) (cond ((org-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) + ((org-at-item-p) (org-indent-item)))) (defun org-insert-todo-subheading (arg) "Insert a new subheading with TODO keyword or checkbox and demote it. @@ -6152,7 +6952,7 @@ Works for outline headings and for plain lists alike." (org-insert-todo-heading arg) (cond ((org-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) + ((org-at-item-p) (org-indent-item)))) ;;; Promotion and Demotion @@ -6220,17 +7020,37 @@ in the region." "Return the level of the current entry, or nil if before the first headline. The level is the number of stars at the beginning of the headline." (save-excursion - (condition-case nil - (progn - (org-back-to-heading t) - (funcall outline-level)) - (error nil)))) + (let ((outline-regexp (org-get-limited-outline-regexp))) + (condition-case nil + (progn + (org-back-to-heading t) + (funcall outline-level)) + (error nil))))) + +(defun org-get-previous-line-level () + "Return the outline depth of the last headline before the current line. +Returns 0 for the first headline in the buffer, and nil if before the +first headline." + (let ((current-level (org-current-level)) + (prev-level (when (> (line-number-at-pos) 1) + (save-excursion + (beginning-of-line 0) + (org-current-level))))) + (cond ((null current-level) nil) ; Before first headline + ((null prev-level) 0) ; At first headline + (prev-level)))) (defun org-reduced-level (l) "Compute the effective level of a heading. This takes into account the setting of `org-odd-levels-only'." (if org-odd-levels-only (1+ (floor (/ l 2))) l)) +(defun org-level-increment () + "Return the number of stars that will be added or removed at a +time to headlines when structure editing, based on the value of +`org-odd-levels-only'." + (if org-odd-levels-only 2 1)) + (defun org-get-valid-level (level &optional change) "Rectify a level change under the influence of `org-odd-levels-only' LEVEL is a current level, CHANGE is by how much the level should be @@ -6278,30 +7098,41 @@ in the region." (if org-adapt-indentation (org-fixup-indentation diff)) (run-hooks 'org-after-demote-entry-hook))) -(defvar org-tab-ind-state nil) - (defun org-cycle-level () + "Cycle the level of an empty headline through possible states. +This goes first to child, then to parent, level, then up the hierarchy. +After top level, it switches back to sibling level." + (interactive) (let ((org-adapt-indentation nil)) - (when (and (looking-at "[ \t]*$") - (looking-back - (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp "\\)?[ \t]*"))) - (setq this-command 'org-cycle-level) - (if (eq last-command 'org-cycle-level) - (condition-case nil - (progn (org-do-promote) - (if (equal org-tab-ind-state (org-current-level)) - (org-do-promote))) - (error - (progn - (save-excursion - (beginning-of-line 1) - (and (looking-at "\\*+") - (replace-match - (make-string org-tab-ind-state ?*)))) - (setq this-command 'org-cycle)))) - (setq org-tab-ind-state (- (match-end 1) (match-beginning 1))) - (org-do-demote)) - t))) + (when (org-point-at-end-of-empty-headline) + (setq this-command 'org-cycle-level) ; Only needed for caching + (let ((cur-level (org-current-level)) + (prev-level (org-get-previous-line-level))) + (cond + ;; If first headline in file, promote to top-level. + ((= prev-level 0) + (loop repeat (/ (- cur-level 1) (org-level-increment)) + do (org-do-promote))) + ;; If same level as prev, demote one. + ((= prev-level cur-level) + (org-do-demote)) + ;; If parent is top-level, promote to top level if not already. + ((= prev-level 1) + (loop repeat (/ (- cur-level 1) (org-level-increment)) + do (org-do-promote))) + ;; If top-level, return to prev-level. + ((= cur-level 1) + (loop repeat (/ (- prev-level 1) (org-level-increment)) + do (org-do-demote))) + ;; If less than prev-level, promote one. + ((< cur-level prev-level) + (org-do-promote)) + ;; If deeper than prev-level, promote until higher than + ;; prev-level. + ((> cur-level prev-level) + (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment))) + do (org-do-promote)))) + t)))) (defun org-map-tree (fun) "Call FUN for every heading underneath the current one." @@ -6331,7 +7162,7 @@ in the region." (funcall fun))))) (defun org-fixup-indentation (diff) - "Change the indentation in the current entry by DIFF + "Change the indentation in the current entry by DIFF. However, if any line in the current entry has no indentation, or if it would end up with no indentation after the change, nothing at all is done." (save-excursion @@ -6369,10 +7200,11 @@ level 5 etc." (end-of-line 1)))))) (defun org-convert-to-oddeven-levels () - "Convert an org-mode file with only odd levels to one with odd and even levels. -This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a -section with an even level, conversion would destroy the structure of the file. An error -is signaled in this case." + "Convert an org-mode file with only odd levels to one with odd/even levels. +This promotes level 3 to level 2, level 5 to level 3 etc. If the +file contains a section with an even level, conversion would +destroy the structure of the file. An error is signaled in this +case." (interactive) (goto-char (point-min)) ;; First check if there are no even levels @@ -6707,20 +7539,27 @@ If yes, remember the marker and the distance to BEG." (save-match-data (narrow-to-region (progn (org-back-to-heading t) (point)) - (progn (org-end-of-subtree t t) (point)))))) + (progn (org-end-of-subtree t t) + (if (and (org-on-heading-p) (not (eobp))) (backward-char 1)) + (point)))))) + +(eval-when-compile + (defvar org-property-drawer-re)) +(defvar org-property-start-re) ;; defined below (defun org-clone-subtree-with-time-shift (n &optional shift) "Clone the task (subtree) at point N times. The clones will be inserted as siblings. -In interactive use, the user will be prompted for the number of clones -to be produced, and for a time SHIFT, which may be a repeater as used -in time stamps, for example `+3d'. +In interactive use, the user will be prompted for the number of +clones to be produced, and for a time SHIFT, which may be a +repeater as used in time stamps, for example `+3d'. -When a valid repeater is given and the entry contains any time stamps, -the clones will become a sequence in time, with time stamps in the -subtree shifted for each clone produced. If SHIFT is nil or the -empty string, time stamps will be left alone. +When a valid repeater is given and the entry contains any time +stamps, the clones will become a sequence in time, with time +stamps in the subtree shifted for each clone produced. If SHIFT +is nil or the empty string, time stamps will be left alone. The +ID property of the original subtree is removed. If the original subtree did contain time stamps with a repeater, the following will happen: @@ -6734,7 +7573,7 @@ the following will happen: I this way you can spell out a number of instances of a repeating task, and still retain the repeater to cover future instances of the task." (interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ") - (let (beg end template task + (let (beg end template task idprop shift-n shift-what doshift nmin nmax (n-no-remove -1)) (if (not (and (integerp n) (> n 0))) (error "Invalid number of replications %s" n)) @@ -6751,6 +7590,7 @@ and still retain the repeater to cover future instances of the task." (setq nmin 1 nmax n) (org-back-to-heading t) (setq beg (point)) + (setq idprop (org-entry-get nil "ID")) (org-end-of-subtree t t) (or (bolp) (insert "\n")) (setq end (point)) @@ -6762,12 +7602,18 @@ and still retain the repeater to cover future instances of the task." (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) (goto-char end) (loop for n from nmin to nmax do - (if (not doshift) - (setq task template) - (with-temp-buffer - (insert template) - (org-mode) - (goto-char (point-min)) + ;; prepare clone + (with-temp-buffer + (insert template) + (org-mode) + (goto-char (point-min)) + (and idprop (if org-clone-delete-id + (org-entry-delete nil "ID") + (org-id-get-create t))) + (while (re-search-forward org-property-start-re nil t) + (org-remove-empty-drawer-at "PROPERTIES" (point))) + (goto-char (point-min)) + (when doshift (while (re-search-forward org-ts-regexp-both nil t) (org-timestamp-change (* n shift-n) shift-what)) (unless (= n n-no-remove) @@ -6776,21 +7622,23 @@ and still retain the repeater to cover future instances of the task." (save-excursion (goto-char (match-beginning 0)) (if (looking-at "<[^<>\n]+\\( +\\+[0-9]+[dwmy]\\)") - (delete-region (match-beginning 1) (match-end 1)))))) - (setq task (buffer-string)))) + (delete-region (match-beginning 1) (match-end 1))))))) + (setq task (buffer-string))) (insert task)) (goto-char beg))) ;;; Outline Sorting (defun org-sort (with-case) - "Call `org-sort-entries-or-items' or `org-table-sort-lines'. + "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'. Optional argument WITH-CASE means sort case-sensitively. With a double prefix argument, also remove duplicate entries." (interactive "P") - (if (org-at-table-p) - (org-call-with-arg 'org-table-sort-lines with-case) - (org-call-with-arg 'org-sort-entries-or-items with-case))) + (cond + ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case)) + ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case)) + (t + (org-call-with-arg 'org-sort-entries with-case)))) (defun org-sort-remove-invisible (s) (remove-text-properties 0 (length s) org-rm-props s) @@ -6808,20 +7656,18 @@ When children are sorted, the cursor is in the parent line when this hook gets called. When a region or a plain list is sorted, the cursor will be in the first entry of the sorted region/list.") -(defun org-sort-entries-or-items +(defun org-sort-entries (&optional with-case sorting-type getkey-func compare-func property) - "Sort entries on a certain level of an outline tree, or plain list items. + "Sort entries on a certain level of an outline tree. If there is an active region, the entries in the region are sorted. Else, if the cursor is before the first entry, sort the top-level items. Else, the children of the entry at point are sorted. -If the cursor is at the first item in a plain list, the list items will be -sorted. Sorting can be alphabetically, numerically, by date/time as given by a time stamp, by a property or by priority. The command prompts for the sorting type unless it has been given to the -function through the SORTING-TYPE argument, which needs to a character, +function through the SORTING-TYPE argument, which needs to be a character, \(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the precise meaning of each character: @@ -6829,7 +7675,6 @@ n Numerically, by converting the beginning of the entry/item to a number. a Alphabetically, ignoring the TODO keyword and the priority, if any. t By date/time, either the first active time stamp in the entry, or, if none exist, by the first inactive one. - In items, only the first line will be checked. s By the scheduled date/time. d By deadline date/time. c By creation time, which is assumed to be the first inactive time stamp @@ -6848,7 +7693,7 @@ WITH-CASE, the sorting considers case as well." (interactive "P") (let ((case-func (if with-case 'identity 'downcase)) start beg end stars re re2 - txt what tmp plain-list-p) + txt what tmp) ;; Find beginning and end of region to sort (cond ((org-region-active-p) @@ -6858,15 +7703,6 @@ WITH-CASE, the sorting considers case as well." (goto-char (region-beginning)) (if (not (org-on-heading-p)) (outline-next-heading)) (setq start (point))) - ((org-at-item-p) - ;; we will sort this plain list - (org-beginning-of-item-list) (setq start (point)) - (org-end-of-item-list) - (or (bolp) (insert "\n")) - (setq end (point)) - (goto-char start) - (setq plain-list-p t - what "plain list")) ((or (org-on-heading-p) (condition-case nil (progn (org-back-to-heading) t) (error nil))) ;; we will sort the children of the current headline @@ -6899,43 +7735,39 @@ WITH-CASE, the sorting considers case as well." (setq beg (point)) (if (>= beg end) (error "Nothing to sort")) - (unless plain-list-p - (looking-at "\\(\\*+\\)") - (setq stars (match-string 1) - re (concat "^" (regexp-quote stars) " +") - re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") - txt (buffer-substring beg end)) - (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) - (if (and (not (equal stars "*")) (string-match re2 txt)) - (error "Region to sort contains a level above the first entry"))) + (looking-at "\\(\\*+\\)") + (setq stars (match-string 1) + re (concat "^" (regexp-quote stars) " +") + re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") + txt (buffer-substring beg end)) + (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) + (if (and (not (equal stars "*")) (string-match re2 txt)) + (error "Region to sort contains a level above the first entry")) (unless sorting-type (message - (if plain-list-p - "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" - "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc + "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc [t]ime [s]cheduled [d]eadline [c]reated - A/N/T/S/D/C/P/O/F means reversed:") + A/N/T/S/D/C/P/O/F means reversed:" what) (setq sorting-type (read-char-exclusive)) (and (= (downcase sorting-type) ?f) (setq getkey-func (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)) + obarray 'fboundp t nil nil)) (setq getkey-func (intern getkey-func))) (and (= (downcase sorting-type) ?r) (setq property (org-icompleting-read "Property: " - (mapcar 'list (org-buffer-property-keys t)) - nil t)))) + (mapcar 'list (org-buffer-property-keys t)) + nil t)))) (message "Sorting entries...") (save-restriction (narrow-to-region start end) - (let ((dcst (downcase sorting-type)) (case-fold-search nil) (now (current-time))) @@ -6943,99 +7775,70 @@ WITH-CASE, the sorting considers case as well." (/= dcst sorting-type) ;; This function moves to the beginning character of the "record" to ;; be sorted. - (if plain-list-p - (lambda nil - (if (org-at-item-p) t (goto-char (point-max)))) - (lambda nil - (if (re-search-forward re nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max))))) + (lambda nil + (if (re-search-forward re nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)))) ;; This function moves to the last character of the "record" being ;; sorted. - (if plain-list-p - 'org-end-of-item - (lambda nil - (save-match-data - (condition-case nil - (outline-forward-same-level 1) - (error - (goto-char (point-max))))))) - + (lambda nil + (save-match-data + (condition-case nil + (outline-forward-same-level 1) + (error + (goto-char (point-max)))))) ;; This function returns the value that gets sorted against. - (if plain-list-p - (lambda nil - (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+") - (cond - ((= dcst ?n) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol)))) - ((= dcst ?a) - (buffer-substring (match-end 0) (point-at-eol))) - ((= dcst ?t) - (if (or (re-search-forward org-ts-regexp (point-at-eol) t) - (re-search-forward org-ts-regexp-both - (point-at-eol) t)) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now))) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))) - (lambda nil - (cond - ((= dcst ?n) - (if (looking-at org-complex-heading-regexp) - (string-to-number (match-string 4)) - nil)) - ((= dcst ?a) - (if (looking-at org-complex-heading-regexp) - (funcall case-func (match-string 4)) - nil)) - ((= dcst ?t) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (or (re-search-forward org-ts-regexp end t) - (re-search-forward org-ts-regexp-both end t)) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) - ((= dcst ?c) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward - (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") - end t) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) - ((= dcst ?s) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward org-scheduled-time-regexp end t) - (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) - ((= dcst ?d) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward org-deadline-time-regexp end t) - (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) - ((= dcst ?p) - (if (re-search-forward org-priority-regexp (point-at-eol) t) - (string-to-char (match-string 2)) - org-default-priority)) - ((= dcst ?r) - (or (org-entry-get nil property) "")) - ((= dcst ?o) - (if (looking-at org-complex-heading-regexp) - (- 9999 (length (member (match-string 2) - org-todo-keywords-1))))) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))) + (lambda nil + (cond + ((= dcst ?n) + (if (looking-at org-complex-heading-regexp) + (string-to-number (match-string 4)) + nil)) + ((= dcst ?a) + (if (looking-at org-complex-heading-regexp) + (funcall case-func (match-string 4)) + nil)) + ((= dcst ?t) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (or (re-search-forward org-ts-regexp end t) + (re-search-forward org-ts-regexp-both end t)) + (org-time-string-to-seconds (match-string 0)) + (org-float-time now)))) + ((= dcst ?c) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward + (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") + end t) + (org-time-string-to-seconds (match-string 0)) + (org-float-time now)))) + ((= dcst ?s) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward org-scheduled-time-regexp end t) + (org-time-string-to-seconds (match-string 1)) + (org-float-time now)))) + ((= dcst ?d) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward org-deadline-time-regexp end t) + (org-time-string-to-seconds (match-string 1)) + (org-float-time now)))) + ((= dcst ?p) + (if (re-search-forward org-priority-regexp (point-at-eol) t) + (string-to-char (match-string 2)) + org-default-priority)) + ((= dcst ?r) + (or (org-entry-get nil property) "")) + ((= dcst ?o) + (if (looking-at org-complex-heading-regexp) + (- 9999 (length (member (match-string 2) + org-todo-keywords-1))))) + ((= dcst ?f) + (if getkey-func + (progn + (setq tmp (funcall getkey-func)) + (if (stringp tmp) (setq tmp (funcall case-func tmp))) + tmp) + (error "Invalid key function `%s'" getkey-func))) + (t (error "Invalid sorting type `%c'" sorting-type)))) nil (cond ((= dcst ?a) 'string<) @@ -7114,15 +7917,15 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." "Keymap for the minor `orgstruct-mode'.") (defvar org-local-vars nil - "List of local variables, for use by `orgstruct-mode'") + "List of local variables, for use by `orgstruct-mode'.") ;;;###autoload (define-minor-mode orgstruct-mode - "Toggle the minor more `orgstruct-mode'. -This mode is for using Org-mode structure commands in other modes. -The following key behave as if Org-mode was active, if the cursor -is on a headline, or on a plain list item (both in the definition -of Org-mode). + "Toggle the minor mode `orgstruct-mode'. +This mode is for using Org-mode structure commands in other +modes. The following keys behave as if Org-mode were active, if +the cursor is on a headline, or on a plain list item (both as +defined by Org-mode). M-up Move entry/item up M-down Move entry/item down @@ -7173,7 +7976,7 @@ major mode, for example with \\[normal-mode]." (org-set-local 'orgstruct-is-++ t)))) (defvar orgstruct-is-++ nil - "Is orgstruct-mode in ++ version in the current-buffer?") + "Is `orgstruct-mode' in ++ version in the current-buffer?") (make-variable-buffer-local 'orgstruct-is-++) ;;;###autoload @@ -7415,7 +8218,7 @@ If yes, it should return a non-nil value after a calling `org-store-link-props' with a list of properties and values. Special properties are: -:type The link prefix. like \"http\". This must be given. +:type The link prefix, like \"http\". This must be given. :link The link, like \"http://www.astro.uva.nl/~dominik\". This is obligatory as well. :description Optional default description for the second pair @@ -7440,11 +8243,13 @@ It should be a function accepting three arguments: path the path of the link, the text after the prefix (like \"http:\") desc the description of the link, if any, nil if there was no description - format the export format, a symbol like `html' or `latex'. + format the export format, a symbol like `html' or `latex' or `ascii'.. The function may use the FORMAT information to return different values depending on the format. The return value will be put literally into -the exported file. +the exported file. If the return value is nil, this means Org should +do what it normally does with links which do not have EXPORT defined. + Org-mode has a built-in default for exporting links. If you are happy with this default, there is no need to define an export function for the link type. For a simple example of an export function, see `org-bbdb.el'." @@ -7469,7 +8274,7 @@ For file links, arg negates `org-context-in-file-links'." (org-load-modules-maybe) (setq org-store-link-plist nil) ; reset (let ((outline-regexp (org-get-limited-outline-regexp)) - link cpltxt desc description search txt custom-id) + link cpltxt desc description search txt custom-id agenda-link) (cond ((run-hook-with-args-until-success 'org-store-link-functions) @@ -7501,7 +8306,10 @@ For file links, arg negates `org-context-in-file-links'." (get-text-property (point) 'org-marker)))) (when m (org-with-point-at m - (call-interactively 'org-store-link))))) + (setq agenda-link + (if (interactive-p) + (call-interactively 'org-store-link) + (org-store-link nil))))))) ((eq major-mode 'calendar-mode) (let ((cd (calendar-cursor-to-date))) @@ -7540,19 +8348,23 @@ For file links, arg negates `org-context-in-file-links'." ((eq major-mode 'dired-mode) ;; link to the file in the current line - (setq cpltxt (concat "file:" - (abbreviate-file-name - (expand-file-name - (dired-get-filename nil t)))) - link (org-make-link cpltxt))) - - ((and buffer-file-name (org-mode-p)) + (let ((file (dired-get-filename nil t))) + (setq file (if file + (abbreviate-file-name + (expand-file-name (dired-get-filename nil t))) + ;; otherwise, no file so use current directory. + default-directory)) + (setq cpltxt (concat "file:" file) + link (org-make-link cpltxt)))) + + ((and (buffer-file-name (buffer-base-buffer)) (org-mode-p)) (setq custom-id (ignore-errors (org-entry-get nil "CUSTOM_ID"))) (cond ((org-in-regexp "<<\\(.*?\\)>>") (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name) + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))) "::" (match-string 1)) link (org-make-link cpltxt))) ((and (featurep 'org-id) @@ -7574,11 +8386,13 @@ For file links, arg negates `org-context-in-file-links'." (error ;; probably before first headline, link to file only (concat "file:" - (abbreviate-file-name buffer-file-name)))))) + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer)))))))) (t ;; Just link to current headline (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name))) + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) ;; Add a context search string (when (org-xor org-context-in-file-links arg) (setq txt (cond @@ -7635,7 +8449,7 @@ For file links, arg negates `org-context-in-file-links'." "::#" custom-id)) (setq org-stored-links (cons (list link desc) org-stored-links)))) - (and link (org-make-link-string link desc))))) + (or agenda-link (and link (org-make-link-string link desc)))))) (defun org-store-link-props (&rest plist) "Store link properties, extract names and addresses." @@ -7694,12 +8508,13 @@ according to FMT (default from `org-email-link-description-format')." (defun org-make-org-heading-search-string (&optional string heading) "Make search string for STRING or current headline." (interactive) - (let ((s (or string (org-get-heading)))) + (let ((s (or string (org-get-heading))) + (lines org-context-in-file-links)) (unless (and string (not heading)) ;; We are using a headline, clean up garbage in there. (if (string-match org-todo-regexp s) (setq s (replace-match "" t t s))) - (if (string-match (org-re ":[[:alnum:]_@:]+:[ \t]*$") s) + (if (string-match (org-re ":[[:alnum:]_@#%:]+:[ \t]*$") s) (setq s (replace-match "" t t s))) (setq s (org-trim s)) (if (string-match (concat "^\\(" org-quote-string "\\|" @@ -7707,9 +8522,14 @@ according to FMT (default from `org-email-link-description-format')." (setq s (replace-match "" t t s))) (while (string-match org-ts-regexp s) (setq s (replace-match "" t t s)))) - (while (string-match "[^a-zA-Z_0-9 \t]+" s) - (setq s (replace-match " " t t s))) (or string (setq s (concat "*" s))) ; Add * for headlines + (when (and string (integerp lines) (> lines 0)) + (let ((slines (org-split-string s "\n"))) + (when (< lines (length slines)) + (setq s (mapconcat + 'identity + (reverse (nthcdr (- (length slines) lines) + (reverse slines))) "\n"))))) (mapconcat 'identity (org-split-string s "[ \t]+") " "))) (defun org-make-link (&rest strings) @@ -7736,7 +8556,11 @@ according to FMT (default from `org-email-link-description-format')." (when (and (not description) (not (equal link (org-link-escape link)))) (setq description (org-extract-attributes link))) - (concat "[[" (org-link-escape link) "]" + (setq link (if (string-match org-link-types-re link) + (concat (match-string 1 link) + (org-link-escape (substring link (match-end 1)))) + (org-link-escape link))) + (concat "[[" link "]" (if description (concat "[" description "]") "") "]")) @@ -7755,7 +8579,7 @@ according to FMT (default from `org-email-link-description-format')." (?\371 . "%F9") ; `u (?\373 . "%FB") ; ^u (?\; . "%3B") - (?? . "%3F") +;; (?? . "%3F") (?= . "%3D") (?+ . "%2B") ) @@ -7771,7 +8595,7 @@ This is the list that is used before handing over to the browser.") (defun org-link-escape (text &optional table) "Escape characters in TEXT that are problematic for links." - (if org-url-encoding-use-url-hexify + (if (and org-url-encoding-use-url-hexify (not table)) (url-hexify-string text) (setq table (or table org-link-escape-chars)) (when text @@ -7788,16 +8612,18 @@ This is the list that is used before handing over to the browser.") (defun org-link-unescape (text &optional table) "Reverse the action of `org-link-escape'." - (if org-url-encoding-use-url-hexify + (if (and org-url-encoding-use-url-hexify (not table)) (url-unhex-string text) (setq table (or table org-link-escape-chars)) (when text - (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x))) + (let ((case-fold-search t) + (re (mapconcat (lambda (x) (regexp-quote (downcase (cdr x)))) table "\\|"))) (while (string-match re text) (setq text (replace-match - (char-to-string (car (rassoc (match-string 0 text) table))) + (char-to-string (car (rassoc (upcase (match-string 0 text)) + table))) t t text))) text)))) @@ -7807,6 +8633,12 @@ This is the list that is used before handing over to the browser.") (defun org-fixup-message-id-for-http (s) "Replace special characters in a message id, so it can be used in an http query." + (when (string-match "%" s) + (setq s (mapconcat (lambda (c) + (if (eq c ?%) + "%25" + (char-to-string c))) + s ""))) (while (string-match "<" s) (setq s (replace-match "%3C" t t s))) (while (string-match ">" s) @@ -7899,7 +8731,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x))) (reverse org-stored-links) "\n")))) (let ((cw (selected-window))) - (select-window (get-buffer-window "*Org Links*")) + (select-window (get-buffer-window "*Org Links*" 'visible)) (setq truncate-lines t) (unless (pos-visible-in-window-p (point-max)) (org-fit-window-to-buffer)) @@ -7924,6 +8756,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support nil nil nil 'tmphist (car (car org-stored-links))))) + (if (not (string-match "\\S-" link)) + (error "No link selected")) (if (or (member link all-prefixes) (and (equal ":" (substring link -1)) (member (substring link 0 -1) all-prefixes) @@ -7956,8 +8790,9 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (setq link search))))) ;; Check if we can/should use a relative path. If yes, simplify the link - (when (string-match "^file:\\(.*\\)" link) - (let* ((path (match-string 1 link)) + (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link) + (let* ((type (match-string 1 link)) + (path (match-string 2 link)) (origpath path) (case-fold-search nil)) (cond @@ -7971,14 +8806,15 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (t (save-match-data (if (string-match (concat "^" (regexp-quote - (file-name-as-directory - (expand-file-name ".")))) + (expand-file-name + (file-name-as-directory + default-directory)))) (expand-file-name path)) ;; We are linking a file with relative path name. (setq path (substring (expand-file-name path) (match-end 0))) (setq path (abbreviate-file-name (expand-file-name path))))))) - (setq link (concat "file:" path)) + (setq link (concat type path)) (if (equal desc origpath) (setq desc path)))) @@ -8097,6 +8933,23 @@ from." (defvar org-link-search-failed nil) +(defvar org-open-link-functions nil + "Hook for functions finding a plain text link. +These functions must take a single argument, the link content. +They will be called for links that look like [[link text][description]] +when LINK TEXT does not have a protocol like \"http:\" and does not look +like a filename (e.g. \"./blue.png\"). + +These functions will be called *before* Org attempts to resolve the +link by doing text searches in the current buffer - so if you want a +link \"[[target]]\" to still find \"<<target>>\", your function should +handle this as a special case. + +When the function does handle the link, it must return a non-nil value. +If it decides that it is not responsible for this link, it must return +nil to indicate that that Org-mode can continue with other options +like exact and fuzzy text search.") + (defun org-next-link () "Move forward to the next link. If the link is in hidden text, expose it." @@ -8209,8 +9062,19 @@ Org-mode syntax." (org-mode) (insert s) (goto-char (point-min)) + (when reference-buffer + (setq org-link-abbrev-alist-local + (with-current-buffer reference-buffer + org-link-abbrev-alist-local))) (org-open-at-point arg reference-buffer))))) +(defvar org-open-at-point-functions nil + "Hook that is run when following a link at point. + +Functions in this hook must return t if they identify and follow +a link at point. If they don't find anything interesting at point, +they must return nil.") + (defun org-open-at-point (&optional in-emacs reference-buffer) "Open link at or after point. If there is no link at point, this function will search forward up to @@ -8220,6 +9084,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file. With a double prefix argument, try to open outside of Emacs, in the application the system uses for this file type." (interactive "P") + ;; if in a code block, then open the block's results + (unless (call-interactively #'org-babel-open-src-block-result) (org-load-modules-maybe) (move-marker org-open-link-marker (point)) (setq org-window-config-before-follow-link (current-window-configuration)) @@ -8230,18 +9096,21 @@ application the system uses for this file type." (concat org-plain-link-re "\\|" org-bracket-link-regexp "\\|" org-angle-link-re "\\|" - "[ \t]:[^ \t\n]+:[ \t]*$")))) + "[ \t]:[^ \t\n]+:[ \t]*$"))) + (not (get-text-property (point) 'org-linked-text))) (or (org-offer-links-in-entry in-emacs) (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) + ((run-hook-with-args-until-success 'org-open-at-point-functions)) ((org-at-timestamp-p t) (org-follow-timestamp-link)) - ((or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) + ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) + (not (org-in-regexp org-bracket-link-regexp))) (org-footnote-action)) (t (let (type path link line search (pos (point))) (catch 'match (save-excursion (skip-chars-forward "^]\n\r") - (when (org-in-regexp org-bracket-link-regexp) + (when (org-in-regexp org-bracket-link-regexp 1) (setq link (org-extract-attributes (org-link-unescape (org-match-string-no-properties 1)))) (while (string-match " *\n *" link) @@ -8271,7 +9140,7 @@ application the system uses for this file type." (setq type (match-string 1) path (match-string 2)) (throw 'match t))) (save-excursion - (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) + (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) (setq type "tags" path (match-string 1)) (while (string-match ":" path) @@ -8325,24 +9194,16 @@ application the system uses for this file type." (browse-url (concat type ":" (org-link-escape path org-link-escape-chars-browser)))) + ((string= type "doi") + (browse-url (concat "http://dx.doi.org/" + (org-link-escape + path org-link-escape-chars-browser)))) + ((member type '("message")) (browse-url (concat type ":" path))) ((string= type "tags") (org-tags-view in-emacs path)) - ((string= type "thisfile") - (if in-emacs - (switch-to-buffer-other-window - (org-get-buffer-for-internal-link (current-buffer))) - (org-mark-ring-push)) - (let ((cmd `(org-link-search - ,path - ,(cond ((equal in-emacs '(4)) 'occur) - ((equal in-emacs '(16)) 'org-occur) - (t nil)) - ,pos))) - (condition-case nil (eval cmd) - (error (progn (widen) (eval cmd)))))) ((string= type "tree-match") (org-occur (concat "\\[" (regexp-quote path) "\\]"))) @@ -8358,10 +9219,6 @@ application the system uses for this file type." (dired path) (org-open-file path in-emacs line search))) - ((string= type "news") - (require 'org-gnus) - (org-gnus-follow-link path)) - ((string= type "shell") (let ((cmd path)) (if (or (not org-confirm-shell-link-function) @@ -8387,10 +9244,28 @@ application the system uses for this file type." (call-interactively (read cmd)))) (error "Abort")))) + ((and (string= type "thisfile") + (run-hook-with-args-until-success + 'org-open-link-functions path))) + + ((string= type "thisfile") + (if in-emacs + (switch-to-buffer-other-window + (org-get-buffer-for-internal-link (current-buffer))) + (org-mark-ring-push)) + (let ((cmd `(org-link-search + ,path + ,(cond ((equal in-emacs '(4)) 'occur) + ((equal in-emacs '(16)) 'org-occur) + (t nil)) + ,pos))) + (condition-case nil (eval cmd) + (error (progn (widen) (eval cmd)))))) + (t (browse-url-at-point))))))) (move-marker org-open-link-marker nil) - (run-hook-with-args 'org-follow-link-hook)) + (run-hook-with-args 'org-follow-link-hook))) (defun org-offer-links-in-entry (&optional nth zero) "Offer links in the current entry and follow the selected link. @@ -8418,7 +9293,7 @@ there is one, offer it as link number zero." ((null links) (message "No links")) ((equal (length links) 1) - (setq link (car links))) + (setq link (list (car links)))) ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) (setq link (nth (if have-zero nth (1- nth)) links))) (t ; we have to select a link @@ -8437,19 +9312,44 @@ there is one, offer it as link number zero." (match-string 1 l)))))) links)) (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) - (message "Select link to open:") + (message "Select link to open, RET to open all:") (setq c (read-char-exclusive)) (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) (when (equal c ?q) (error "Abort")) - (setq nth (- c ?0)) - (if have-zero (setq nth (1+ nth))) - (unless (and (integerp nth) (>= (length links) nth)) - (error "Invalid link selection")) - (setq link (nth (1- nth) links)))) + (if (equal c ?\C-m) + (setq link links) + (setq nth (- c ?0)) + (if have-zero (setq nth (1+ nth))) + (unless (and (integerp nth) (>= (length links) nth)) + (error "Invalid link selection")) + (setq link (list (nth (1- nth) links)))))) (if link - (progn (org-open-link-from-string link in-emacs (current-buffer)) t) + (let ((buf (current-buffer))) + (dolist (l link) + (org-open-link-from-string l in-emacs buf)) + t) nil))) +;; Add special file links that specify the way of opening + +(org-add-link-type "file+sys" 'org-open-file-with-system) +(org-add-link-type "file+emacs" 'org-open-file-with-emacs) +(defun org-open-file-with-system (path) + "Open file at PATH using the system way of opening it." + (org-open-file path 'system)) +(defun org-open-file-with-emacs (path) + "Open file at PATH in Emacs." + (org-open-file path 'emacs)) +(defun org-remove-file-link-modifiers () + "Remove the file link modifiers in `file+sys:' and `file+emacs:' links." + (goto-char (point-min)) + (while (re-search-forward "\\<file\\+\\(sys\\|emacs\\):" nil t) + (org-if-unprotected + (replace-match "file:" t t)))) +(eval-after-load "org-exp" + '(add-hook 'org-export-preprocess-before-normalizing-links-hook + 'org-remove-file-link-modifiers)) + ;;;; Time estimates (defun org-get-effort (&optional pom) @@ -8464,8 +9364,8 @@ These functions are called in turn with point at the location to which the link should point. A function in the hook should first test if it would like to -handle this file type, for example by checking the major-mode or -the file extension. If it decides not to handle this file, it +handle this file type, for example by checking the `major-mode' +or the file extension. If it decides not to handle this file, it should just return nil to give other functions a chance. If it does handle the file, it must return the search string to be used when following the link. The search string will be part of the @@ -8486,8 +9386,8 @@ buffer with \\[org-insert-link].") Functions added to this hook must accept a single argument, the search string that was part of the file link, the part after the double colon. The function must first check if it would like to -handle this search, for example by checking the major-mode or the -file extension. If it decides not to handle this search, it +handle this search, for example by checking the `major-mode' or +the file extension. If it decides not to handle this search, it should just return nil to give other functions a chance. If it does handle the search, it must return a non-nil value to keep other functions from trying. @@ -8502,6 +9402,7 @@ the window configuration before `org-open-at-point' was called using: (set-window-configuration org-window-config-before-follow-link)") +(defvar org-link-search-inhibit-query nil) ;; dynamically scoped (defun org-link-search (s &optional type avoid-pos) "Search for a link search option. If S is surrounded by forward slashes, it is interpreted as a @@ -8519,7 +9420,7 @@ in all files. If AVOID-POS is given, ignore matches near that position." (pre nil) (post nil) words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall) (cond - ;; First check if there are any special + ;; First check if there are any special search functions ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) ;; Now try the builtin stuff ((and (equal (string-to-char s0) ?#) @@ -8564,12 +9465,33 @@ in all files. If AVOID-POS is given, ignore matches near that position." ;;((eq major-mode 'dired-mode) ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) (t (org-do-occur (match-string 1 s))))) + ((and (org-mode-p) org-link-search-must-match-exact-headline) + (and (equal (string-to-char s) ?*) (setq s (substring s 1))) + (goto-char (point-min)) + (cond + ((let (case-fold-search) + (re-search-forward (format org-complex-heading-regexp-format + (regexp-quote s)) + nil t)) + ;; OK, found a match + (setq type 'dedicated) + (goto-char (match-beginning 0))) + ((and (not org-link-search-inhibit-query) + (eq org-link-search-must-match-exact-headline 'query-to-create) + (y-or-n-p "No match - create this as a new heading? ")) + (goto-char (point-max)) + (or (bolp) (newline)) + (insert "* " s "\n") + (beginning-of-line 0)) + (t + (goto-char pos) + (error "No match")))) (t - ;; A normal search strings + ;; A normal search string (when (equal (string-to-char s) ?*) ;; Anchor on headlines, post may include tags. (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*" - post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$") + post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@#%:+]:[ \t]*\\)?$") s (substring s 1))) (remove-text-properties 0 (length s) @@ -8610,13 +9532,7 @@ in all files. If AVOID-POS is given, ignore matches near that position." ) (goto-char (match-beginning 1)) (goto-char pos) - (error "No match"))))) - (t - ;; Normal string-search - (goto-char (point-min)) - (if (search-forward s nil t) - (goto-char (match-beginning 0)) - (error "No match")))) + (error "No match")))))) (and (org-mode-p) (org-show-context 'link-search)) type)) @@ -8759,18 +9675,23 @@ entry for this file type, and if yes, the corresponding command is launched. If no application is found, Emacs simply visits the file. With optional prefix argument IN-EMACS, Emacs will visit the file. -With a double C-c C-u prefix arg, Org tries to avoid opening in Emacs -and o use an external application to visit the file. - -Optional LINE specifies a line to go to, optional SEARCH a string to -search for. If LINE or SEARCH is given, the file will always be -opened in Emacs. +With a double \\[universal-argument] \\[universal-argument] \ +prefix arg, Org tries to avoid opening in Emacs +and to use an external application to visit the file. + +Optional LINE specifies a line to go to, optional SEARCH a string +to search for. If LINE or SEARCH is given, the file will be +opened in Emacs, unless an entry from org-file-apps that makes +use of groups in a regexp matches. If the file does not exist, an error is thrown." - (setq in-emacs (or in-emacs line search)) (let* ((file (if (equal path "") buffer-file-name (substitute-in-file-name (expand-file-name path)))) - (apps (append org-file-apps (org-default-apps))) + (file-apps (append org-file-apps (org-default-apps))) + (apps (org-remove-if + 'org-file-apps-entry-match-against-dlink-p file-apps)) + (apps-dlink (org-remove-if-not + 'org-file-apps-entry-match-against-dlink-p file-apps)) (remp (and (assq 'remote apps) (org-file-remote-p file))) (dirp (if remp nil (file-directory-p file))) (file (if (and dirp org-open-directory-means-index-dot-org) @@ -8778,21 +9699,41 @@ If the file does not exist, an error is thrown." file)) (a-m-a-p (assq 'auto-mode apps)) (dfile (downcase file)) + ;; reconstruct the original file: link from the PATH, LINE and SEARCH args + (link (cond ((and (eq line nil) + (eq search nil)) + file) + (line + (concat file "::" (number-to-string line))) + (search + (concat file "::" search)))) + (dlink (downcase link)) (old-buffer (current-buffer)) (old-pos (point)) (old-mode major-mode) - ext cmd) + ext cmd link-match-data) (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) (setq ext (match-string 1 dfile)) (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) (setq ext (match-string 1 dfile)))) (cond - ((equal in-emacs '(16)) + ((member in-emacs '((16) system)) (setq cmd (cdr (assoc 'system apps)))) (in-emacs (setq cmd 'emacs)) (t (setq cmd (or (and remp (cdr (assoc 'remote apps))) (and dirp (cdr (assoc 'directory apps))) + ; first, try matching against apps-dlink + ; if we get a match here, store the match data for later + (let ((match (assoc-default dlink apps-dlink + 'string-match))) + (if match + (progn (setq link-match-data (match-data)) + match) + (progn (setq in-emacs (or in-emacs line search)) + nil))) ; if we have no match in apps-dlink, + ; always open the file in emacs if line or search + ; is given (for backwards compatibility) (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) 'string-match) (cdr (assoc ext apps)) @@ -8824,6 +9765,19 @@ If the file does not exist, an error is thrown." (shell-quote-argument (convert-standard-filename file))) t t cmd))) + + ;; Replace "%1", "%2" etc. in command with group matches from regex + (save-match-data + (let ((match-index 1) + (number-of-groups (- (/ (length link-match-data) 2) 1))) + (set-match-data link-match-data) + (while (<= match-index number-of-groups) + (let ((regex (concat "%" (number-to-string match-index))) + (replace-with (match-string match-index dlink))) + (while (string-match regex cmd) + (setq cmd (replace-match replace-with t t cmd)))) + (setq match-index (+ match-index 1))))) + (save-window-excursion (start-process-shell-command cmd nil cmd) (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) @@ -8836,13 +9790,34 @@ If the file does not exist, an error is thrown." (if search (org-link-search search)))) ((consp cmd) (let ((file (convert-standard-filename file))) - (eval cmd))) + (save-match-data + (set-match-data link-match-data) + (eval cmd)))) (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) (and (org-mode-p) (eq old-mode 'org-mode) (or (not (equal old-buffer (current-buffer))) (not (equal old-pos (point)))) (org-mark-ring-push old-pos old-buffer)))) +(defun org-file-apps-entry-match-against-dlink-p (entry) + "This function returns non-nil if `entry' uses a regular +expression which should be matched against the whole link by +org-open-file. + +It assumes that is the case when the entry uses a regular +expression which has at least one grouping construct and the +action is either a lisp form or a command string containing +'%1', i.e. using at least one subexpression match as a +parameter." + (let ((selector (car entry)) + (action (cdr entry))) + (if (stringp selector) + (and (> (regexp-opt-depth selector) 0) + (or (and (stringp action) + (string-match "%[0-9]" action)) + (consp action))) + nil))) + (defun org-default-apps () "Return the default applications for this operating system." (cond @@ -8917,12 +9892,64 @@ on the system \"/user@host:\"." (defvar org-agenda-new-buffers nil "Buffers created to visit agenda files.") +(defvar org-refile-cache nil + "Cache for refile targets.") + + +(defvar org-refile-markers nil + "All the markers used for caching refile locations.") + +(defun org-refile-marker (pos) + "Get a new refile marker, but only if caching is in use." + (if (not org-refile-use-cache) + pos + (let ((m (make-marker))) + (move-marker m pos) + (push m org-refile-markers) + m))) + +(defun org-refile-cache-clear () + "Clear the refile cache and disable all the markers." + (mapc (lambda (m) (move-marker m nil)) org-refile-markers) + (setq org-refile-markers nil) + (setq org-refile-cache nil) + (message "Refile cache has been cleared")) + +(defun org-refile-cache-check-set (set) + "Check if all the markers in the cache still have live buffers." + (let (marker) + (catch 'exit + (while (and set (setq marker (nth 3 (pop set)))) + ;; if org-refile-use-outline-path is 'file, marker may be nil + (when (and marker (null (marker-buffer marker))) + (message "not found") (sit-for 3) + (throw 'exit nil))) + t))) + +(defun org-refile-cache-put (set &rest identifiers) + "Push the refile targets SET into the cache, under IDENTIFIERS." + (let* ((key (sha1 (prin1-to-string identifiers))) + (entry (assoc key org-refile-cache))) + (if entry + (setcdr entry set) + (push (cons key set) org-refile-cache)))) + +(defun org-refile-cache-get (&rest identifiers) + "Retrieve the cached value for refile targets given by IDENTIFIERS." + (cond + ((not org-refile-cache) nil) + ((not org-refile-use-cache) (org-refile-cache-clear) nil) + (t + (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers)) + org-refile-cache)))) + (and set (org-refile-cache-check-set set) set))))) + (defun org-get-refile-targets (&optional default-buffer) "Produce a table with refile targets." (let ((case-fold-search nil) ;; otherwise org confuses "TODO" as a kw and "Todo" as a word (entries (or org-refile-targets '((nil . (:level . 1))))) - targets txt re files f desc descre fast-path-p level pos0) + targets tgs txt re files f desc descre fast-path-p level pos0) (message "Getting targets...") (with-current-buffer (or default-buffer (current-buffer)) (while (setq entry (pop entries)) @@ -8961,46 +9988,58 @@ on the system \"/user@host:\"." (while (setq f (pop files)) (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)) - (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f)))) - (setq f (expand-file-name f)) - (if (eq org-refile-use-outline-path 'file) - (push (list (file-name-nondirectory f) f nil nil) targets)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward descre nil t) - (goto-char (setq pos0 (point-at-bol))) - (catch 'next - (when org-refile-target-verify-function - (save-match-data - (or (funcall org-refile-target-verify-function) - (throw 'next t)))) - (when (looking-at org-complex-heading-regexp) - (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) - txt (org-link-display-format (match-string 4)) - re (concat "^" (regexp-quote - (buffer-substring (match-beginning 1) - (match-end 4))))) - (if (match-end 5) (setq re (concat re "[ \t]+" - (regexp-quote - (match-string 5))))) - (setq re (concat re "[ \t]*$")) - (when org-refile-use-outline-path - (setq txt (mapconcat 'org-protect-slash - (append - (if (eq org-refile-use-outline-path 'file) - (list (file-name-nondirectory - (buffer-file-name (buffer-base-buffer)))) - (if (eq org-refile-use-outline-path 'full-file-path) - (list (buffer-file-name (buffer-base-buffer))))) - (org-get-outline-path fast-path-p level txt) - (list txt)) - "/"))) - (push (list txt f re (point)) targets))) - (when (= (point) pos0) - ;; verification function has not moved point - (goto-char (point-at-eol)))))))))) + (or + (setq tgs (org-refile-cache-get (buffer-file-name) descre)) + (progn + (if (bufferp f) (setq f (buffer-file-name + (buffer-base-buffer f)))) + (setq f (and f (expand-file-name f))) + (if (eq org-refile-use-outline-path 'file) + (push (list (file-name-nondirectory f) f nil nil) tgs)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward descre nil t) + (goto-char (setq pos0 (point-at-bol))) + (catch 'next + (when org-refile-target-verify-function + (save-match-data + (or (funcall org-refile-target-verify-function) + (throw 'next t)))) + (when (looking-at org-complex-heading-regexp) + (setq level (org-reduced-level + (- (match-end 1) (match-beginning 1))) + txt (org-link-display-format (match-string 4)) + txt (replace-regexp-in-string "\\( *\[[0-9]+/?[0-9]*%?\]\\)+$" "" txt) + re (format org-complex-heading-regexp-format + (regexp-quote (match-string 4)))) + (when org-refile-use-outline-path + (setq txt (mapconcat + 'org-protect-slash + (append + (if (eq org-refile-use-outline-path + 'file) + (list (file-name-nondirectory + (buffer-file-name + (buffer-base-buffer)))) + (if (eq org-refile-use-outline-path + 'full-file-path) + (list (buffer-file-name + (buffer-base-buffer))))) + (org-get-outline-path fast-path-p + level txt) + (list txt)) + "/"))) + (push (list txt f re (org-refile-marker (point))) + tgs))) + (when (= (point) pos0) + ;; verification function has not moved point + (goto-char (point-at-eol)))))))) + (when org-refile-use-cache + (org-refile-cache-put tgs (buffer-file-name) descre)) + (setq targets (append tgs targets)) + )))) (message "Getting targets...done") (nreverse targets))) @@ -9013,9 +10052,10 @@ on the system \"/user@host:\"." (defun org-get-outline-path (&optional fastp level heading) "Return the outline path to the current entry, as a list. -The parameters FASTP, LEVEL, and HEADING are for use be a scanner + +The parameters FASTP, LEVEL, and HEADING are for use by a scanner routine which makes outline path derivations for an entire file, -avoiding backtracing." +avoiding backtracing. Refile target collection makes use of that." (if fastp (progn (if (> level 19) @@ -9025,7 +10065,7 @@ avoiding backtracing." (prog1 (delq nil (append org-olpa nil)) (aset org-olpa level heading))) - (let (rtn) + (let (rtn case-fold-search) (save-excursion (save-restriction (widen) @@ -9035,7 +10075,7 @@ avoiding backtracing." rtn))))) (defun org-format-outline-path (path &optional width prefix) - "Format the outlie path PATH for display. + "Format the outline path PATH for display. Width is the maximum number of characters that is available. Prefix is a prefix to be included in the returned string, such as the file name." @@ -9075,8 +10115,9 @@ such as the file name." (defun org-display-outline-path (&optional file current) "Display the current outline path in the echo area." (interactive "P") - (let ((bfn (buffer-file-name (buffer-base-buffer))) - (path (and (org-mode-p) (org-get-outline-path)))) + (let* ((bfn (buffer-file-name (buffer-base-buffer))) + (case-fold-search nil) + (path (and (org-mode-p) (org-get-outline-path)))) (if current (setq path (append path (save-excursion (org-back-to-heading t) @@ -9096,6 +10137,7 @@ such as the file name." Note that this is still *before* the stuff will be removed from the *old* location.") +(defvar org-capture-last-stored-marker) (defun org-refile (&optional goto default-buffer rfloc) "Move the entry at point to another heading. The list of target headings is compiled using the information in @@ -9107,113 +10149,130 @@ Depending on `org-reverse-note-order', the new subitem will either be the first or the last subitem. If there is an active region, all entries in that region will be moved. -However, the region must fulfil the requirement that the first heading +However, the region must fulfill the requirement that the first heading is the first one sets the top-level of the moved text - at most siblings below it are allowed. With prefix arg GOTO, the command will only visit the target location, not actually move anything. -With a double prefix `C-u C-u', go to the location where the last refiling +With a double prefix arg \\[universal-argument] \\[universal-argument], \ +go to the location where the last refiling operation has put the subtree. With a prefix argument of `2', refile to the running clock. RFLOC can be a refile location obtained in a different way. -See also `org-refile-use-outline-path' and `org-completion-use-ido'" +See also `org-refile-use-outline-path' and `org-completion-use-ido'. + +If you are using target caching (see `org-refile-use-cache'), +You have to clear the target cache in order to find new targets. +This can be done with a 0 prefix: `C-0 C-c C-w'" (interactive "P") - (let* ((cbuf (current-buffer)) - (regionp (org-region-active-p)) - (region-start (and regionp (region-beginning))) - (region-end (and regionp (region-end))) - (region-length (and regionp (- region-end region-start))) - (filename (buffer-file-name (buffer-base-buffer cbuf))) - pos it nbuf file re level reversed) - (setq last-command nil) - (when regionp - (goto-char region-start) - (or (bolp) (goto-char (point-at-bol))) - (setq region-start (point)) - (unless (org-kill-is-subtree-p - (buffer-substring region-start region-end)) - (error "The region is not a (sequence of) subtree(s)"))) - (if (equal goto '(16)) - (org-refile-goto-last-stored) - (when (or - (and (equal goto 2) - org-clock-hd-marker (marker-buffer org-clock-hd-marker) - (prog1 - (setq it (list (or org-clock-heading "running clock") - (buffer-file-name - (marker-buffer org-clock-hd-marker)) - "" - (marker-position org-clock-hd-marker))) - (setq goto nil))) - (setq it (or rfloc - (save-excursion - (org-refile-get-location - (if goto "Goto: " "Refile to: ") default-buffer - org-refile-allow-creating-parent-nodes))))) - (setq file (nth 1 it) - re (nth 2 it) - pos (nth 3 it)) - (if (and (not goto) - pos - (equal (buffer-file-name) file) - (if regionp - (and (>= pos region-start) - (<= pos region-end)) - (and (>= pos (point)) - (< pos (save-excursion - (org-end-of-subtree t t)))))) - (error "Cannot refile to position inside the tree or region")) - - (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) - (if goto - (progn - (switch-to-buffer nbuf) - (goto-char pos) - (org-show-context 'org-goto)) - (if regionp + (if (member goto '(0 (64))) + (org-refile-cache-clear) + (let* ((cbuf (current-buffer)) + (regionp (org-region-active-p)) + (region-start (and regionp (region-beginning))) + (region-end (and regionp (region-end))) + (region-length (and regionp (- region-end region-start))) + (filename (buffer-file-name (buffer-base-buffer cbuf))) + pos it nbuf file re level reversed) + (setq last-command nil) + (when regionp + (goto-char region-start) + (or (bolp) (goto-char (point-at-bol))) + (setq region-start (point)) + (unless (org-kill-is-subtree-p + (buffer-substring region-start region-end)) + (error "The region is not a (sequence of) subtree(s)"))) + (if (equal goto '(16)) + (org-refile-goto-last-stored) + (when (or + (and (equal goto 2) + org-clock-hd-marker (marker-buffer org-clock-hd-marker) + (prog1 + (setq it (list (or org-clock-heading "running clock") + (buffer-file-name + (marker-buffer org-clock-hd-marker)) + "" + (marker-position org-clock-hd-marker))) + (setq goto nil))) + (setq it (or rfloc + (save-excursion + (org-refile-get-location + (if goto "Goto: " "Refile to: ") default-buffer + org-refile-allow-creating-parent-nodes))))) + (setq file (nth 1 it) + re (nth 2 it) + pos (nth 3 it)) + (if (and (not goto) + pos + (equal (buffer-file-name) file) + (if regionp + (and (>= pos region-start) + (<= pos region-end)) + (and (>= pos (point)) + (< pos (save-excursion + (org-end-of-subtree t t)))))) + (error "Cannot refile to position inside the tree or region")) + + (setq nbuf (or (find-buffer-visiting file) + (find-file-noselect file))) + (if goto (progn - (org-kill-new (buffer-substring region-start region-end)) - (org-save-markers-in-region region-start region-end)) - (org-copy-subtree 1 nil t)) - (with-current-buffer (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) - (setq reversed (org-notes-order-reversed-p)) - (save-excursion - (save-restriction - (widen) - (if pos - (progn - (goto-char pos) - (looking-at outline-regexp) - (setq level (org-get-valid-level (funcall outline-level) 1)) - (goto-char - (if reversed - (or (outline-next-heading) (point-max)) - (or (save-excursion (org-get-next-sibling)) - (org-end-of-subtree t t) - (point-max))))) - (setq level 1) - (if (not reversed) - (goto-char (point-max)) - (goto-char (point-min)) - (or (outline-next-heading) (goto-char (point-max))))) - (if (not (bolp)) (newline)) - (bookmark-set "org-refile-last-stored") - (org-paste-subtree level) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (run-hooks 'org-after-refile-insert-hook)))) - (if regionp - (delete-region (point) (+ (point) region-length)) - (org-cut-subtree)) - (when (featurep 'org-inlinetask) - (org-inlinetask-remove-END-maybe)) - (setq org-markers-to-move nil) - (message "Refiled to \"%s\"" (car it)))))) - (org-reveal)) + (switch-to-buffer nbuf) + (goto-char pos) + (org-show-context 'org-goto)) + (if regionp + (progn + (org-kill-new (buffer-substring region-start region-end)) + (org-save-markers-in-region region-start region-end)) + (org-copy-subtree 1 nil t)) + (with-current-buffer (setq nbuf (or (find-buffer-visiting file) + (find-file-noselect file))) + (setq reversed (org-notes-order-reversed-p)) + (save-excursion + (save-restriction + (widen) + (if pos + (progn + (goto-char pos) + (looking-at outline-regexp) + (setq level (org-get-valid-level (funcall outline-level) 1)) + (goto-char + (if reversed + (or (outline-next-heading) (point-max)) + (or (save-excursion (org-get-next-sibling)) + (org-end-of-subtree t t) + (point-max))))) + (setq level 1) + (if (not reversed) + (goto-char (point-max)) + (goto-char (point-min)) + (or (outline-next-heading) (goto-char (point-max))))) + (if (not (bolp)) (newline)) + (org-paste-subtree level) + (when org-log-refile + (org-add-log-setup 'refile nil nil 'findpos + org-log-refile) + (unless (eq org-log-refile 'note) + (save-excursion (org-add-log-note)))) + (and org-auto-align-tags (org-set-tags nil t)) + (bookmark-set "org-refile-last-stored") + ;; If we are refiling for capture, make sure that the + ;; last-capture pointers point here + (when (org-bound-and-true-p org-refile-for-capture) + (bookmark-set "org-capture-last-stored-marker") + (move-marker org-capture-last-stored-marker (point))) + (if (fboundp 'deactivate-mark) (deactivate-mark)) + (run-hooks 'org-after-refile-insert-hook)))) + (if regionp + (delete-region (point) (+ (point) region-length)) + (org-cut-subtree)) + (when (featurep 'org-inlinetask) + (org-inlinetask-remove-END-maybe)) + (setq org-markers-to-move nil) + (message "Refiled to \"%s\" in file %s" (car it) file))))))) (defun org-refile-goto-last-stored () "Go to the location where the last refile was stored." @@ -9253,6 +10312,7 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'" (setq answ (funcall cfunc prompt tbl nil (not new-nodes) nil 'org-refile-history)) (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl))) + (org-refile-check-position pa) (if pa (progn (when (or (not org-refile-history) @@ -9265,15 +10325,39 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'" (if (equal (car org-refile-history) (nth 1 org-refile-history)) (pop org-refile-history))) pa) - (when (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) - (setq parent (match-string 1 answ) - child (match-string 2 answ)) - (setq parent-target (or (assoc parent tbl) (assoc (concat parent "/") tbl))) - (when (and parent-target - (or (eq new-nodes t) - (and (eq new-nodes 'confirm) - (y-or-n-p (format "Create new node \"%s\"? " child))))) - (org-refile-new-child parent-target child)))))) + (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) + (progn + (setq parent (match-string 1 answ) + child (match-string 2 answ)) + (setq parent-target (or (assoc parent tbl) + (assoc (concat parent "/") tbl))) + (when (and parent-target + (or (eq new-nodes t) + (and (eq new-nodes 'confirm) + (y-or-n-p (format "Create new node \"%s\"? " + child))))) + (org-refile-new-child parent-target child))) + (error "Invalid target location"))))) + +(defun org-refile-check-position (refile-pointer) + "Check if the refile pointer matches the readline to which it points." + (let* ((file (nth 1 refile-pointer)) + (re (nth 2 refile-pointer)) + (pos (nth 3 refile-pointer)) + buffer) + (when (org-string-nw-p re) + (setq buffer (if (markerp pos) + (marker-buffer pos) + (or (find-buffer-visiting file) + (find-file-noselect file)))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (beginning-of-line 1) + (unless (org-looking-at-p re) + (error "Invalid refile position, please rebuild the cache")))))))) (defun org-refile-new-child (parent-target child) "Use refile target PARENT-TARGET to add new CHILD below it." @@ -9398,16 +10482,15 @@ the property list including an extra property :name with the block name." (defun org-map-dblocks (&optional command) "Apply COMMAND to all dynamic blocks in the current buffer. If COMMAND is not given, use `org-update-dblock'." - (let ((cmd (or command 'org-update-dblock)) - pos) + (let ((cmd (or command 'org-update-dblock))) (save-excursion (goto-char (point-min)) (while (re-search-forward org-dblock-start-re nil t) - (goto-char (setq pos (match-beginning 0))) - (condition-case nil - (funcall cmd) - (error (message "Error during update of dynamic block"))) - (goto-char pos) + (goto-char (match-beginning 0)) + (save-excursion + (condition-case nil + (funcall cmd) + (error (message "Error during update of dynamic block")))) (unless (re-search-forward org-dblock-end-re nil t) (error "Dynamic block not terminated")))))) @@ -9423,9 +10506,10 @@ blocks in the buffer." (org-update-dblock))) (defun org-update-dblock () - "Update the dynamic block at point + "Update the dynamic block at point. This means to empty the block, parse for parameters and then call the correct writing function." + (interactive) (save-window-excursion (let* ((pos (point)) (line (org-current-line)) @@ -9467,6 +10551,7 @@ Error if there is no such block at point." (defun org-update-all-dblocks () "Update all dynamic blocks in the buffer. This function can be used in a hook." + (interactive) (when (org-mode-p) (org-map-dblocks 'org-update-dblock))) @@ -9474,9 +10559,10 @@ This function can be used in a hook." ;;;; Completion (defconst org-additional-option-like-keywords - '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML" - "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook" - "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:" "LATEX_CLASS:" "ATTR_LaTeX" + '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML:" + "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook:" + "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:" + "LATEX_CLASS:" "LATEX_CLASS_OPTIONS:" "ATTR_LaTeX:" "BEGIN:" "END:" "ORGTBL" "TBLFM:" "TBLNAME:" "BEGIN_EXAMPLE" "END_EXAMPLE" @@ -9484,11 +10570,17 @@ This function can be used in a hook." "BEGIN_VERSE" "END_VERSE" "BEGIN_CENTER" "END_CENTER" "BEGIN_SRC" "END_SRC" - "CATEGORY" "COLUMNS" - "CAPTION" "LABEL" - "SETUPFILE" - "BIND" - "MACRO")) + "BEGIN_RESULT" "END_RESULT" + "SOURCE:" "SRCNAME:" "FUNCTION:" + "RESULTS:" + "HEADER:" "HEADERS:" + "BABEL:" + "CATEGORY:" "COLUMNS:" "PROPERTY:" + "CAPTION:" "LABEL:" + "SETUPFILE:" + "INCLUDE:" + "BIND:" + "MACRO:")) (defcustom org-structure-template-alist '( @@ -9517,12 +10609,12 @@ This function can be used in a hook." ) "Structure completion elements. This is a list of abbreviation keys and values. The value gets inserted -it you type @samp{.} followed by the key and then the completion key, +if you type `<' followed by the key and then press the completion key, usually `M-TAB'. %file will be replaced by a file name after prompting for the file using completion. There are two templates for each key, the first uses the original Org syntax, the second uses Emacs Muse-like syntax tags. These Muse-like tags become -the default when the /org-mtags.el/ module has been loaded. See also the +the default when the /org-mtags.el/ module has been loaded. See also the variable `org-mtags-prefer-muse-templates'. This is an experimental feature, it is undecided if it is going to stay in." :group 'org-completion @@ -9570,132 +10662,6 @@ expands them." (insert rpl) (if (re-search-backward "\\?" start t) (delete-char 1)))) - -(defun org-complete (&optional arg) - "Perform completion on word at point. -At the beginning of a headline, this completes TODO keywords as given in -`org-todo-keywords'. -If the current word is preceded by a backslash, completes the TeX symbols -that are supported for HTML support. -If the current word is preceded by \"#+\", completes special words for -setting file options. -In the line after \"#+STARTUP:, complete valid keywords.\" -At all other locations, this simply calls the value of -`org-completion-fallback-command'." - (interactive "P") - (org-without-partial-completion - (catch 'exit - (let* ((a nil) - (end (point)) - (beg1 (save-excursion - (skip-chars-backward (org-re "[:alnum:]_@")) - (point))) - (beg (save-excursion - (skip-chars-backward "a-zA-Z0-9_:$") - (point))) - (confirm (lambda (x) (stringp (car x)))) - (searchhead (equal (char-before beg) ?*)) - (struct - (when (and (member (char-before beg1) '(?. ?<)) - (setq a (assoc (buffer-substring beg1 (point)) - org-structure-template-alist))) - (org-complete-expand-structure-template (1- beg1) a) - (throw 'exit t))) - (tag (and (equal (char-before beg1) ?:) - (equal (char-after (point-at-bol)) ?*))) - (prop (and (equal (char-before beg1) ?:) - (not (equal (char-after (point-at-bol)) ?*)))) - (texp (equal (char-before beg) ?\\)) - (link (equal (char-before beg) ?\[)) - (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) - beg) - "#+")) - (startup (string-match "^#\\+STARTUP:.*" - (buffer-substring (point-at-bol) (point)))) - (completion-ignore-case opt) - (type nil) - (tbl nil) - (table (cond - (opt - (setq type :opt) - (require 'org-exp) - (append - (delq nil - (mapcar - (lambda (x) - (if (string-match - "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) - (cons (match-string 2 x) - (match-string 1 x)))) - (org-split-string (org-get-current-options) "\n"))) - (mapcar 'list org-additional-option-like-keywords))) - (startup - (setq type :startup) - org-startup-options) - (link (append org-link-abbrev-alist-local - org-link-abbrev-alist)) - (texp - (setq type :tex) - org-html-entities) - ((string-match "\\`\\*+[ \t]+\\'" - (buffer-substring (point-at-bol) beg)) - (setq type :todo) - (mapcar 'list org-todo-keywords-1)) - (searchhead - (setq type :searchhead) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward org-todo-line-regexp nil t) - (push (list - (org-make-org-heading-search-string - (match-string 3) t)) - tbl))) - tbl) - (tag (setq type :tag beg beg1) - (or org-tag-alist (org-get-buffer-tags))) - (prop (setq type :prop beg beg1) - (mapcar 'list (org-buffer-property-keys nil t t))) - (t (progn - (call-interactively org-completion-fallback-command) - (throw 'exit nil))))) - (pattern (buffer-substring-no-properties beg end)) - (completion (try-completion pattern table confirm))) - (cond ((eq completion t) - (if (not (assoc (upcase pattern) table)) - (message "Already complete") - (if (and (equal type :opt) - (not (member (car (assoc (upcase pattern) table)) - org-additional-option-like-keywords))) - (insert (substring (cdr (assoc (upcase pattern) table)) - (length pattern))) - (if (memq type '(:tag :prop)) (insert ":"))))) - ((null completion) - (message "Can't find completion for \"%s\"" pattern) - (ding)) - ((not (string= pattern completion)) - (delete-region beg end) - (if (string-match " +$" completion) - (setq completion (replace-match "" t t completion))) - (insert completion) - (if (get-buffer-window "*Completions*") - (delete-window (get-buffer-window "*Completions*"))) - (if (assoc completion table) - (if (eq type :todo) (insert " ") - (if (memq type '(:tag :prop)) (insert ":")))) - (if (and (equal type :opt) (assoc completion table)) - (message "%s" (substitute-command-keys - "Press \\[org-complete] again to insert example settings")))) - (t - (message "Making completion list...") - (let ((list (sort (all-completions pattern table confirm) - 'string<))) - (with-output-to-temp-buffer "*Completions*" - (condition-case nil - ;; Protection needed for XEmacs and emacs 21 - (display-completion-list list pattern) - (error (display-completion-list list))))) - (message "Making completion list...%s" "done"))))))) - ;;;; TODO, DEADLINE, Comments (defun org-toggle-comment () @@ -9719,38 +10685,15 @@ this is nil.") (defvar org-setting-tags nil) ; dynamically skipped -(defun org-parse-local-options (string var) - "Parse STRING for startup setting relevant for variable VAR." - (let ((rtn (symbol-value var)) - e opts) - (save-match-data - (if (or (not string) (not (string-match "\\S-" string))) - rtn - (setq opts (delq nil (mapcar (lambda (x) - (setq e (assoc x org-startup-options)) - (if (eq (nth 1 e) var) e nil)) - (org-split-string string "[ \t]+")))) - (if (not opts) - rtn - (setq rtn nil) - (while (setq e (pop opts)) - (if (not (nth 3 e)) - (setq rtn (nth 2 e)) - (if (not (listp rtn)) (setq rtn nil)) - (push (nth 2 e) rtn))) - rtn))))) - (defvar org-todo-setup-filter-hook nil "Hook for functions that pre-filter todo specs. - -Each function takes a todo spec and returns either `nil' or the spec +Each function takes a todo spec and returns either nil or the spec transformed into canonical form." ) (defvar org-todo-get-default-hook nil "Hook for functions that get a default item for todo. - Each function takes arguments (NEW-MARK OLD-MARK) and returns either -`nil' or a string to be used for the todo mark." ) +nil or a string to be used for the todo mark." ) (defvar org-agenda-headline-snapshot-before-repeat) @@ -9767,10 +10710,12 @@ So for this example: when the item starts with TODO, it is changed to DONE. When it starts with DONE, the DONE is removed. And when neither TODO nor DONE are present, add TODO at the beginning of the heading. -With C-u prefix arg, use completion to determine the new state. +With \\[universal-argument] prefix arg, use completion to determine the new \ +state. With numeric prefix arg, switch to that state. -With a double C-u prefix, switch to the next set of TODO keywords (nextset). -With a triple C-u prefix, circumvent any state blocking. +With a double \\[universal-argument] prefix, switch to the next set of TODO \ +keywords (nextset). +With a triple \\[universal-argument] prefix, circumvent any state blocking. For calling through lisp, arg is also interpreted in the following way: 'none -> empty state @@ -9798,7 +10743,7 @@ For calling through lisp, arg is also interpreted in the following way: (looking-at " *")) (let* ((match-data (match-data)) (startpos (point-at-bol)) - (logging (save-match-data (org-entry-get nil "LOGGING" t))) + (logging (save-match-data (org-entry-get nil "LOGGING" t t))) (org-log-done org-log-done) (org-log-repeat org-log-repeat) (org-todo-log-states org-todo-log-states) @@ -9980,54 +10925,56 @@ changes. Such blocking occurs when: 3. The parent of the task is blocked because it has siblings that should be done first, or is child of a block grandparent TODO entry." - (catch 'dont-block - ;; If this is not a todo state change, or if this entry is already DONE, - ;; do not block - (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) - (member (plist-get change-plist :from) - (cons 'done org-done-keywords)) - (member (plist-get change-plist :to) - (cons 'todo org-not-done-keywords)) - (not (plist-get change-plist :to))) - (throw 'dont-block t)) - ;; If this task has children, and any are undone, it's blocked - (save-excursion - (org-back-to-heading t) - (let ((this-level (funcall outline-level))) - (outline-next-heading) - (let ((child-level (funcall outline-level))) - (while (and (not (eobp)) - (> child-level this-level)) - ;; this todo has children, check whether they are all - ;; completed - (if (and (not (org-entry-is-done-p)) - (org-entry-is-todo-p)) - (throw 'dont-block nil)) - (outline-next-heading) - (setq child-level (funcall outline-level)))))) - ;; Otherwise, if the task's parent has the :ORDERED: property, and - ;; any previous siblings are undone, it's blocked - (save-excursion - (org-back-to-heading t) - (let* ((pos (point)) - (parent-pos (and (org-up-heading-safe) (point)))) - (if (not parent-pos) (throw 'dont-block t)) ; no parent - (when (and (org-entry-get (point) "ORDERED") - (forward-line 1) - (re-search-forward org-not-done-heading-regexp pos t)) - (throw 'dont-block nil)) ; block, there is an older sibling not done. - ;; Search further up the hierarchy, to see if an anchestor is blocked - (while t - (goto-char parent-pos) - (if (not (looking-at org-not-done-heading-regexp)) - (throw 'dont-block t)) ; do not block, parent is not a TODO - (setq pos (point)) - (setq parent-pos (and (org-up-heading-safe) (point))) + (if (not org-enforce-todo-dependencies) + t ; if locally turned off don't block + (catch 'dont-block + ;; If this is not a todo state change, or if this entry is already DONE, + ;; do not block + (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) + (member (plist-get change-plist :from) + (cons 'done org-done-keywords)) + (member (plist-get change-plist :to) + (cons 'todo org-not-done-keywords)) + (not (plist-get change-plist :to))) + (throw 'dont-block t)) + ;; If this task has children, and any are undone, it's blocked + (save-excursion + (org-back-to-heading t) + (let ((this-level (funcall outline-level))) + (outline-next-heading) + (let ((child-level (funcall outline-level))) + (while (and (not (eobp)) + (> child-level this-level)) + ;; this todo has children, check whether they are all + ;; completed + (if (and (not (org-entry-is-done-p)) + (org-entry-is-todo-p)) + (throw 'dont-block nil)) + (outline-next-heading) + (setq child-level (funcall outline-level)))))) + ;; Otherwise, if the task's parent has the :ORDERED: property, and + ;; any previous siblings are undone, it's blocked + (save-excursion + (org-back-to-heading t) + (let* ((pos (point)) + (parent-pos (and (org-up-heading-safe) (point)))) (if (not parent-pos) (throw 'dont-block t)) ; no parent - (when (and (org-entry-get (point) "ORDERED") + (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t)) - (throw 'dont-block nil))))))) ; block, older sibling not done. + (throw 'dont-block nil)) ; block, there is an older sibling not done. + ;; Search further up the hierarchy, to see if an anchestor is blocked + (while t + (goto-char parent-pos) + (if (not (looking-at org-not-done-heading-regexp)) + (throw 'dont-block t)) ; do not block, parent is not a TODO + (setq pos (point)) + (setq parent-pos (and (org-up-heading-safe) (point))) + (if (not parent-pos) (throw 'dont-block t)) ; no parent + (when (and (org-not-nil (org-entry-get (point) "ORDERED")) + (forward-line 1) + (re-search-forward org-not-done-heading-regexp pos t)) + (throw 'dont-block nil)))))))) ; block, older sibling not done. (defcustom org-track-ordered-property-with-tag nil "Should the ORDERED property also be shown as a tag? @@ -10071,30 +11018,44 @@ See variable `org-track-ordered-property-with-tag'." "Block turning an entry into a TODO, using checkboxes. This checks whether the current task should be blocked from state changes because there are unchecked boxes in this entry." - (catch 'dont-block - ;; If this is not a todo state change, or if this entry is already DONE, - ;; do not block - (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) - (member (plist-get change-plist :from) - (cons 'done org-done-keywords)) - (member (plist-get change-plist :to) - (cons 'todo org-not-done-keywords)) - (not (plist-get change-plist :to))) - (throw 'dont-block t)) - ;; If this task has checkboxes that are not checked, it's blocked - (save-excursion - (org-back-to-heading t) - (let ((beg (point)) end) - (outline-next-heading) - (setq end (point)) - (goto-char beg) - (if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]" - end t) - (progn - (if (boundp 'org-blocked-by-checkboxes) - (setq org-blocked-by-checkboxes t)) - (throw 'dont-block nil))))) - t)) ; do not block + (if (not org-enforce-todo-checkbox-dependencies) + t ; if locally turned off don't block + (catch 'dont-block + ;; If this is not a todo state change, or if this entry is already DONE, + ;; do not block + (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) + (member (plist-get change-plist :from) + (cons 'done org-done-keywords)) + (member (plist-get change-plist :to) + (cons 'todo org-not-done-keywords)) + (not (plist-get change-plist :to))) + (throw 'dont-block t)) + ;; If this task has checkboxes that are not checked, it's blocked + (save-excursion + (org-back-to-heading t) + (let ((beg (point)) end) + (outline-next-heading) + (setq end (point)) + (goto-char beg) + (if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]" + end t) + (progn + (if (boundp 'org-blocked-by-checkboxes) + (setq org-blocked-by-checkboxes t)) + (throw 'dont-block nil))))) + t))) ; do not block + +(defun org-entry-blocked-p () + "Is the current entry blocked?" + (if (org-entry-get nil "NOBLOCKING") + nil ;; Never block this entry + (not + (run-hook-with-args-until-failure + 'org-blocker-hook + (list :type 'todo-state-change + :position (point) + :from 'todo + :to 'done))))) (defun org-update-statistics-cookies (all) "Update the statistics cookie, either from TODO or from checkboxes. @@ -10116,8 +11077,9 @@ This should be called with the cursor in a line with a statistics cookie." (outline-next-heading) (if (org-on-heading-p) (setq l2 (org-outline-level))) (point))) - (if (and (save-excursion (re-search-forward - "^[ \t]*[-+*] \\[[- X]\\]" end t)) + (if (and (save-excursion + (re-search-forward + "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t)) (not (save-excursion (re-search-forward ":COOKIE_DATA:.*\\<todo\\>" end t)))) (org-update-checkbox-count) @@ -10125,7 +11087,12 @@ This should be called with the cursor in a line with a statistics cookie." (progn (goto-char end) (org-update-parent-todo-statistics)) - (error "No data for statistics cookie")))) + (goto-char pos) + (beginning-of-line 1) + (while (re-search-forward + "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)" + (point-at-eol) t) + (replace-match (if (match-end 2) "[100%]" "[0/0]") t t))))) (goto-char pos) (move-marker pos nil))))) @@ -10397,13 +11364,17 @@ This function is run automatically after each state change to a DONE state." (msg "Entry repeats: ") (org-log-done nil) (org-todo-log-states nil) - (nshiftmax 10) (nshift 0) - re type n what ts time) + re type n what ts time to-state) (when repeat (if (eq org-log-repeat t) (setq org-log-repeat 'state)) - (org-todo (if (eq interpret 'type) last-state head)) - (org-entry-put nil "LAST_REPEAT" (format-time-string - (org-time-stamp-format t t))) + (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE") + org-todo-repeat-to-state)) + (unless (and to-state (member to-state org-todo-keywords-1)) + (setq to-state (if (eq interpret 'type) last-state head))) + (org-todo to-state) + (when (or org-log-repeat (org-entry-get nil "CLOCK")) + (org-entry-put nil "LAST_REPEAT" (format-time-string + (org-time-stamp-format t t)))) (when org-log-repeat (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) (memq 'org-add-log-note post-command-hook)) @@ -10439,15 +11410,17 @@ This function is run automatically after each state change to a DONE state." (- (time-to-days (current-time)) (time-to-days time)) 'day)) ((equal (match-string 1 ts) "+") - (while (or (= nshift 0) - (<= (time-to-days time) (time-to-days (current-time)))) - (when (= (incf nshift) nshiftmax) - (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift)) - (error "Abort"))) - (org-timestamp-change n (cdr (assoc what whata))) - (org-at-timestamp-p t) - (setq ts (match-string 1)) - (setq time (save-match-data (org-time-string-to-time ts)))) + (let ((nshiftmax 10) (nshift 0)) + (while (or (= nshift 0) + (<= (time-to-days time) + (time-to-days (current-time)))) + (when (= (incf nshift) nshiftmax) + (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift)) + (error "Abort"))) + (org-timestamp-change n (cdr (assoc what whata))) + (org-at-timestamp-p t) + (setq ts (match-string 1)) + (setq time (save-match-data (org-time-string-to-time ts))))) (org-timestamp-change (- n) (cdr (assoc what whata))) ;; rematch, so that we have everything in place for the real shift (org-at-timestamp-p t) @@ -10488,20 +11461,37 @@ With argument REMOVE, remove any deadline from the item. When TIME is set, it should be an internal time specification, and the scheduling will use the corresponding date." (interactive "P") - (let ((old-date (org-entry-get nil "DEADLINE"))) + (let* ((old-date (org-entry-get nil "DEADLINE")) + (repeater (and old-date + (string-match "\\([.+]+[0-9]+[dwmy]\\) ?" old-date) + (match-string 1 old-date)))) (if remove (progn + (when (and old-date org-log-redeadline) + (org-add-log-setup 'deldeadline nil old-date 'findpos + org-log-redeadline)) (org-remove-timestamp-with-keyword org-deadline-string) (message "Item no longer has a deadline.")) - (if (org-get-repeat) - (error "Cannot change deadline on task with repeater, please do that by hand") - (org-add-planning-info 'deadline time 'closed) - (when (and old-date org-log-redeadline - (not (equal old-date - (substring org-last-inserted-timestamp 1 -1)))) - (org-add-log-setup 'redeadline nil old-date 'findpos - org-log-redeadline)) - (message "Deadline on %s" org-last-inserted-timestamp))))) + (org-add-planning-info 'deadline time 'closed) + (when (and old-date org-log-redeadline + (not (equal old-date + (substring org-last-inserted-timestamp 1 -1)))) + (org-add-log-setup 'redeadline nil old-date 'findpos + org-log-redeadline)) + (when repeater + (save-excursion + (org-back-to-heading t) + (when (re-search-forward (concat org-deadline-string " " + org-last-inserted-timestamp) + (save-excursion + (outline-next-heading) (point)) t) + (goto-char (1- (match-end 0))) + (insert " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message "Deadline on %s" org-last-inserted-timestamp)))) (defun org-schedule (&optional remove time) "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. @@ -10509,20 +11499,37 @@ With argument REMOVE, remove any scheduling date from the item. When TIME is set, it should be an internal time specification, and the scheduling will use the corresponding date." (interactive "P") - (let ((old-date (org-entry-get nil "SCHEDULED"))) + (let* ((old-date (org-entry-get nil "SCHEDULED")) + (repeater (and old-date + (string-match "\\([.+]+[0-9]+[dwmy]\\) ?" old-date) + (match-string 1 old-date)))) (if remove (progn + (when (and old-date org-log-reschedule) + (org-add-log-setup 'delschedule nil old-date 'findpos + org-log-reschedule)) (org-remove-timestamp-with-keyword org-scheduled-string) (message "Item is no longer scheduled.")) - (if (org-get-repeat) - (error "Cannot reschedule task with repeater, please do that by hand") - (org-add-planning-info 'scheduled time 'closed) - (when (and old-date org-log-reschedule - (not (equal old-date - (substring org-last-inserted-timestamp 1 -1)))) - (org-add-log-setup 'reschedule nil old-date 'findpos - org-log-reschedule)) - (message "Scheduled to %s" org-last-inserted-timestamp))))) + (org-add-planning-info 'scheduled time 'closed) + (when (and old-date org-log-reschedule + (not (equal old-date + (substring org-last-inserted-timestamp 1 -1)))) + (org-add-log-setup 'reschedule nil old-date 'findpos + org-log-reschedule)) + (when repeater + (save-excursion + (org-back-to-heading t) + (when (re-search-forward (concat org-scheduled-string " " + org-last-inserted-timestamp) + (save-excursion + (outline-next-heading) (point)) t) + (goto-char (1- (match-end 0))) + (insert " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message "Scheduled to %s" org-last-inserted-timestamp)))) (defun org-get-scheduled-time (pom &optional inherit) "Get the scheduled time as a time tuple, of a format suitable @@ -10533,7 +11540,7 @@ returns nil." (apply 'encode-time (org-parse-time-string time))))) (defun org-get-deadline-time (pom &optional inherit) - "Get the deadine as a time tuple, of a format suitable for + "Get the deadline as a time tuple, of a format suitable for calling org-deadline with, or if there is no scheduling, returns nil." (let ((time (org-entry-get pom "DEADLINE" inherit))) @@ -10651,7 +11658,7 @@ be removed." (end-of-line 1)) (goto-char (point-min)) (widen) - (if (and (looking-at "[ \t]+\n") + (if (and (looking-at "[ \t]*\n") (equal (char-before) ?\n)) (delete-region (1- (point)) (point-at-eol))) ts)))))) @@ -10676,7 +11683,7 @@ This is done in the same way as adding a state change note." (defvar org-property-end-re) (defun org-add-log-setup (&optional purpose state prev-state - findpos how &optional extra) + findpos how extra) "Set up the post command hook to take a note. If this is about to TODO state change, the new state is expected in STATE. When FINDPOS is non-nil, find the correct position for the note in @@ -10737,10 +11744,11 @@ EXTRA is additional text that will be inserted into the notes buffer." (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." (if (looking-at "\n[ \t]*- State") (forward-char 1)) - (while (looking-at "[ \t]*- State") - (condition-case nil - (org-next-item) - (error (org-end-of-item))))) + (when (org-in-item-p) + (let ((limit (org-list-bottom-point))) + (while (looking-at "[ \t]*- State") + (goto-char (or (org-get-next-item (point) limit) + (org-get-end-of-item limit))))))) (defun org-add-log-note (&optional purpose) "Pop up a window for taking a note, and add this note later at point." @@ -10766,8 +11774,14 @@ EXTRA is additional text that will be inserted into the notes buffer." (or org-log-note-state ""))) ((eq org-log-note-purpose 'reschedule) "rescheduling") + ((eq org-log-note-purpose 'delschedule) + "no longer scheduled") ((eq org-log-note-purpose 'redeadline) "changing deadline") + ((eq org-log-note-purpose 'deldeadline) + "removing deadline") + ((eq org-log-note-purpose 'refile) + "refiling") ((eq org-log-note-purpose 'note) "this entry") (t (error "This should not happen"))))) @@ -10779,7 +11793,7 @@ EXTRA is additional text that will be inserted into the notes buffer." "Finish taking a log note, and insert it to where it belongs." (let ((txt (buffer-string)) (note (cdr (assq org-log-note-purpose org-log-note-headings))) - lines ind) + lines ind bul) (kill-buffer (current-buffer)) (while (string-match "\\`#.*\n[ \t\n]*" txt) (setq txt (replace-match "" t t txt))) @@ -10795,6 +11809,9 @@ EXTRA is additional text that will be inserted into the notes buffer." (cons "%t" (format-time-string (org-time-stamp-format 'long 'inactive) (current-time))) + (cons "%T" (format-time-string + (org-time-stamp-format 'long nil) + (current-time))) (cons "%s" (if org-log-note-state (concat "\"" org-log-note-state "\"") "")) @@ -10816,13 +11833,26 @@ EXTRA is additional text that will be inserted into the notes buffer." (move-marker org-log-note-marker nil) (end-of-line 1) (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - (insert "- " (pop lines)) - (org-indent-line-function) - (beginning-of-line 1) - (looking-at "[ \t]*") - (setq ind (concat (match-string 0) " ")) - (end-of-line 1) - (while lines (insert "\n" ind (pop lines))) + (setq ind (save-excursion + (if (org-in-item-p) + (progn + (goto-char (org-list-top-point)) + (org-get-indentation)) + (skip-chars-backward " \r\t\n") + (cond + ((and (org-at-heading-p) + org-adapt-indentation) + (1+ (org-current-level))) + ((org-at-heading-p) 0) + (t (org-get-indentation)))))) + (setq bul (org-list-bullet-string "-")) + (org-indent-line-to ind) + (insert bul (pop lines)) + (let ((ind-body (+ (length bul) ind))) + (while lines + (insert "\n") + (org-indent-line-to ind-body) + (insert (pop lines)))) (message "Note stored") (org-back-to-heading t) (org-cycle-hide-drawers 'children))))) @@ -10849,17 +11879,18 @@ POS may also be a marker." This command can create sparse trees. You first need to select the type of match used to create the tree: -t Show entries with a specific TODO keyword. +t Show all TODO entries. +T Show entries with a specific TODO keyword. m Show entries selected by a tags/property match. p Enter a property name and its value (both with completion on existing names/values) and show entries with that property. -/ Show entries matching a regular expression (`r' can be used as well) +r Show entries matching a regular expression (`/' can be used as well) d Show deadlines due within `org-deadline-warning-days'. b Show deadlines and scheduled items before a date. a Show deadlines and scheduled items after a date." (interactive "P") (let (ans kwd value) - (message "Sparse tree: [/]regexp [t]odo-kwd [m]atch [p]roperty [d]eadlines [b]efore-date [a]fter-date") + (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date") (setq ans (read-char-exclusive)) (cond ((equal ans ?d) @@ -10869,6 +11900,8 @@ a Show deadlines and scheduled items after a date." ((equal ans ?a) (call-interactively 'org-check-after-date)) ((equal ans ?t) + (org-show-todo-tree nil)) + ((equal ans ?T) (org-show-todo-tree '(4))) ((member ans '(?T ?m)) (call-interactively 'org-match-sparse-tree)) @@ -10940,7 +11973,7 @@ that the match should indeed be shown." cnt)) (defun org-show-context (&optional key) - "Make sure point and context and visible. + "Make sure point and context are visible. How much context is shown depends upon the variables `org-show-hierarchy-above', `org-show-following-heading'. and `org-show-siblings'." @@ -10971,6 +12004,9 @@ How much context is shown depends upon the variables (org-flag-heading nil) (when siblings-p (org-show-siblings)))))))) +(defvar org-reveal-start-hook nil + "Hook run before revealing a location.") + (defun org-reveal (&optional siblings) "Show current entry, hierarchy above it, and the following headline. This can be used to show a consistent set of context around locations @@ -10979,17 +12015,26 @@ not t for the search context. With optional argument SIBLINGS, on each level of the hierarchy all siblings are shown. This repairs the tree structure to what it would -look like when opened with hierarchical calls to `org-cycle'." +look like when opened with hierarchical calls to `org-cycle'. +With double optional argument \\[universal-argument] \\[universal-argument], \ +go to the parent and show the +entire tree." (interactive "P") + (run-hooks 'org-reveal-start-hook) (let ((org-show-hierarchy-above t) (org-show-following-heading t) (org-show-siblings (if siblings t org-show-siblings))) - (org-show-context nil))) + (org-show-context nil)) + (when (equal siblings '(16)) + (save-excursion + (when (org-up-heading-safe) + (org-show-subtree) + (run-hook-with-args 'org-cycle-hook 'subtree))))) (defun org-highlight-new-match (beg end) "Highlight from BEG to END and mark the highlight is an occur headline." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face 'secondary-selection) + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face 'secondary-selection) (push ov org-occur-highlights))) (defun org-remove-occur-highlights (&optional beg end noremove) @@ -10998,7 +12043,7 @@ BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) (unless org-inhibit-highlight-removal - (mapc 'org-delete-overlay org-occur-highlights) + (mapc 'delete-overlay org-occur-highlights) (setq org-occur-highlights nil) (setq org-occur-parameters nil) (unless noremove @@ -11045,7 +12090,8 @@ ACTION can be `set', `up', `down', or a character." (setq new action) (message "Priority %c-%c, SPC to remove: " org-highest-priority org-lowest-priority) - (setq new (read-char-exclusive))) + (save-match-data + (setq new (read-char-exclusive)))) (if (and (= (upcase org-highest-priority) org-highest-priority) (= (upcase org-lowest-priority) org-lowest-priority)) (setq new (upcase new))) @@ -11089,11 +12135,13 @@ ACTION can be `set', `up', `down', or a character." (defun org-get-priority (s) "Find priority cookie and return priority." - (save-match-data - (if (not (string-match org-priority-regexp s)) - (* 1000 (- org-lowest-priority org-default-priority)) - (* 1000 (- org-lowest-priority - (string-to-char (match-string 2 s))))))) + (if (functionp org-get-priority-function) + (funcall org-get-priority-function) + (save-match-data + (if (not (string-match org-priority-regexp s)) + (* 1000 (- org-lowest-priority org-default-priority)) + (* 1000 (- org-lowest-priority + (string-to-char (match-string 2 s)))))))) ;;;; Tags @@ -11130,7 +12178,7 @@ only lines with a TODO keyword are included in the output." (let* ((re (concat "^" outline-regexp " *\\(\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re - "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$"))) + "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))) (props (list 'face 'default 'done-face 'org-agenda-done 'undone-face 'default @@ -11330,11 +12378,11 @@ also TODO lines." ;; Parse the string and create a lisp form (let ((match0 match) - (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@]+\\)")) + (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")) minus tag mm tagsmatch todomatch tagsmatcher todomatcher kwd matcher orterms term orlist re-p str-p level-p level-op time-p - prop-p pn pv po cat-p gv rest) + prop-p pn pv po gv rest) (if (string-match "/+" match) ;; match contains also a todo-matching request (progn @@ -11358,7 +12406,9 @@ also TODO lines." (setq rest (substring term (match-end 0)) minus (and (match-end 1) (equal (match-string 1 term) "-")) - tag (match-string 2 term) + tag (save-match-data (replace-regexp-in-string + "\\\\-" "-" + (match-string 2 term))) re-p (equal (string-to-char tag) ?{) level-p (match-end 4) prop-p (match-end 5) @@ -11372,7 +12422,6 @@ also TODO lines." (setq pn (match-string 5 term) po (match-string 6 term) pv (match-string 7 term) - cat-p (equal pn "CATEGORY") re-p (equal (string-to-char pv) ?{) str-p (equal (string-to-char pv) ?\") time-p (save-match-data @@ -11501,7 +12550,7 @@ epoch to the beginning of today (00:00)." (delq nil list)) (defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param -(defvar org-tags-overlay (org-make-overlay 1 1)) +(defvar org-tags-overlay (make-overlay 1 1)) (org-detach-overlay org-tags-overlay) (defun org-get-local-tags-at (&optional pos) @@ -11537,7 +12586,7 @@ ignore inherited ones." (while (not (equal lastpos (point))) (setq lastpos (point)) (when (looking-at - (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) + (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) (setq ltags (org-split-string (org-match-string-no-properties 1) ":")) (when parent @@ -11564,7 +12613,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (let (res current) (save-excursion (org-back-to-heading t) - (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") + (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$") (point-at-eol) t) (progn (setq current (match-string 1)) @@ -11594,7 +12643,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." ;; Assumes that this is a headline (let ((pos (point)) (col (current-column)) ncol tags-l p) (beginning-of-line 1) - (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) (< pos (match-beginning 2))) (progn (setq tags-l (- (match-end 2) (match-beginning 2))) @@ -11654,6 +12703,17 @@ If DATA is nil or the empty string, any tags will be removed." (if (looking-at ".*?\\([ \t]+\\)$") (delete-region (match-beginning 1) (match-end 1)))))) +(defun org-align-all-tags () + "Align the tags i all headings." + (interactive) + (save-excursion + (or (ignore-errors (org-back-to-heading t)) + (outline-next-heading)) + (if (org-on-heading-p) + (org-set-tags t) + (message "No headings")))) + +(defvar org-indent-indentation-per-level) (defun org-set-tags (&optional arg just-align) "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." @@ -11663,7 +12723,7 @@ With prefix ARG, realign all tags in headings in the current buffer." (col (current-column)) (org-setting-tags t) table current-tags inherited-tags ; computed below when needed - tags p0 c0 c1 rpl) + tags p0 c0 c1 rpl di tc level) (if arg (save-excursion (goto-char (point-min)) @@ -11677,7 +12737,11 @@ With prefix ARG, realign all tags in headings in the current buffer." ;; Get a new set of tags from the user (save-excursion (setq table (append org-tag-persistent-alist - (or org-tag-alist (org-get-buffer-tags))) + (or org-tag-alist (org-get-buffer-tags)) + (and + org-complete-tags-always-offer-all-agenda-tags + (org-global-tags-completion-table + (org-agenda-files)))) org-last-tags-completion-table table current-tags (org-split-string current ":") inherited-tags (nreverse @@ -11689,19 +12753,24 @@ With prefix ARG, realign all tags in headings in the current buffer." (delq nil (mapcar 'cdr table)))) (org-fast-tag-selection current-tags inherited-tags table - (if org-fast-tag-selection-include-todo org-todo-key-alist)) + (if org-fast-tag-selection-include-todo + org-todo-key-alist)) (let ((org-add-colon-after-tag-completion t)) (org-trim (org-without-partial-completion - (org-icompleting-read "Tags: " 'org-tags-completion-function + (org-icompleting-read "Tags: " + 'org-tags-completion-function nil nil current 'org-tags-history))))))) (while (string-match "[-+&]+" tags) ;; No boolean logic, just a list (setq tags (replace-match ":" t t tags)))) + (setq tags (replace-regexp-in-string "[ ,]" ":" tags)) + (if org-tags-sort-function (setq tags (mapconcat 'identity - (sort (org-split-string tags (org-re "[^[:alnum:]_@]+")) + (sort (org-split-string + tags (org-re "[^[:alnum:]_@#%]+")) org-tags-sort-function) ":"))) (if (string-match "\\`[\t ]*\\'" tags) @@ -11711,6 +12780,9 @@ With prefix ARG, realign all tags in headings in the current buffer." ;; Insert new tags at the correct column (beginning-of-line 1) + (setq level (or (and (looking-at org-outline-regexp) + (- (match-end 0) (point) 1)) + 1)) (cond ((and (equal current "") (equal tags ""))) ((re-search-forward @@ -11719,10 +12791,14 @@ With prefix ARG, realign all tags in headings in the current buffer." (if (equal tags "") (setq rpl "") (goto-char (match-beginning 0)) - (setq c0 (current-column) p0 (point) - c1 (max (1+ c0) (if (> org-tags-column 0) - org-tags-column - (- (- org-tags-column) (length tags)))) + (setq c0 (current-column) + ;; compute offset for the case of org-indent-mode active + di (if org-indent-mode + (* (1- org-indent-indentation-per-level) (1- level)) + 0) + p0 (if (equal (char-before) ?*) (1+ (point)) (point)) + tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) + c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags)))) rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) (replace-match rpl t t) (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) @@ -11774,7 +12850,7 @@ This works in the agenda, and also in an org-mode buffer." (defun org-tags-completion-function (string predicate &optional flag) (let (s1 s2 rtn (ctable org-last-tags-completion-table) (confirm (lambda (x) (stringp (car x))))) - (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string) + (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string) (setq s1 (match-string 1 string) s2 (match-string 2 string)) (setq s1 "" s2 string)) @@ -11822,6 +12898,7 @@ This works in the agenda, and also in an org-mode buffer." (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) (org-overlay-display org-tags-overlay (concat prefix s))))) +(defvar org-last-tag-selection-key nil) (defun org-fast-tag-selection (current inherited table &optional todo-table) "Fast tag selection with single keys. CURRENT is the current list of tags in the headline, INHERITED is the @@ -11850,7 +12927,7 @@ Returns the new tags string, or nil to not change the current settings." (save-excursion (beginning-of-line 1) (if (looking-at - (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) (setq ov-start (match-beginning 1) ov-end (match-end 1) ov-prefix "") @@ -11863,7 +12940,7 @@ Returns the new tags string, or nil to not change the current settings." (if (> (current-column) org-tags-column) " " (make-string (- org-tags-column (current-column)) ?\ )))))) - (org-move-overlay org-tags-overlay ov-start ov-end) + (move-overlay org-tags-overlay ov-start ov-end) (save-window-excursion (if expert (set-buffer (get-buffer-create " *Org tags*")) @@ -11936,6 +13013,7 @@ Returns the new tags string, or nil to not change the current settings." (if (not groups) "no " "") (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) (setq c (let ((inhibit-quit t)) (read-char-exclusive))) + (setq org-last-tag-selection-key c) (cond ((= c ?\r) (throw 'exit t)) ((= c ?!) @@ -11999,7 +13077,7 @@ Returns the new tags string, or nil to not change the current settings." (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward - (org-re "\\[.\\] \\([[:alnum:]_@]+\\)") nil t) + (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) @@ -12020,7 +13098,7 @@ Returns the new tags string, or nil to not change the current settings." (error "Not on a heading")) (save-excursion (beginning-of-line 1) - (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) (org-match-string-no-properties 1) ""))) @@ -12034,7 +13112,7 @@ Returns the new tags string, or nil to not change the current settings." (save-excursion (goto-char (point-min)) (while (re-search-forward - (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t\r\n]") nil t) + (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t\r\n]") nil t) (when (equal (char-after (point-at-bol 0)) ?*) (mapc (lambda (x) (add-to-list 'tags x)) (org-split-string (org-match-string-no-properties 1) ":"))))) @@ -12159,7 +13237,7 @@ a *different* entry, you cannot use these techniques." (defconst org-special-properties '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY" - "TIMESTAMP" "TIMESTAMP_IA") + "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED") "The special properties valid in Org-mode. These are properties that are not defined in the property drawer, @@ -12170,8 +13248,8 @@ but in some other way.") "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" "EXPORT_FILE_NAME" "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" - "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" - "CLOCK_MODELINE_TOTAL" "STYLE") + "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE" + "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS") "Some properties that are used by Org-mode for various purposes. Being in this list makes sure that they are offered for completion.") @@ -12179,7 +13257,7 @@ Being in this list makes sure that they are offered for completion.") "Regular expression matching the first line of a property drawer.") (defconst org-property-end-re "^[ \t]*:END:[ \t]*$" - "Regular expression matching the first line of a property drawer.") + "Regular expression matching the last line of a property drawer.") (defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" "Regular expression matching the first line of a property drawer.") @@ -12256,13 +13334,15 @@ allowed value." (message "%s is now %s" prop val))) (defun org-at-property-p () - "Is the cursor in a property line?" - ;; FIXME: Does not check if we are actually in the drawer. - ;; FIXME: also returns true on any drawers..... - ;; This is used by C-c C-c for property action. + "Is cursor inside a property drawer?" (save-excursion (beginning-of-line 1) - (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)")))) + (when (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)")) + (save-match-data ;; Used by calling procedures + (let ((p (point)) + (range (unless (org-before-first-heading-p) + (org-get-property-block)))) + (and range (<= (car range) p) (< p (cdr range)))))))) (defun org-get-property-block (&optional beg end force) "Return the (beg . end) range of the body of the property drawer. @@ -12293,7 +13373,7 @@ If the drawer does not exist and FORCE is non-nil, create the drawer." (insert ":END:\n")) (cons beg end))))) -(defun org-entry-properties (&optional pom which) +(defun org-entry-properties (&optional pom which specific) "Get all properties of the entry at point-or-marker POM. This includes the TODO keyword, the tags, time strings for deadline, scheduled, and clocking, and any additional properties defined in the @@ -12301,12 +13381,16 @@ entry. The return value is an alist, keys may occur multiple times if the property key was used several times. POM may also be nil, in which case the current entry is used. If WHICH is nil or `all', get all properties. If WHICH is -`special' or `standard', only get that subclass." +`special' or `standard', only get that subclass. If WHICH +is a string only get exactly this property. SPECIFIC can be a string, the +specific property we are interested in. Specifying it can speed +things up because then unnecessary parsing is avoided." (setq which (or which 'all)) (org-with-point-at pom (let ((clockstr (substring org-clock-string 0 -1)) - (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) - beg end range props sum-props key value string clocksum) + (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) + (case-fold-search nil) + beg end range props sum-props key key1 value string clocksum) (save-excursion (when (condition-case nil (and (org-mode-p) (org-back-to-heading t)) @@ -12319,31 +13403,53 @@ If WHICH is nil or `all', get all properties. If WHICH is (when (memq which '(all special)) ;; Get the special properties, like TODO and tags (goto-char beg) - (when (and (looking-at org-todo-line-regexp) (match-end 2)) + (when (and (or (not specific) (string= specific "TODO")) + (looking-at org-todo-line-regexp) (match-end 2)) (push (cons "TODO" (org-match-string-no-properties 2)) props)) - (when (looking-at org-priority-regexp) + (when (and (or (not specific) (string= specific "PRIORITY")) + (looking-at org-priority-regexp)) (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) - (when (and (setq value (org-get-tags-string)) + (when (and (or (not specific) (string= specific "TAGS")) + (setq value (org-get-tags-string)) (string-match "\\S-" value)) (push (cons "TAGS" value) props)) - (when (setq value (org-get-tags-at)) - (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) + (when (and (or (not specific) (string= specific "ALLTAGS")) + (setq value (org-get-tags-at))) + (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") + ":")) props)) - (while (re-search-forward org-maybe-keyword-time-regexp end t) - (setq key (if (match-end 1) (substring (org-match-string-no-properties 1) 0 -1)) - string (if (equal key clockstr) - (org-no-properties - (org-trim - (buffer-substring - (match-beginning 3) (goto-char (point-at-eol))))) - (substring (org-match-string-no-properties 3) 1 -1))) - (unless key - (if (= (char-after (match-beginning 3)) ?\[) - (setq key "TIMESTAMP_IA") - (setq key "TIMESTAMP"))) - (when (or (equal key clockstr) (not (assoc key props))) - (push (cons key string) props))) - + (when (or (not specific) (string= specific "BLOCKED")) + (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)) + (when (or (not specific) + (member specific + '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" + "TIMESTAMP" "TIMESTAMP_IA"))) + (while (re-search-forward org-maybe-keyword-time-regexp end t) + (setq key (if (match-end 1) + (substring (org-match-string-no-properties 1) + 0 -1)) + string (if (equal key clockstr) + (org-no-properties + (org-trim + (buffer-substring + (match-beginning 3) (goto-char + (point-at-eol))))) + (substring (org-match-string-no-properties 3) + 1 -1))) + ;; Get the correct property name from the key. This is + ;; necessary if the user has configured time keywords. + (setq key1 (concat key ":")) + (cond + ((not key) + (setq key + (if (= (char-after (match-beginning 3)) ?\[) + "TIMESTAMP_IA" "TIMESTAMP"))) + ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) + ((equal key1 org-deadline-string) (setq key "DEADLINE")) + ((equal key1 org-closed-string) (setq key "CLOSED")) + ((equal key1 org-clock-string) (setq key "CLOCK"))) + (when (or (equal key "CLOCK") (not (assoc key props))) + (push (cons key string) props)))) ) (when (memq which '(all standard)) @@ -12370,22 +13476,27 @@ If WHICH is nil or `all', get all properties. If WHICH is (push (cons "CATEGORY" value) props)) (append sum-props (nreverse props))))))) -(defun org-entry-get (pom property &optional inherit) +(defun org-entry-get (pom property &optional inherit literal-nil) "Get value of PROPERTY for entry at point-or-marker POM. If INHERIT is non-nil and the entry does not have the property, then also check higher levels of the hierarchy. If INHERIT is the symbol `selective', use inheritance only if the setting in `org-use-property-inheritance' selects PROPERTY for inheritance. If the property is present but empty, the return value is the empty string. -If the property is not present at all, nil is returned." +If the property is not present at all, nil is returned. + +If LITERAL-NIL is set, return the string value \"nil\" as a string, +do not interpret it as the list atom nil. This is used for inheritance +when a \"nil\" value can supersede a non-nil value higher up the hierarchy." (org-with-point-at pom (if (and inherit (if (eq inherit 'selective) (org-property-inherit-p property) t)) - (org-entry-get-with-inheritance property) + (org-entry-get-with-inheritance property literal-nil) (if (member property org-special-properties) - ;; We need a special property. Use brute force, get all properties. - (cdr (assoc property (org-entry-properties nil 'special))) + ;; We need a special property. Use `org-entry-properties' to + ;; retrieve it, but specify the wanted property + (cdr (assoc property (org-entry-properties nil 'special property))) (let ((range (org-get-property-block))) (if (and range (goto-char (car range)) @@ -12394,7 +13505,9 @@ If the property is not present at all, nil is returned." (cdr range) t)) ;; Found the property, return it. (if (match-end 1) - (org-match-string-no-properties 1) + (if literal-nil + (org-match-string-no-properties 1) + (org-not-nil (org-match-string-no-properties 1))) ""))))))) (defun org-property-or-variable-value (var &optional inherit) @@ -12489,8 +13602,12 @@ no match, the marker will point nowhere. Note that also `org-entry-get' calls this function, if the INHERIT flag is set.") -(defun org-entry-get-with-inheritance (property) - "Get entry property, and search higher levels if not present." +(defun org-entry-get-with-inheritance (property &optional literal-nil) + "Get entry property, and search higher levels if not present. +The search will stop at the first ancestor which has the property defined. +If the value found is \"nil\", return nil to show that the property +should be considered as undefined (this is the meaning of nil here). +However, if LITERAL-NIL is set, return the string value \"nil\" instead." (move-marker org-entry-property-inherited-from nil) (let (tmp) (save-excursion @@ -12498,15 +13615,21 @@ is set.") (widen) (catch 'ex (while t - (when (setq tmp (org-entry-get nil property)) + (when (setq tmp (org-entry-get nil property nil 'literal-nil)) (org-back-to-heading t) (move-marker org-entry-property-inherited-from (point)) (throw 'ex tmp)) (or (org-up-heading-safe) (throw 'ex nil))))) - (or tmp - (cdr (assoc property org-file-properties)) - (cdr (assoc property org-global-properties)) - (cdr (assoc property org-global-properties-fixed)))))) + (setq tmp (or tmp + (cdr (assoc property org-file-properties)) + (cdr (assoc property org-global-properties)) + (cdr (assoc property org-global-properties-fixed)))) + (if literal-nil tmp (org-not-nil tmp))))) + +(defvar org-property-changed-functions nil + "Hook called when the value of a property has changed. +Each hook function should accept two arguments, the name of the property +and the new value.") (defun org-entry-put (pom property value) "Set PROPERTY to VALUE for entry at point-or-marker POM." @@ -12560,7 +13683,8 @@ is set.") (org-indent-line-function) (insert ":" property ":")) (and value (insert " " value)) - (org-indent-line-function))))))) + (org-indent-line-function))))) + (run-hook-with-args 'org-property-changed-functions property value))) (defun org-buffer-property-keys (&optional include-specials include-defaults include-columns) "Get all property keys in the current buffer. @@ -12680,16 +13804,17 @@ in the current file." keys))) prop0))) (cur (org-entry-get nil prop)) + (prompt (concat prop " value" + (if (and cur (string-match "\\S-" cur)) + (concat " [" cur "]") "") ": ")) (allowed (org-property-get-allowed-values nil prop 'table)) (existing (mapcar 'list (org-property-values prop))) (val (if allowed - (org-completing-read "Value: " allowed nil 'req-match) + (org-completing-read prompt allowed nil + (not (get-text-property 0 'org-unrestricted + (caar allowed)))) (let (org-completion-use-ido org-completion-use-iswitchb) - (org-completing-read - (concat "Value " (if (and cur (string-match "\\S-" cur)) - (concat "[" cur "]") "") - ": ") - existing nil nil "" nil cur))))) + (org-completing-read prompt existing nil nil "" nil cur))))) (list prop (if (equal val "") cur val)))) (unless (equal (org-entry-get nil property) value) (org-entry-put nil property value))) @@ -12698,8 +13823,8 @@ in the current file." "In the current entry, delete PROPERTY." (interactive (let* ((completion-ignore-case t) - (prop (org-icompleting-read - "Property: " (org-entry-properties nil 'standard)))) + (prop (org-icompleting-read "Property: " + (org-entry-properties nil 'standard)))) (list prop))) (message "Property %s %s" property (if (org-entry-delete nil property) @@ -12741,6 +13866,15 @@ then applies it to the property in the column format's scope." (error "No operator defined for property %s" prop)) (org-columns-compute prop))) +(defvar org-property-allowed-value-functions nil + "Hook for functions supplying allowed values for a specific property. +The functions must take a single argument, the name of the property, and +return a flat list of allowed values. If \":ETC\" is one of +the values, this means that these values are intended as defaults for +completion, but that other values should be allowed too. +The functions must return nil if they are not responsible for this +property.") + (defun org-property-get-allowed-values (pom property &optional table) "Get allowed values for the property PROPERTY. When TABLE is non-nil, return an alist that can directly be used for @@ -12756,9 +13890,10 @@ completion." (push (char-to-string n) vals) (setq n (1- n))))) ((member property org-special-properties)) + ((setq vals (run-hook-with-args-until-success + 'org-property-allowed-value-functions property))) (t (setq vals (org-entry-get pom (concat property "_ALL") 'inherit)) - (when (and vals (string-match "\\S-" vals)) (setq vals (car (read-from-string (concat "(" vals ")")))) (setq vals (mapcar (lambda (x) @@ -12767,6 +13902,9 @@ completion." ((symbolp x) (symbol-name x)) (t "???"))) vals))))) + (when (member ":ETC" vals) + (setq vals (remove ":ETC" vals)) + (org-add-props (car vals) '(org-unrestricted t))) (if table (mapcar 'list vals) vals))) (defun org-property-previous-allowed-value (&optional previous) @@ -12797,7 +13935,89 @@ completion." (replace-match (concat " :" key ": " nval) t t) (org-indent-line-function) (beginning-of-line 1) - (skip-chars-forward " \t"))) + (skip-chars-forward " \t") + (run-hook-with-args 'org-property-changed-functions key nval))) + +(defun org-find-olp (path &optional this-buffer) + "Return a marker pointing to the entry at outline path OLP. +If anything goes wrong, throw an error. +You can wrap this call to catch the error like this: + + (condition-case msg + (org-mobile-locate-entry (match-string 4)) + (error (nth 1 msg))) + +The return value will then be either a string with the error message, +or a marker if everything is OK. + +If THIS-BUFFER is set, the outline path does not contain a file, +only headings." + (let* ((file (if this-buffer buffer-file-name (pop path))) + (buffer (if this-buffer (current-buffer) (find-file-noselect file))) + (level 1) + (lmin 1) + (lmax 1) + limit re end found pos heading cnt) + (unless buffer (error "File not found :%s" file)) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (setq limit (point-max)) + (goto-char (point-min)) + (while (setq heading (pop path)) + (setq re (format org-complex-heading-regexp-format + (regexp-quote heading))) + (setq cnt 0 pos (point)) + (while (re-search-forward re end t) + (setq level (- (match-end 1) (match-beginning 1))) + (if (and (>= level lmin) (<= level lmax)) + (setq found (match-beginning 0) cnt (1+ cnt)))) + (when (= cnt 0) (error "Heading not found on level %d: %s" + lmax heading)) + (when (> cnt 1) (error "Heading not unique on level %d: %s" + lmax heading)) + (goto-char found) + (setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0))) + (setq end (save-excursion (org-end-of-subtree t t)))) + (when (org-on-heading-p) + (move-marker (make-marker) (point)))))))) + +(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) + "Find node HEADING in BUFFER. +Return a marker to the heading if it was found, or nil if not. +If POS-ONLY is set, return just the position instead of a marker. + +The heading text must match exact, but it may have a TODO keyword, +a priority cookie and tags in the standard locations." + (with-current-buffer (or buffer (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let (case-fold-search) + (if (re-search-forward + (format org-complex-heading-regexp-format + (regexp-quote heading)) nil t) + (if pos-only + (match-beginning 0) + (move-marker (make-marker) (match-beginning 0))))))))) + +(defun org-find-exact-heading-in-directory (heading &optional dir) + "Find Org node headline HEADING in all .org files in directory DIR. +When the target headline is found, return a marker to this location." + (let ((files (directory-files (or dir default-directory) + nil "\\`[^.#].*\\.org\\'")) + file visiting m buffer) + (catch 'found + (while (setq file (pop files)) + (message "trying %s" file) + (setq visiting (org-find-base-buffer-visiting file)) + (setq buffer (or visiting (find-file-noselect file))) + (setq m (org-find-exact-headline-in-buffer + heading buffer)) + (when (and (not m) (not visiting)) (kill-buffer buffer)) + (and m (throw 'found m)))))) (defun org-find-entry-with-id (ident) "Locate the entry that contains the ID property with exact value IDENT. @@ -12905,8 +14125,8 @@ So these are more for recording a certain time/date." (interactive "P") (org-time-stamp arg 'inactive)) -(defvar org-date-ovl (org-make-overlay 1 1)) -(org-overlay-put org-date-ovl 'face 'org-warning) +(defvar org-date-ovl (make-overlay 1 1)) +(overlay-put org-date-ovl 'face 'org-warning) (org-detach-overlay org-date-ovl) (defvar org-ans1) ; dynamically scoped parameter @@ -12927,10 +14147,15 @@ The prompt will suggest to enter an ISO date, but you can also enter anything which will at least partially be understood by `parse-time-string'. Unrecognized parts of the date will default to the current day, month, year, hour and minute. If this command is called to replace a timestamp at point, -of to enter the second timestamp of a range, the default time is taken from the -existing stamp. For example, +of to enter the second timestamp of a range, the default time is taken +from the existing stamp. Furthermore, the command prefers the future, +so if you are giving a date where the year is not given, and the day-month +combination is already past in the current year, it will assume you +mean next year. For details, see the manual. A few examples: + 3-2-5 --> 2003-02-05 feb 15 --> currentyear-02-15 + 2/15 --> currentyear-02-15 sep 12 9 --> 2009-09-12 12:45 --> today 12:45 22 sept 0:34 --> currentyear-09-22 0:34 @@ -12983,11 +14208,10 @@ user." (setq def (apply 'encode-time defdecode) defdecode (decode-time def))))) (calendar-frame-setup nil) + (calendar-setup nil) (calendar-move-hook nil) (calendar-view-diary-initially-flag nil) - (view-diary-entries-initially nil) (calendar-view-holidays-initially-flag nil) - (view-calendar-holidays-initially nil) (timestr (format-time-string (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) (prompt (concat (if prompt (concat prompt " ") "") @@ -13008,10 +14232,8 @@ user." (map (copy-keymap calendar-mode-map)) (minibuffer-local-map (copy-keymap minibuffer-local-map))) (org-defkey map (kbd "RET") 'org-calendar-select) - (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1]) - 'org-calendar-select-mouse) - (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2]) - 'org-calendar-select-mouse) + (org-defkey map [mouse-1] 'org-calendar-select-mouse) + (org-defkey map [mouse-2] 'org-calendar-select-mouse) (org-defkey minibuffer-local-map [(meta shift left)] (lambda () (interactive) (org-eval-in-calendar '(calendar-backward-month 1)))) @@ -13054,6 +14276,14 @@ user." (org-defkey minibuffer-local-map "<" (lambda () (interactive) (org-eval-in-calendar '(scroll-calendar-right 1)))) + (org-defkey minibuffer-local-map "\C-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-left-three-months 1)))) + (org-defkey minibuffer-local-map "\M-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-right-three-months 1)))) (run-hooks 'org-read-date-minibuffer-setup-hook) (unwind-protect (progn @@ -13068,7 +14298,7 @@ user." (remove-hook 'post-command-hook 'org-read-date-display) (use-local-map old-map) (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay) + (delete-overlay org-read-date-overlay) (setq org-read-date-overlay nil))))))) (t ; Naked prompt only @@ -13076,10 +14306,14 @@ user." (setq ans (read-string prompt default-input 'org-read-date-history timestr)) (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay) + (delete-overlay org-read-date-overlay) (setq org-read-date-overlay nil))))) (setq final (org-read-date-analyze ans def defdecode)) + + ;; One round trip to get rid of 34th of August and stuff like that.... + (setq final (decode-time (apply 'encode-time final))) + (setq org-read-date-final-answer ans) (if to-time @@ -13098,7 +14332,7 @@ user." "Display the current date prompt interpretation in the minibuffer." (when org-read-date-display-live (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay)) + (delete-overlay org-read-date-overlay)) (let ((p (point))) (end-of-line 1) (while (not (equal (buffer-substring @@ -13126,15 +14360,16 @@ user." (when org-read-date-analyze-futurep (setq txt (concat txt " (=>F)"))) (setq org-read-date-overlay - (org-make-overlay (1- (point-at-eol)) (point-at-eol))) + (make-overlay (1- (point-at-eol)) (point-at-eol))) (org-overlay-display org-read-date-overlay txt 'secondary-selection)))) (defun org-read-date-analyze (ans def defdecode) - "Analyse the combined answer of the date prompt." + "Analyze the combined answer of the date prompt." ;; FIXME: cleanup and comment - (let (delta deltan deltaw deltadef year month day - hour minute second wday pm h2 m2 tl wday1 - iso-year iso-weekday iso-week iso-year iso-date futurep) + (let ((nowdecode (decode-time (current-time))) + delta deltan deltaw deltadef year month day + hour minute second wday pm h2 m2 tl wday1 + iso-year iso-weekday iso-week iso-year iso-date futurep kill-year) (setq org-read-date-analyze-futurep nil) (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) (setq ans "+0")) @@ -13149,22 +14384,38 @@ user." ;; If yes, store the info and postpone interpreting it until the rest ;; of the parsing is done (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) - (setq iso-year (if (match-end 1) (org-small-year-to-year (string-to-number (match-string 1 ans)))) - iso-weekday (if (match-end 3) (string-to-number (match-string 3 ans))) + (setq iso-year (if (match-end 1) + (org-small-year-to-year + (string-to-number (match-string 1 ans)))) + iso-weekday (if (match-end 3) + (string-to-number (match-string 3 ans))) iso-week (string-to-number (match-string 2 ans))) (setq ans (replace-match "" t t ans))) - ;; Help matching ISO dates with single digit month ot day, like 2006-8-11. + ;; Help matching ISO dates with single digit month or day, like 2006-8-11. (when (string-match "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) (setq year (if (match-end 2) (string-to-number (match-string 2 ans)) - (string-to-number (format-time-string "%Y"))) + (progn (setq kill-year t) + (string-to-number (format-time-string "%Y")))) month (string-to-number (match-string 3 ans)) day (string-to-number (match-string 4 ans))) (if (< year 100) (setq year (+ 2000 year))) (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) t nil ans))) + ;; Help matching american dates, like 5/30 or 5/30/7 + (when (string-match + "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans) + (setq year (if (match-end 4) + (string-to-number (match-string 4 ans)) + (progn (setq kill-year t) + (string-to-number (format-time-string "%Y")))) + month (string-to-number (match-string 1 ans)) + day (string-to-number (match-string 2 ans))) + (if (< year 100) (setq year (+ 2000 year))) + (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) + t nil ans))) ;; Help matching am/pm times, because `parse-time-string' does not do that. ;; If there is a time with am/pm, and *no* time without it, we convert ;; so that matching will be successful. @@ -13207,13 +14458,13 @@ user." day (or (nth 3 tl) (nth 3 defdecode)) month (or (nth 4 tl) (if (and org-read-date-prefer-future - (nth 3 tl) (< (nth 3 tl) (nth 3 defdecode))) - (prog1 (1+ (nth 4 defdecode)) (setq futurep t)) + (nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode))) + (prog1 (1+ (nth 4 nowdecode)) (setq futurep t)) (nth 4 defdecode))) - year (or (nth 5 tl) + year (or (and (not kill-year) (nth 5 tl)) (if (and org-read-date-prefer-future - (nth 4 tl) (< (nth 4 tl) (nth 4 defdecode))) - (prog1 (1+ (nth 5 defdecode)) (setq futurep t)) + (nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode))) + (prog1 (1+ (nth 5 nowdecode)) (setq futurep t)) (nth 5 defdecode))) hour (or (nth 2 tl) (nth 2 defdecode)) minute (or (nth 1 tl) (nth 1 defdecode)) @@ -13222,14 +14473,14 @@ user." (when (and (eq org-read-date-prefer-future 'time) (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl)) - (equal day (nth 3 defdecode)) - (equal month (nth 4 defdecode)) - (equal year (nth 5 defdecode)) + (equal day (nth 3 nowdecode)) + (equal month (nth 4 nowdecode)) + (equal year (nth 5 nowdecode)) (nth 2 tl) - (or (< (nth 2 tl) (nth 2 defdecode)) - (and (= (nth 2 tl) (nth 2 defdecode)) + (or (< (nth 2 tl) (nth 2 nowdecode)) + (and (= (nth 2 tl) (nth 2 nowdecode)) (nth 1 tl) - (< (nth 1 tl) (nth 1 defdecode))))) + (< (nth 1 tl) (nth 1 nowdecode))))) (setq day (1+ day) futurep t)) @@ -13237,6 +14488,7 @@ user." (cond (iso-week ;; There was an iso week + (require 'cal-iso) (setq futurep nil) (setq year (or iso-year year) day (or iso-weekday wday 1) @@ -13316,6 +14568,24 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to (list delta "d" rel)) (list (* n (if (= dir ?-) -1 1)) what rel))))) +(defun org-order-calendar-date-args (arg1 arg2 arg3) + "Turn a user-specified date into the internal representation. +The internal representation needed by the calendar is (month day year). +This is a wrapper to handle the brain-dead convention in calendar that +user function argument order change dependent on argument order." + (if (boundp 'calendar-date-style) + (cond + ((eq calendar-date-style 'american) + (list arg1 arg2 arg3)) + ((eq calendar-date-style 'european) + (list arg2 arg1 arg3)) + ((eq calendar-date-style 'iso) + (list arg2 arg3 arg1))) + (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1 + (if (org-bound-and-true-p european-calendar-style) + (list arg2 arg1 arg3) + (list arg1 arg2 arg3))))) + (defun org-eval-in-calendar (form &optional keepdate) "Eval FORM in the calendar window and return to current window. Also, store the cursor date in variable org-ans2." @@ -13327,7 +14597,7 @@ Also, store the cursor date in variable org-ans2." (let* ((date (calendar-cursor-to-date)) (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) - (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) + (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) (select-window sw) (org-select-frame-set-input-focus sf))) @@ -13343,7 +14613,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer." (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) "Insert a date stamp for the date given by the internal TIME. -WITH-HM means, use the stamp format that includes the time of the day. +WITH-HM means use the stamp format that includes the time of the day. INACTIVE means use square brackets instead of angular ones, so that the stamp will not contribute to the agenda. PRE and POST are optional strings to be inserted before and after the @@ -13353,7 +14623,6 @@ The command returns the inserted time stamp." stamp) (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) (insert-before-markers (or pre "")) - (insert-before-markers (setq stamp (format-time-string fmt time))) (when (listp extra) (setq extra (car extra)) (if (and (stringp extra) @@ -13363,9 +14632,8 @@ The command returns the inserted time stamp." (string-to-number (match-string 2 extra)))) (setq extra nil))) (when extra - (backward-char 1) - (insert-before-markers extra) - (forward-char 1)) + (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) + (insert-before-markers (setq stamp (format-time-string fmt time))) (insert-before-markers (or post "")) (setq org-last-inserted-timestamp stamp))) @@ -13621,7 +14889,7 @@ days in order to avoid rounding problems." (defun org-time-string-to-absolute (s &optional daynr prefer show-all) "Convert a time stamp to an absolute day number. -If there is a specifyer for a cyclic time stamp, get the closest date to +If there is a specifier for a cyclic time stamp, get the closest date to DAYNR. PREFER and SHOW-ALL are passed through to `org-closest-date'. the variable date is bound by the calendar when this is called." @@ -13680,9 +14948,12 @@ D may be an absolute day number, or a calendar-type list (month day year)." (org-current-line) (buffer-file-name) sexp) (sleep-for 2)))))) - (cond ((stringp result) result) + (cond ((stringp result) (split-string result "; ")) ((and (consp result) + (not (consp (cdr result))) (stringp (cdr result))) (cdr result)) + ((and (consp result) + (stringp (car result))) result) (result entry) (t nil)))) @@ -13734,7 +15005,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change) (setq dn (string-to-number (match-string 1 change)) dw (cdr (assoc (match-string 2 change) a1))) - (error "Invalid change specifyer: %s" change)) + (error "Invalid change specifier: %s" change)) (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) (cond ((eq dw 'day) @@ -13780,7 +15051,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." (t (if (= cday n1) n1 n2))))))) (defun org-date-to-gregorian (date) - "Turn any specification of DATE into a gregorian date for the calendar." + "Turn any specification of DATE into a Gregorian date for the calendar." (cond ((integerp date) (calendar-gregorian-from-absolute date)) ((and (listp date) (= (length date) 3)) date) ((stringp date) @@ -13812,7 +15083,7 @@ If the cursor is on the year, change the year. If it is on the month or the day, change that. With prefix ARG, change by that many units." (interactive "p") - (org-timestamp-change (prefix-numeric-value arg))) + (org-timestamp-change (prefix-numeric-value arg) nil 'updown)) (defun org-timestamp-down (&optional arg) "Decrease the date item at the cursor by one. @@ -13820,7 +15091,7 @@ If the cursor is on the year, change the year. If it is on the month or the day, change that. With prefix ARG, change by that many units." (interactive "p") - (org-timestamp-change (- (prefix-numeric-value arg)))) + (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown)) (defun org-timestamp-up-day (&optional arg) "Increase the date in the time stamp by one day. @@ -13829,7 +15100,7 @@ With prefix ARG, change that many days." (if (and (not (org-at-timestamp-p t)) (org-on-heading-p)) (org-todo 'up) - (org-timestamp-change (prefix-numeric-value arg) 'day))) + (org-timestamp-change (prefix-numeric-value arg) 'day 'updown))) (defun org-timestamp-down-day (&optional arg) "Decrease the date in the time stamp by one day. @@ -13838,7 +15109,7 @@ With prefix ARG, change that many days." (if (and (not (org-at-timestamp-p t)) (org-on-heading-p)) (org-todo 'down) - (org-timestamp-change (- (prefix-numeric-value arg)) 'day))) + (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown)) (defun org-at-timestamp-p (&optional inactive-ok) "Determine if the cursor is in or at a timestamp." @@ -13883,7 +15154,7 @@ With prefix ARG, change that many days." (message "Timestamp is now %sactive" (if (equal (char-after beg) ?<) "" "in"))))) -(defun org-timestamp-change (n &optional what) +(defun org-timestamp-change (n &optional what updown) "Change the date in the time stamp at point. The date will be changed by N times WHAT. WHAT can be `day', `month', `year', `minute', `second'. If WHAT is not given, the cursor position @@ -13914,8 +15185,10 @@ in the timestamp determines what will be changed." (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) (setq with-hm t)) (setq time0 (org-parse-time-string ts)) - (when (and (eq org-ts-what 'minute) - (eq current-prefix-arg nil)) + (when (and updown + (eq org-ts-what 'minute) + (not current-prefix-arg)) + ;; This looks like s-up and s-down. Change by one rounding step. (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) (when (not (= 0 (setq rem (% (nth 1 time0) dm)))) (setcar (cdr time0) (+ (nth 1 time0) @@ -14012,9 +15285,7 @@ A prefix ARG can be used to force the current date." (let ((tsr org-ts-regexp) diff (calendar-move-hook nil) (calendar-view-holidays-initially-flag nil) - (view-calendar-holidays-initially nil) - (calendar-view-diary-initially-flag nil) - (view-diary-entries-initially nil)) + (calendar-view-diary-initially-flag nil)) (if (or (org-at-timestamp-p) (save-excursion (beginning-of-line 1) @@ -14104,21 +15375,31 @@ changes from another. I believe the procedure must be like this: ;;;; Agenda files ;;;###autoload -(defun org-iswitchb (&optional arg) - "Use `org-icompleting-read' to prompt for an Org buffer to switch to. +(defun org-switchb (&optional arg) + "Switch between Org buffers. With a prefix argument, restrict available to files. -With two prefix arguments, restrict available buffers to agenda files." +With two prefix arguments, restrict available buffers to agenda files. + +Defaults to `iswitchb' for buffer name completion. +Set `org-completion-use-ido' to make it use ido instead." (interactive "P") (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files)) ((equal arg '(16)) (org-buffer-list 'agenda)) - (t (org-buffer-list))))) + (t (org-buffer-list)))) + (org-completion-use-iswitchb org-completion-use-iswitchb) + (org-completion-use-ido org-completion-use-ido)) + (unless (or org-completion-use-ido org-completion-use-iswitchb) + (setq org-completion-use-iswitchb t)) (switch-to-buffer (org-icompleting-read "Org buffer: " - (mapcar 'list (mapcar 'buffer-name blist)) - nil t)))) + (mapcar 'list (mapcar 'buffer-name blist)) + nil t)))) +;;; Define some older names previously used for this functionality ;;;###autoload -(defalias 'org-ido-switchb 'org-iswitchb) +(defalias 'org-ido-switchb 'org-switchb) +;;;###autoload +(defalias 'org-iswitchb 'org-switchb) (defun org-buffer-list (&optional predicate exclude-tmp) "Return a list of Org buffers. @@ -14162,7 +15443,7 @@ If EXCLUDE-TMP is non-nil, ignore temporary buffers." "Get the list of agenda files. Optional UNRESTRICTED means return the full list even if a restriction is currently in place. -When ARCHIVES is t, include all archive files hat are really being +When ARCHIVES is t, include all archive files that are really being used by the agenda files. If ARCHIVE is `ifmode', do this only if `org-agenda-archives-mode' is t." (let ((files @@ -14189,6 +15470,13 @@ used by the agenda files. If ARCHIVE is `ifmode', do this only if (setq files (org-add-archive-files files))) files)) +(defun org-agenda-file-p (&optional file) + "Return non-nil, if FILE is an agenda file. +If FILE is omitted, use the file associated with the current +buffer." + (member (or file (buffer-file-name)) + (org-agenda-files t))) + (defun org-edit-agenda-file-list () "Edit the list of agenda files. Depending on setup, this either uses customize to edit the variable @@ -14215,24 +15503,41 @@ the buffer and restores the previous window configuration." (defun org-store-new-agenda-file-list (list) "Set new value for the agenda file list and save it correctly." (if (stringp org-agenda-files) - (let ((f org-agenda-files) b) - (while (setq b (find-buffer-visiting f)) (kill-buffer b)) - (with-temp-file f - (insert (mapconcat 'identity list "\n") "\n"))) + (let ((fe (org-read-agenda-file-list t)) b u) + (while (setq b (find-buffer-visiting org-agenda-files)) + (kill-buffer b)) + (with-temp-file org-agenda-files + (insert + (mapconcat + (lambda (f) ;; Keep un-expanded entries. + (if (setq u (assoc f fe)) + (cdr u) + f)) + list "\n") + "\n"))) (let ((org-mode-hook nil) (org-inhibit-startup t) (org-insert-mode-line-in-empty-file nil)) (setq org-agenda-files list) (customize-save-variable 'org-agenda-files org-agenda-files)))) -(defun org-read-agenda-file-list () - "Read the list of agenda files from a file." +(defun org-read-agenda-file-list (&optional pair-with-expansion) + "Read the list of agenda files from a file. +If PAIR-WITH-EXPANSION is t return pairs with un-expanded +filenames, used by `org-store-new-agenda-file-list' to write back +un-expanded file names." (when (file-directory-p org-agenda-files) (error "`org-agenda-files' cannot be a single directory")) (when (stringp org-agenda-files) (with-temp-buffer (insert-file-contents org-agenda-files) - (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*")))) - + (mapcar + (lambda (f) + (let ((e (expand-file-name (substitute-in-file-name f) + org-directory))) + (if pair-with-expansion + (cons e f) + e))) + (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*"))))) ;;;###autoload (defun org-cycle-agenda-files () @@ -14280,7 +15585,7 @@ end of the list." (defun org-remove-file (&optional file) "Remove current file from the list of files in variable `org-agenda-files'. These are the files which are being checked for agenda entries. -Optional argument FILE means, use this file instead of the current." +Optional argument FILE means use this file instead of the current." (interactive) (let* ((org-agenda-skip-unavailable-files nil) (file (or file buffer-file-name)) @@ -14382,6 +15687,8 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (add-text-properties (match-beginning 0) (org-end-of-subtree t) pc))) (set-buffer-modified-p bmp))))) + (setq org-todo-keywords-for-agenda + (org-uniquify org-todo-keywords-for-agenda)) (setq org-todo-keyword-alist-for-agenda (org-uniquify org-todo-keyword-alist-for-agenda) org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda)))) @@ -14477,6 +15784,11 @@ looks only before point, not after." (goto-char pos) (if dd-on (cons "$$" m)))))) +(defun org-inside-latex-macro-p () + "Is point inside a LaTeX macro or its arguments?" + (save-match-data + (org-in-regexp + "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) (defun org-try-cdlatex-tab () "Check if it makes sense to execute `cdlatex-tab', and do it if yes. @@ -14519,7 +15831,7 @@ Revert to the normal definition outside of these fragments." (defun org-remove-latex-fragment-image-overlays () "Remove all overlays with LaTeX fragment images in current buffer." - (mapc 'org-delete-overlay org-latex-fragment-image-overlays) + (mapc 'delete-overlay org-latex-fragment-image-overlays) (setq org-latex-fragment-image-overlays nil)) (defun org-preview-latex-fragment (&optional subtree) @@ -14528,7 +15840,8 @@ If the cursor is in a LaTeX fragment, create the image and overlay it over the source code. If there is no fragment at point, display all fragments in the current text, from one headline to the next. With prefix SUBTREE, display all fragments in the current subtree. With a -double prefix `C-u C-u', or when the cursor is before the first headline, +double prefix arg \\[universal-argument] \\[universal-argument], or when \ +the cursor is before the first headline, display all fragments in the buffer. The images can be removed again with \\[org-ctrl-c-ctrl-c]." (interactive "P") @@ -14560,7 +15873,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (concat "ltxpng/" (file-name-sans-extension (file-name-nondirectory buffer-file-name))) - default-directory 'overlays msg at 'forbuffer) + default-directory 'overlays msg at 'forbuffer 'dvipng) (message msg "done. Use `C-c C-c' to remove images."))))) (defvar org-latex-regexps @@ -14574,7 +15887,9 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) "Regular expressions for matching embedded LaTeX.") -(defun org-format-latex (prefix &optional dir overlays msg at forbuffer) +(defvar org-export-have-math nil) ;; dynamic scoping +(defun org-format-latex (prefix &optional dir overlays msg at + forbuffer processing-type) "Replace LaTeX fragments with links to an image, and produce images. Some of the options can be changed using the variable `org-format-latex-options'." @@ -14585,8 +15900,10 @@ Some of the options can be changed using the variable (opt org-format-latex-options) (matchers (plist-get opt :matchers)) (re-list org-latex-regexps) + (org-format-latex-header-extra + (plist-get (org-infile-export-plist) :latex-header-extra)) (cnt 0) txt hash link beg end re e checkdir - executables-checked + executables-checked string m n block linkfile movefile ov) ;; Check the different regular expressions (while (setq e (pop re-list)) @@ -14602,56 +15919,81 @@ Some of the options can be changed using the variable (not (eq (get-char-property (match-beginning n) 'org-overlay-type) 'org-latex-overlay)))) - (setq txt (match-string n) - beg (match-beginning n) end (match-end n) - cnt (1+ cnt) - link (concat block "[[file:" linkfile "]]" block)) - (let (print-length print-level) ; make sure full list is printed - (setq hash (sha1 (prin1-to-string - (list org-format-latex-header - org-export-latex-packages-alist - org-format-latex-options - forbuffer txt))) - linkfile (format "%s_%s.png" prefix hash) - movefile (format "%s_%s.png" absprefix hash))) - (if msg (message msg cnt)) - (goto-char beg) - (unless checkdir ; make sure the directory exists - (setq checkdir t) - (or (file-directory-p todir) (make-directory todir))) - - (unless executables-checked - (org-check-external-command - "latex" "needed to convert LaTeX fragments to images") - (org-check-external-command - "dvipng" "needed to convert LaTeX fragments to images") - (setq executables-checked t)) - - (unless (file-exists-p movefile) - (org-create-formula-image - txt movefile opt forbuffer)) - (if overlays - (progn - (mapc (lambda (o) - (if (eq (org-overlay-get o 'org-overlay-type) - 'org-latex-overlay) - (org-delete-overlay o))) - (org-overlays-in beg end)) - (setq ov (org-make-overlay beg end)) - (org-overlay-put ov 'org-overlay-type 'org-latex-overlay) - (if (featurep 'xemacs) - (progn - (org-overlay-put ov 'invisible t) - (org-overlay-put - ov 'end-glyph - (make-glyph (vector 'png :file movefile)))) - (org-overlay-put - ov 'display - (list 'image :type 'png :file movefile :ascent 'center))) - (push ov org-latex-fragment-image-overlays) - (goto-char end)) - (delete-region beg end) - (insert link)))))))) + (setq org-export-have-math t) + (cond + ((eq processing-type 'verbatim) + ;; Leave the text verbatim, just protect it + (add-text-properties (match-beginning n) (match-end n) + '(org-protected t))) + ((eq processing-type 'mathjax) + ;; Prepare for MathJax processing + (setq string (match-string n)) + (if (member m '("$" "$1")) + (save-excursion + (delete-region (match-beginning n) (match-end n)) + (goto-char (match-beginning n)) + (insert (org-add-props (concat "\\(" (substring string 1 -1) + "\\)") + '(org-protected t)))) + (add-text-properties (match-beginning n) (match-end n) + '(org-protected t)))) + ((or (eq processing-type 'dvipng) t) + ;; Process to an image + (setq txt (match-string n) + beg (match-beginning n) end (match-end n) + cnt (1+ cnt)) + (let (print-length print-level) ; make sure full list is printed + (setq hash (sha1 (prin1-to-string + (list org-format-latex-header + org-format-latex-header-extra + org-export-latex-default-packages-alist + org-export-latex-packages-alist + org-format-latex-options + forbuffer txt))) + linkfile (format "%s_%s.png" prefix hash) + movefile (format "%s_%s.png" absprefix hash))) + (setq link (concat block "[[file:" linkfile "]]" block)) + (if msg (message msg cnt)) + (goto-char beg) + (unless checkdir ; make sure the directory exists + (setq checkdir t) + (or (file-directory-p todir) (make-directory todir t))) + + (unless executables-checked + (org-check-external-command + "latex" "needed to convert LaTeX fragments to images") + (org-check-external-command + "dvipng" "needed to convert LaTeX fragments to images") + (setq executables-checked t)) + + (unless (file-exists-p movefile) + (org-create-formula-image + txt movefile opt forbuffer)) + (if overlays + (progn + (mapc (lambda (o) + (if (eq (overlay-get o 'org-overlay-type) + 'org-latex-overlay) + (delete-overlay o))) + (overlays-in beg end)) + (setq ov (make-overlay beg end)) + (overlay-put ov 'org-overlay-type 'org-latex-overlay) + (if (featurep 'xemacs) + (progn + (overlay-put ov 'invisible t) + (overlay-put + ov 'end-glyph + (make-glyph (vector 'png :file movefile)))) + (overlay-put + ov 'display + (list 'image :type 'png :file movefile :ascent 'center))) + (push ov org-latex-fragment-image-overlays) + (goto-char end)) + (delete-region beg end) + (insert (org-add-props link + (list 'org-latex-src + (replace-regexp-in-string + "\"" "" txt))))))))))))) ;; This function borrows from Ganesh Swami's latex2png.el (defun org-create-formula-image (string tofile options buffer) @@ -14677,17 +16019,14 @@ Some of the options can be changed using the variable (if (eq fg 'default) (setq fg (org-dvipng-color :foreground))) (if (eq bg 'default) (setq bg (org-dvipng-color :background))) (with-temp-file texfile - (insert org-format-latex-header - (if org-export-latex-packages-alist - (concat "\n" - (mapconcat (lambda(p) - (if (equal "" (car p)) - (format "\\usepackage{%s}" (cadr p)) - (format "\\usepackage[%s]{%s}" - (car p) (cadr p)))) - org-export-latex-packages-alist "\n")) - "") - "\n\\begin{document}\n" string "\n\\end{document}\n")) + (insert (org-splice-latex-header + org-format-latex-header + org-export-latex-default-packages-alist + org-export-latex-packages-alist t + org-format-latex-header-extra)) + (insert "\n\\begin{document}\n" string "\n\\end{document}\n") + (require 'org-latex) + (org-export-latex-fix-inputenc)) (let ((dir default-directory)) (condition-case nil (progn @@ -14707,13 +16046,75 @@ Some of the options can be changed using the variable dvifile) (error nil)) (if (not (file-exists-p pngfile)) - (progn (message "Failed to create png file from %s" texfile) nil) + (if org-format-latex-signal-error + (error "Failed to create png file from %s" texfile) + (message "Failed to create png file from %s" texfile) + nil) ;; Use the requested file name and clean up (copy-file pngfile tofile 'replace) (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png") do (delete-file (concat texfilebase e))) pngfile)))) +(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) + "Fill a LaTeX header template TPL. +In the template, the following place holders will be recognized: + + [DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG + [NO-DEFAULT-PACKAGES] do not include DEF-PKG + [PACKAGES] \\usepackage statements for PKG + [NO-PACKAGES] do not include PKG + [EXTRA] the string EXTRA + [NO-EXTRA] do not include EXTRA + +For backward compatibility, if both the positive and the negative place +holder is missing, the positive one (without the \"NO-\") will be +assumed to be present at the end of the template. +DEF-PKG and PKG are assumed to be alists of options/packagename lists. +EXTRA is a string. +SNIPPETS-P indicates if this is run to create snippet images for HTML." + (let (rpl (end "")) + (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl) + (setq rpl (if (or (match-end 1) (not def-pkg)) + "" (org-latex-packages-to-string def-pkg snippets-p t)) + tpl (replace-match rpl t t tpl)) + (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) + + (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl) + (setq rpl (if (or (match-end 1) (not pkg)) + "" (org-latex-packages-to-string pkg snippets-p t)) + tpl (replace-match rpl t t tpl)) + (if pkg (setq end + (concat end "\n" + (org-latex-packages-to-string pkg snippets-p))))) + + (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl) + (setq rpl (if (or (match-end 1) (not extra)) + "" (concat extra "\n")) + tpl (replace-match rpl t t tpl)) + (if (and extra (string-match "\\S-" extra)) + (setq end (concat end "\n" extra)))) + + (if (string-match "\\S-" end) + (concat tpl "\n" end) + tpl))) + +(defun org-latex-packages-to-string (pkg &optional snippets-p newline) + "Turn an alist of packages into a string with the \\usepackage macros." + (setq pkg (mapconcat (lambda(p) + (cond + ((stringp p) p) + ((and snippets-p (>= (length p) 3) (not (nth 2 p))) + (format "%% Package %s omitted" (cadr p))) + ((equal "" (car p)) + (format "\\usepackage{%s}" (cadr p))) + (t + (format "\\usepackage[%s]{%s}" + (car p) (cadr p))))) + pkg + "\n")) + (if newline (concat pkg "\n") pkg)) + (defun org-dvipng-color (attr) "Return an rgb color specification for dvipng." (apply 'format "rgb %s %s %s" @@ -14724,6 +16125,80 @@ Some of the options can be changed using the variable "Return string to be used as color value for an RGB component." (format "%g" (/ value 65535.0))) +;; Image display + + +(defvar org-inline-image-overlays nil) +(make-variable-buffer-local 'org-inline-image-overlays) + +(defun org-toggle-inline-images (&optional include-linked) + "Toggle the display of inline images. +INCLUDE-LINKED is passed to `org-display-inline-images'." + (interactive "P") + (if org-inline-image-overlays + (progn + (org-remove-inline-images) + (message "Inline image display turned off")) + (org-display-inline-images include-linked) + (if org-inline-image-overlays + (message "%d images displayed inline" + (length org-inline-image-overlays)) + (message "No images to display inline")))) + +(defun org-display-inline-images (&optional include-linked refresh beg end) + "Display inline images. +Normally only links without a description part are inlined, because this +is how it will work for export. When INCLUDE-LINKED is set, also links +with a description part will be inlined. This can be nice for a quick +look at those images, but it does not reflect what exported files will look +like. +When REFRESH is set, refresh existing images between BEG and END. +This will create new image displays only if necessary. +BEG and END default to the buffer boundaries." + (interactive "P") + (unless refresh + (org-remove-inline-images) + (clear-image-cache)) + (save-excursion + (save-restriction + (widen) + (setq beg (or beg (point-min)) end (or end (point-max))) + (goto-char (point-min)) + (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" + (substring (org-image-file-name-regexp) 0 -2) + "\\)\\]" (if include-linked "" "\\]"))) + old file ov img) + (while (re-search-forward re end t) + (setq old (get-char-property-and-overlay (match-beginning 1) + 'org-image-overlay)) + (setq file (expand-file-name + (concat (or (match-string 3) "") (match-string 4)))) + (when (file-exists-p file) + (if (and (car-safe old) refresh) + (image-refresh (overlay-get (cdr old) 'display)) + (setq img (save-match-data (create-image file))) + (when img + (setq ov (make-overlay (match-beginning 0) (match-end 0))) + (overlay-put ov 'display img) + (overlay-put ov 'face 'default) + (overlay-put ov 'org-image-overlay t) + (overlay-put ov 'modification-hooks + (list 'org-display-inline-modification-hook)) + (push ov org-inline-image-overlays))))))))) + +(defun org-display-inline-modification-hook (ov after beg end &optional len) + "Remove inline-display overlay if a corresponding region is modified." + (let ((inhibit-modification-hooks t)) + (when (and ov after) + (delete ov org-inline-image-overlays) + (delete-overlay ov)))) + +(defun org-remove-inline-images () + "Remove inline display of images." + (interactive) + (mapc 'delete-overlay org-inline-image-overlays) + (setq org-inline-image-overlays nil)) + ;;;; Key bindings ;; Make `C-c C-x' a prefix key @@ -14733,9 +16208,9 @@ Some of the options can be changed using the variable (org-defkey org-mode-map "\C-i" 'org-cycle) (org-defkey org-mode-map [(tab)] 'org-cycle) (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) -(org-defkey org-mode-map [(meta tab)] 'org-complete) -(org-defkey org-mode-map "\M-\t" 'org-complete) -(org-defkey org-mode-map "\M-\C-i" 'org-complete) +(org-defkey org-mode-map [(meta tab)] 'pcomplete) +(org-defkey org-mode-map "\M-\t" 'pcomplete) +(org-defkey org-mode-map "\M-\C-i" 'pcomplete) ;; The following line is necessary under Suse GNU/Linux (unless (featurep 'xemacs) (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) @@ -14765,6 +16240,12 @@ Some of the options can be changed using the variable (org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) (org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) +;; Babel keys +(define-key org-mode-map org-babel-key-prefix org-babel-map) +(mapc (lambda (pair) + (define-key org-babel-map (car pair) (cdr pair))) + org-babel-key-bindings) + ;;; Extra keys for tty access. ;; We only set them when really needed because otherwise the ;; menus don't show the simple keys @@ -14794,7 +16275,7 @@ Some of the options can be changed using the variable (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft) - (org-defkey org-mode-map [?\e (tab)] 'org-complete) + (org-defkey org-mode-map [?\e (tab)] 'pcomplete) (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading) (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft) (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright) @@ -14822,7 +16303,6 @@ Some of the options can be changed using the variable (org-defkey org-mode-map "\C-c\C-s" 'org-schedule) (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) -(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) (org-defkey org-mode-map "\C-c\C-w" 'org-refile) (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved (org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. @@ -14876,6 +16356,7 @@ Some of the options can be changed using the variable (org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) (org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) (org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) +(org-defkey org-mode-map "\C-c@" 'org-mark-subtree) (org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree) ;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree) @@ -14893,16 +16374,20 @@ Some of the options can be changed using the variable (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) +(org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images) +(org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities) (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) (org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) (org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) +(org-defkey org-mode-map [(control ?c) (control ?x) ?\:] 'org-timer-cancel-timer) (org-defkey org-mode-map "\C-c\C-x." 'org-timer) (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) (org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start) +(org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop) (org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue) (define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) @@ -14945,7 +16430,7 @@ Some of the options can be changed using the variable ("^" . org-sort) ("w" . org-refile) ("a" . org-archive-subtree-default-with-confirmation) - ("." . outline-mark-subtree) + ("." . org-mark-subtree) ("Clock Commands") ("I" . org-clock-in) ("O" . org-clock-out) @@ -14963,6 +16448,8 @@ Some of the options can be changed using the variable ("Misc") ("o" . org-open-at-point) ("?" . org-speed-command-help) + ("<" . (org-agenda-set-restriction-lock 'subtree)) + (">" . (org-agenda-remove-restriction-lock)) ) "The default speed commands.") @@ -15009,6 +16496,40 @@ If not, return to the original position and throw an error." (defvar org-table-auto-blank-field) ; defined in org-table.el (defvar org-speed-command nil) + +(defun org-speed-command-default-hook (keys) + "Hook for activating single-letter speed commands. +`org-speed-commands-default' specifies a minimal command set. Use +`org-speed-commands-user' for further customization." + (when (or (and (bolp) (looking-at outline-regexp)) + (and (functionp org-use-speed-commands) + (funcall org-use-speed-commands))) + (cdr (assoc keys (append org-speed-commands-user + org-speed-commands-default))))) + +(defun org-babel-speed-command-hook (keys) + "Hook for activating single-letter code block commands." + (when (and (bolp) (looking-at org-babel-src-block-regexp)) + (cdr (assoc keys org-babel-key-bindings)))) + +(defcustom org-speed-command-hook + '(org-speed-command-default-hook org-babel-speed-command-hook) + "Hook for activating speed commands at strategic locations. +Hook functions are called in sequence until a valid handler is +found. + +Each hook takes a single argument, a user-pressed command key +which is also a `self-insert-command' from the global map. + +Within the hook, examine the cursor position and the command key +and return nil or a valid handler as appropriate. Handler could +be one of an interactive command, a function, or a form. + +Set `org-use-speed-commands' to non-nil value to enable this +hook. The default setting is `org-speed-command-default-hook'." + :group 'org-structure + :type 'hook) + (defun org-self-insert-command (N) "Like `self-insert-command', use overwrite-mode for whitespace in tables. If the cursor is in a table looking at whitespace, the whitespace is @@ -15016,13 +16537,9 @@ overwritten, and the table is not marked as requiring realignment." (interactive "p") (cond ((and org-use-speed-commands - (or (and (bolp) (looking-at outline-regexp)) - (and (functionp org-use-speed-commands) - (funcall org-use-speed-commands))) - (setq - org-speed-command - (or (cdr (assoc (this-command-keys) org-speed-commands-user)) - (cdr (assoc (this-command-keys) org-speed-commands-default))))) + (setq org-speed-command + (run-hook-with-args-until-success + 'org-speed-command-hook (this-command-keys)))) (cond ((commandp org-speed-command) (setq this-command org-speed-command) @@ -15089,9 +16606,11 @@ because, in this case the deletion might narrow the column." (noalign (looking-at "[^|\n\r]* |")) (c org-table-may-need-update)) (backward-delete-char N) - (skip-chars-forward "^|") - (insert " ") - (goto-char (1- pos)) + (if (not overwrite-mode) + (progn + (skip-chars-forward "^|") + (insert " ") + (goto-char (1- pos)))) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. (if noalign (setq org-table-may-need-update c))) @@ -15178,8 +16697,9 @@ See `org-ctrl-c-ctrl-c-hook' for more information. This hook runs as the first action when TAB is pressed, even before `org-cycle' messes around with the `outline-regexp' to cater for inline tasks and plain list item folding. -If any function in this hook returns t, not other actions like table -field motion visibility cycling will be done.") +If any function in this hook returns t, any other actions that +would have been caused by TAB (such as table field motion or visibility +cycling) will not occur.") (defvar org-tab-after-check-for-table-hook nil "Hook for functions to attach themselves to TAB. @@ -15230,6 +16750,34 @@ See `org-ctrl-c-ctrl-c-hook' for more information.") (defvar org-metareturn-hook nil "Hook for functions attaching themselves to `M-RET'. See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftup-hook nil + "Hook for functions attaching themselves to `S-up'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftup-final-hook nil + "Hook for functions attaching themselves to `S-up'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftdown-hook nil + "Hook for functions attaching themselves to `S-down'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftdown-final-hook nil + "Hook for functions attaching themselves to `S-down'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftleft-hook nil + "Hook for functions attaching themselves to `S-left'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftleft-final-hook nil + "Hook for functions attaching themselves to `S-left'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftright-hook nil + "Hook for functions attaching themselves to `S-right'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftright-final-hook nil + "Hook for functions attaching themselves to `S-right'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") (defun org-modifier-cursor-error () "Throw an error, a modified cursor command was applied in wrong context." @@ -15270,7 +16818,7 @@ See the individual commands for more information." ((run-hook-with-args-until-success 'org-shiftmetaleft-hook)) ((org-at-table-p) (call-interactively 'org-table-delete-column)) ((org-on-heading-p) (call-interactively 'org-promote-subtree)) - ((org-at-item-p) (call-interactively 'org-outdent-item)) + ((org-at-item-p) (call-interactively 'org-outdent-item-tree)) (t (org-modifier-cursor-error)))) (defun org-shiftmetaright () @@ -15283,7 +16831,7 @@ See the individual commands for more information." ((run-hook-with-args-until-success 'org-shiftmetaright-hook)) ((org-at-table-p) (call-interactively 'org-table-insert-column)) ((org-on-heading-p) (call-interactively 'org-demote-subtree)) - ((org-at-item-p) (call-interactively 'org-indent-item)) + ((org-at-item-p) (call-interactively 'org-indent-item-tree)) (t (org-modifier-cursor-error)))) (defun org-shiftmetaup (&optional arg) @@ -15312,6 +16860,10 @@ commands for more information." ((org-at-item-p) (call-interactively 'org-move-item-down)) (t (org-modifier-cursor-error)))) +(defsubst org-hidden-tree-error () + (error + "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>")) + (defun org-metaleft (&optional arg) "Promote heading or move table column to left. Calls `org-do-promote' or `org-table-move-column', depending on context. @@ -15326,12 +16878,14 @@ See the individual commands for more information." (save-excursion (goto-char (region-beginning)) (org-on-heading-p)))) + (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) (call-interactively 'org-do-promote)) ((or (org-at-item-p) (and (org-region-active-p) (save-excursion (goto-char (region-beginning)) (org-at-item-p)))) + (when (org-check-for-hidden 'items) (org-hidden-tree-error)) (call-interactively 'org-outdent-item)) (t (call-interactively 'backward-word)))) @@ -15349,15 +16903,44 @@ See the individual commands for more information." (save-excursion (goto-char (region-beginning)) (org-on-heading-p)))) + (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) (call-interactively 'org-do-demote)) ((or (org-at-item-p) (and (org-region-active-p) (save-excursion (goto-char (region-beginning)) (org-at-item-p)))) + (when (org-check-for-hidden 'items) (org-hidden-tree-error)) (call-interactively 'org-indent-item)) (t (call-interactively 'forward-word)))) +(defun org-check-for-hidden (what) + "Check if there are hidden headlines/items in the current visual line. +WHAT can be either `headlines' or `items'. If the current line is +an outline or item heading and it has a folded subtree below it, +this function returns t, nil otherwise." + (let ((re (cond + ((eq what 'headlines) (concat "^" org-outline-regexp)) + ((eq what 'items) (concat "^" (org-item-re t))) + (t (error "This should not happen")))) + beg end) + (save-excursion + (catch 'exit + (unless (org-region-active-p) + (setq beg (point-at-bol)) + (beginning-of-line 2) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (beginning-of-line 2)) + (setq end (point)) + (goto-char beg) + (goto-char (point-at-eol)) + (setq end (max end (point))) + (while (re-search-forward re end t) + (if (get-char-property (match-beginning 0) 'invisible) + (throw 'exit t)))) + nil)))) + (defun org-metaup (&optional arg) "Move subtree up or move table row up. Calls `org-move-subtree-up' or `org-table-move-row' or @@ -15390,6 +16973,7 @@ Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', depending on context. See the individual commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftup-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'previous-line)) ((org-at-timestamp-p t) @@ -15402,6 +16986,7 @@ depending on context. See the individual commands for more information." ((and (not org-support-shift-select) (org-at-item-p)) (call-interactively 'org-previous-item)) ((org-clocktable-try-shift 'up arg)) + ((run-hook-with-args-until-success 'org-shiftup-final-hook)) (org-support-shift-select (org-call-for-shift-select 'previous-line)) (t (org-shiftselect-error)))) @@ -15412,6 +16997,7 @@ Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' depending on context. See the individual commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftdown-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'next-line)) ((org-at-timestamp-p t) @@ -15424,6 +17010,7 @@ depending on context. See the individual commands for more information." ((and (not org-support-shift-select) (org-at-item-p)) (call-interactively 'org-next-item)) ((org-clocktable-try-shift 'down arg)) + ((run-hook-with-args-until-success 'org-shiftdown-final-hook)) (org-support-shift-select (org-call-for-shift-select 'next-line)) (t (org-shiftselect-error)))) @@ -15439,6 +17026,7 @@ Depending on context, this does one of the following: - on a clocktable definition line, move time block into the future" (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftright-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'forward-char)) ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) @@ -15458,6 +17046,7 @@ Depending on context, this does one of the following: (org-at-property-p)) (call-interactively 'org-property-next-allowed-value)) ((org-clocktable-try-shift 'right arg)) + ((run-hook-with-args-until-success 'org-shiftright-final-hook)) (org-support-shift-select (org-call-for-shift-select 'forward-char)) (t (org-shiftselect-error)))) @@ -15473,6 +17062,7 @@ Depending on context, this does one of the following: - on a clocktable definition line, move time block into the past" (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftleft-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'backward-char)) ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) @@ -15492,6 +17082,7 @@ Depending on context, this does one of the following: (org-at-property-p)) (call-interactively 'org-property-previous-allowed-value)) ((org-clocktable-try-shift 'left arg)) + ((run-hook-with-args-until-success 'org-shiftleft-final-hook)) (org-support-shift-select (org-call-for-shift-select 'backward-char)) (t (org-shiftselect-error)))) @@ -15554,25 +17145,38 @@ See the individual commands for more information." (org-table-paste-rectangle) (org-paste-subtree arg))) -(defun org-edit-special () +(defun org-edit-special (&optional arg) "Call a special editor for the stuff at point. When at a table, call the formula editor with `org-table-edit-formulas'. When at the first line of an src example, call `org-edit-src-code'. When in an #+include line, visit the include file. Otherwise call `ffap' to visit the file at point." (interactive) - (cond - ((org-at-table-p) - (call-interactively 'org-table-edit-formulas)) + ;; possibly prep session before editing source + (when arg + (let* ((info (org-babel-get-src-block-info)) + (lang (nth 0 info)) + (params (nth 2 info)) + (session (cdr (assoc :session params)))) + (when (and info session) ;; we are in a source-code block with a session + (funcall + (intern (concat "org-babel-prep-session:" lang)) session params)))) + (cond ;; proceed with `org-edit-special' ((save-excursion (beginning-of-line 1) (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*<include\\>.*?file=\"\\)\\([^\"\n>]+\\)")) (find-file (org-trim (match-string 1)))) ((org-edit-src-code)) ((org-edit-fixed-width-region)) + ((org-at-table.el-p) + (org-edit-src-code)) + ((or (org-at-table-p) + (save-excursion + (beginning-of-line 1) + (looking-at "[ \t]*#\\+TBLFM:"))) + (call-interactively 'org-table-edit-formulas)) (t (call-interactively 'ffap)))) - (defun org-ctrl-c-ctrl-c (&optional arg) "Set tags in headline, or update according to changed information at point. @@ -15602,21 +17206,21 @@ This command does many different things, depending on context: - If the cursor is a the beginning of a dynamic block, update it. -- If the cursor is inside a table created by the table.el package, - activate that table. +- If the current buffer is a capture buffer, close note and file it. -- If the current buffer is a remember buffer, close note and file - it. A prefix argument of 1 files to the default location - without further interaction. A prefix argument of 2 files to - the currently clocking task. - -- If the cursor is on a <<<target>>>, update radio targets and corresponding - links in this buffer. +- If the cursor is on a <<<target>>>, update radio targets and + corresponding links in this buffer. - If the cursor is on a numbered item in a plain list, renumber the ordered list. -- If the cursor is on a checkbox, toggle it." +- If the cursor is on a checkbox, toggle it. + +- If the cursor is on a code block, evaluate it. The variable + `org-confirm-babel-evaluate' can be used to control prompting + before code block evaluation, by default every code block + evaluation requires confirmation. Code block evaluation can be + inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." (interactive "P") (let ((org-enable-table-editor t)) (cond @@ -15631,7 +17235,8 @@ This command does many different things, depending on context: (fboundp org-finish-function)) (funcall org-finish-function)) ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) - ((org-at-property-p) + ((or (looking-at org-property-start-re) + (org-at-property-p)) (call-interactively 'org-property-action)) ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) ((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]") @@ -15639,25 +17244,25 @@ This command does many different things, depending on context: (call-interactively 'org-update-statistics-cookies)) ((org-on-heading-p) (call-interactively 'org-set-tags)) ((org-at-table.el-p) - (require 'table) - (beginning-of-line 1) - (re-search-forward "|" (save-excursion (end-of-line 2) (point))) - (call-interactively 'table-recognize-table)) + (message "Use C-c ' to edit table.el tables")) ((org-at-table-p) (org-table-maybe-eval-formula) (if arg (call-interactively 'org-table-recalculate) (org-table-maybe-recalculate-line)) - (call-interactively 'org-table-align)) + (call-interactively 'org-table-align) + (orgtbl-send-table 'maybe)) ((or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) (call-interactively 'org-footnote-action)) ((org-at-item-checkbox-p) - (call-interactively 'org-toggle-checkbox)) + (call-interactively 'org-list-repair) + (call-interactively 'org-toggle-checkbox) + (org-list-send-list 'maybe)) ((org-at-item-p) - (if arg - (call-interactively 'org-toggle-checkbox) - (call-interactively 'org-maybe-renumber-ordered-list))) + (call-interactively 'org-list-repair) + (when arg (call-interactively 'org-toggle-checkbox)) + (org-list-send-list 'maybe)) ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) ;; Dynamic block (beginning-of-line 1) @@ -15674,9 +17279,9 @@ This command does many different things, depending on context: (if (org-at-table-p) (org-call-with-arg 'org-table-recalculate (or arg t))))) (t -; (org-set-regexps-and-options) -; (org-restart-font-lock) - (let ((org-inhibit-startup t)) (org-mode-restart)) + (let ((org-inhibit-startup-visibility-stuff t) + (org-startup-align-all-tables nil)) + (org-save-outline-visibility 'use-markers (org-mode-restart))) (message "Local setup has been refreshed")))) ((org-clock-update-time-maybe)) (t (error "C-c C-c can do nothing useful at this location"))))) @@ -15692,7 +17297,9 @@ Also updates the keyword regular expressions." "If this is a Note buffer, abort storing the note. Else call `show-branches'." (interactive) (if (not org-finish-function) - (call-interactively 'show-branches) + (progn + (hide-subtree) + (call-interactively 'show-branches)) (let ((org-note-abort t)) (funcall org-finish-function)))) @@ -15711,7 +17318,7 @@ See the individual commands for more information." (call-interactively 'org-open-at-point)) ((and (org-at-heading-p) (looking-at - (org-re "\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$"))) + (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))) (org-show-entry) (end-of-line 1) (newline)) @@ -15777,21 +17384,21 @@ If the first line is normal text, add an item bullet to each line." ;; We already have items, de-itemize (while (< (setq l (1+ l)) l2) (when (org-at-item-p) - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 2)) - (and (looking-at "[ \t]+") (replace-match ""))) + (skip-chars-forward " \t") + (delete-region (point) (match-end 0))) (beginning-of-line 2)) (if (org-on-heading-p) ;; Headings, convert to items (while (< (setq l (1+ l)) l2) (if (looking-at org-outline-regexp) - (replace-match "- " t t)) + (replace-match (org-list-bullet-string "-") t t)) (beginning-of-line 2)) ;; normal lines, turn them into items (while (< (setq l (1+ l)) l2) (unless (org-at-item-p) (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match "\\1- \\2"))) + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) (beginning-of-line 2))))))) (defun org-toggle-heading (&optional nstars) @@ -15987,7 +17594,7 @@ See the individual commands for more information." ["Previous link" org-previous-link t] "--" ["Descriptive Links" - (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) + (progn (add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) :style radio :selected (member '(org-link) buffer-invisibility-spec)] ["Literal Links" @@ -16001,11 +17608,11 @@ See the individual commands for more information." ("Select keyword" ["Next keyword" org-shiftright (org-on-heading-p)] ["Previous keyword" org-shiftleft (org-on-heading-p)] - ["Complete Keyword" org-complete (assq :todo-keyword (org-context))] + ["Complete Keyword" pcomplete (assq :todo-keyword (org-context))] ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))] ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]) - ["Show TODO Tree" org-show-todo-tree t] - ["Global TODO list" org-todo-list t] + ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"] + ["Global TODO list" org-todo-list :active t :keys "C-c a t"] "--" ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies) :selected org-enforce-todo-dependencies :style toggle :active t] @@ -16093,13 +17700,7 @@ See the individual commands for more information." (org-inside-LaTeX-fragment-p)] ["Insert citation" org-reftex-citation t] "--" - ["Export LaTeX fragments as images" - (if (featurep 'org-exp) - (setq org-export-with-LaTeX-fragments - (not org-export-with-LaTeX-fragments)) - (require 'org-exp)) - :style toggle :selected (and (boundp 'org-export-with-LaTeX-fragments) - org-export-with-LaTeX-fragments)]) + ["Template for BEAMER" org-insert-beamer-options-template t]) "--" ("MobileOrg" ["Push Files and Views" org-mobile-push t] @@ -16232,8 +17833,18 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (dir-org-contrib (ignore-errors (file-name-directory (org-find-library-name "org-contribdir")))) + (babel-files + (mapcar (lambda (el) (concat "ob" (when el (format "-%s" el)) ".el")) + (append (list nil "comint" "eval" "exp" "keys" + "lob" "ref" "table" "tangle") + (delq nil + (mapcar + (lambda (lang) + (when (cdr lang) (symbol-name (car lang)))) + org-babel-load-languages))))) (files (append (directory-files dir-org t file-re) + babel-files (and dir-org-contrib (directory-files dir-org-contrib t file-re)))) (remove-re (concat (if (featurep 'xemacs) @@ -16300,9 +17911,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions." "Display the given MESSAGE as a warning." (if (fboundp 'display-warning) (display-warning 'org message - (if (featurep 'xemacs) - 'warning - :warning)) + (if (featurep 'xemacs) 'warning :warning)) (let ((buf (get-buffer-create "*Org warnings*"))) (with-current-buffer buf (goto-char (point-max)) @@ -16316,6 +17925,13 @@ With prefix arg UNCOMPILED, load the uncompiled versions." "Is point in a line starting with `#'?" (equal (char-after (point-at-bol)) ?#)) +(defun org-in-indented-comment-line () + "Is point in a line starting with `#' after some white space?" + (save-excursion + (save-match-data + (goto-char (point-at-bol)) + (looking-at "[ \t]*#")))) + (defun org-in-verbatim-emphasis () (save-match-data (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~"))))) @@ -16377,6 +17993,23 @@ upon the next fontification round." (setq l (- l (get-text-property b 'org-dwidth-n s)))) l)) +(defun org-shorten-string (s maxlength) + "Shorten string S so tht it is no longer than MAXLENGTH characters. +If the string is shorter or has length MAXLENGTH, just return the +original string. If it is longer, the functions finds a space in the +string, breaks this string off at that locations and adds three dots +as ellipsis. Including the ellipsis, the string will not be longer +than MAXLENGTH. If finding a good breaking point in the string does +not work, the string is just chopped off in the middle of a word +if necessary." + (if (<= (length s) maxlength) + s + (let* ((n (max (- maxlength 4) 1)) + (re (concat "\\`\\(.\\{1," (int-to-string n) "\\}[^ ]\\)\\([ ]\\|\\'\\)"))) + (if (string-match re s) + (concat (match-string 1 s) "...") + (concat (substring s 0 (max (- maxlength 3) 0)) "..."))))) + (defun org-get-indentation (&optional line) "Get the indentation of the current line, interpreting tabs. When LINE is given, assume it represents a line and compute its indentation." @@ -16440,7 +18073,8 @@ N may optionally be the number of spaces to remove." (defun org-fill-template (template alist) "Find each %key of ALIST in TEMPLATE and replace it." - (let (entry key value) + (let ((case-fold-search nil) + entry key value) (setq alist (sort (copy-sequence alist) (lambda (a b) (< (length (car a)) (length (car b)))))) (while (setq entry (pop alist)) @@ -16622,11 +18256,11 @@ and :keyword." (mapcar (lambda (x) (if (memq x org-latex-fragment-image-overlays) x)) - (org-overlays-at (point)))))) + (overlays-at (point)))))) (push (list :latex-fragment - (org-overlay-start o) (org-overlay-end o)) clist) + (overlay-start o) (overlay-end o)) clist) (push (list :latex-preview - (org-overlay-start o) (org-overlay-end o)) clist)) + (overlay-start o) (overlay-end o)) clist)) ((org-inside-LaTeX-fragment-p) ;; FIXME: positions wrong. (push (list :latex-fragment (point) (point)) clist))) @@ -16664,6 +18298,24 @@ really on, so that the block visually is on the match." (throw 'exit t))) nil)))) +(defun org-in-regexps-block-p (start-re end-re &optional bound) + "Return t if the current point is between matches of START-RE and END-RE. +This will also return t if point is on one of the two matches or +in an unfinished block. END-RE can be a string or a form +returning a string. + +An optional third argument bounds the search for START-RE. It +defaults to previous heading or `point-min'." + (let ((pos (point)) + (limit (or bound (save-excursion (outline-previous-heading))))) + (save-excursion + ;; we're on a block when point is on start-re... + (or (org-at-regexp-p start-re) + ;; ... or start-re can be found above... + (and (re-search-backward start-re limit t) + ;; ... but no end-re between start-re and point. + (not (re-search-forward (eval end-re) pos t))))))) + (defun org-occur-in-agenda-files (regexp &optional nlines) "Call `multi-occur' with buffers for all agenda files." (interactive "sOrg-files matching: \np") @@ -16731,6 +18383,33 @@ for the search purpose." (setq list (delete (pop elts) list))) list) +(defun org-count (cl-item cl-seq) + "Count the number of occurrences of ITEM in SEQ. +Taken from `count' in cl-seq.el with all keyword arguments removed." + (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x) + (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) + (while (< cl-start cl-end) + (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start))) + (if (equal cl-item cl-x) (setq cl-count (1+ cl-count))) + (setq cl-start (1+ cl-start))) + cl-count)) + +(defun org-remove-if (predicate seq) + "Remove everything from SEQ that fulfills PREDICATE." + (let (res e) + (while seq + (setq e (pop seq)) + (if (not (funcall predicate e)) (push e res))) + (nreverse res))) + +(defun org-remove-if-not (predicate seq) + "Remove everything from SEQ that does not fulfill PREDICATE." + (let (res e) + (while seq + (setq e (pop seq)) + (if (funcall predicate e) (push e res))) + (nreverse res))) + (defun org-back-over-empty-lines () "Move backwards over whitespace, to the beginning of the first empty line. Returns the number of empty lines passed." @@ -16746,7 +18425,7 @@ Returns the number of empty lines passed." (defun org-point-in-group (point group &optional context) "Check if POINT is in match-group GROUP. If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the -match. If the match group does ot exist or point is not inside it, +match. If the match group does not exist or point is not inside it, return nil." (and (match-beginning group) (>= point (match-beginning group)) @@ -16757,7 +18436,8 @@ return nil." (defun org-switch-to-buffer-other-window (&rest args) "Switch to buffer in a second window on the current frame. -In particular, do not allow pop-up frames." +In particular, do not allow pop-up frames. +Returns the newly created buffer." (let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) (apply 'switch-to-buffer-other-window args))) @@ -16808,17 +18488,27 @@ TABLE is an association list with keys like \"%a\" and string values. The sequences in STRING may contain normal field width and padding information, for example \"%-5s\". Replacements happen in the sequence given by TABLE, so values can contain further %-escapes if they are define later in TABLE." - (let ((case-fold-search nil) - e re rpl) - (while (setq e (pop table)) + (let ((tbl (copy-alist table)) + (case-fold-search nil) + (pchg 0) + e re rpl) + (while (setq e (pop tbl)) (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) + (when (and (cdr e) (string-match re (cdr e))) + (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0))) + (safe "SREF")) + (add-text-properties 0 3 (list 'sref sref) safe) + (setcdr e (replace-match safe t t (cdr e))))) (while (string-match re string) - (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") - (cdr e))) - (setq string (replace-match rpl t t string)))) + (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") + (cdr e))) + (setq string (replace-match rpl t t string)))) + (while (setq pchg (next-property-change pchg string)) + (let ((sref (get-text-property pchg 'sref string))) + (when (and sref (string-match "SREF" string pchg)) + (setq string (replace-match sref t t string))))) string)) - (defun org-sublist (list start end) "Return a section of LIST, from START to END. Counting starts at 1." @@ -16890,76 +18580,123 @@ which make use of the date at the cursor." (message "Entry marked for action; press `k' at desired date in agenda or calendar")) +(defun org-mark-subtree () + "Mark the current subtree. +This puts point at the start of the current subtree, and mark at the end. + +If point is in an inline task, mark that task instead." + (interactive) + (let ((inline-task-p + (and (featurep 'org-inlinetask) + (org-inlinetask-in-task-p))) + (beg)) + ;; Get beginning of subtree + (cond + (inline-task-p (org-inlinetask-goto-beginning)) + ((org-at-heading-p) (beginning-of-line)) + (t (let ((outline-regexp (org-get-limited-outline-regexp))) + (outline-previous-visible-heading 1)))) + (setq beg (point)) + ;; Get end of it + (if inline-task-p + (org-inlinetask-goto-end) + (org-end-of-subtree)) + ;; Mark zone + (push-mark (point) nil t) + (goto-char beg))) + ;;; Paragraph filling stuff. ;; We want this to be just right, so use the full arsenal. (defun org-indent-line-function () - "Indent line like previous, but further if previous was headline or item." + "Indent line depending on context." (interactive) (let* ((pos (point)) (itemp (org-at-item-p)) (case-fold-search t) (org-drawer-regexp (or org-drawer-regexp "\000")) - column bpos bcol tpos tcol bullet btype bullet-type) - ;; Find the previous relevant line + (inline-task-p (and (featurep 'org-inlinetask) + (org-inlinetask-in-task-p))) + column bpos bcol tpos tcol) (beginning-of-line 1) (cond - ((looking-at "#") (setq column 0)) + ;; Comments + ((looking-at "# ") (setq column 0)) + ;; Headings ((looking-at "\\*+ ") (setq column 0)) + ;; Literal examples + ((looking-at "[ \t]*:[ \t]") + (setq column (org-get-indentation))) ; do nothing + ;; Drawers ((and (looking-at "[ \t]*:END:") (save-excursion (re-search-backward org-drawer-regexp nil t))) (save-excursion (goto-char (1- (match-beginning 1))) (setq column (current-column)))) - ((and (looking-at "[ \t]+#\\+end_\\([a-z]+\\)") + ;; Special blocks + ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") (save-excursion (re-search-backward (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) (setq column (org-get-indentation (match-string 0)))) + ((and (not (looking-at "[ \t]*#\\+begin_")) + (org-in-regexps-block-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) + (save-excursion + (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) + (setq column + (if (equal (downcase (match-string 1)) "src") + ;; src blocks: let `org-edit-src-exit' handle them + (org-get-indentation) + (org-get-indentation (match-string 0))))) + ;; Lists + ((org-in-item-p) + (org-beginning-of-item) + (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\(:?\\[@\\(:?start:\\)?[0-9]+\\][ \t]*\\)?\\[[- X]\\][ \t]*\\|.*? :: \\)?") + (setq bpos (match-beginning 1) tpos (match-end 0) + bcol (progn (goto-char bpos) (current-column)) + tcol (progn (goto-char tpos) (current-column))) + (if (> tcol (+ bcol org-description-max-indent)) + (setq tcol (+ bcol 5))) + (goto-char pos) + (setq column (if itemp (org-get-indentation) tcol))) + ;; This line has nothing special, look at the previous relevant + ;; line to compute indentation (t (beginning-of-line 0) - (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]") - (not (looking-at "[ \t]*:END:")) - (not (looking-at org-drawer-regexp))) - (beginning-of-line 0)) + (while (and (not (bobp)) + (not (looking-at org-drawer-regexp)) + ;; skip comments, verbatim, empty lines, tables, + ;; inline tasks, lists, drawers and blocks + (or (and (looking-at "[ \t]*:END:") + (re-search-backward org-drawer-regexp nil t)) + (and (looking-at "[ \t]*#\\+end_") + (re-search-backward "[ \t]*#\\+begin_"nil t)) + (looking-at "[ \t]*[\n:#|]") + (and (org-in-item-p) (goto-char (org-list-top-point))) + (and (not inline-task-p) + (featurep 'org-inlinetask) + (org-inlinetask-in-task-p) + (or (org-inlinetask-goto-beginning) t)))) + (beginning-of-line 0)) (cond + ;; There was an heading above. ((looking-at "\\*+[ \t]+") (if (not org-adapt-indentation) (setq column 0) (goto-char (match-end 0)) (setq column (current-column)))) + ;; A drawer had started and is unfinished ((looking-at org-drawer-regexp) - (goto-char (1- (match-beginning 1))) - (setq column (current-column))) - ((looking-at "\\([ \t]*\\):END:") - (goto-char (match-end 1)) - (setq column (current-column))) - ((org-in-item-p) - (org-beginning-of-item) - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column)) - bullet (match-string 1) - bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) - (if (> tcol (+ bcol org-description-max-indent)) - (setq tcol (+ bcol 5))) - (if (not itemp) - (setq column tcol) - (goto-char pos) - (beginning-of-line 1) - (if (looking-at "\\S-") - (progn - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") - (setq bullet (match-string 1) - btype (if (string-match "[0-9]" bullet) "n" bullet)) - (setq column (if (equal btype bullet-type) bcol tcol))) - (setq column (org-get-indentation))))) + (goto-char (1- (match-beginning 1))) + (setq column (current-column))) + ;; Else, nothing noticeable found: get indentation and go on. (t (setq column (org-get-indentation)))))) + ;; Now apply indentation and move cursor accordingly (goto-char pos) (if (<= (current-column) (current-indentation)) (org-indent-line-to column) (save-excursion (org-indent-line-to column))) + ;; Special polishing for properties, see `org-property-format' (setq column (current-column)) (beginning-of-line 1) (if (looking-at @@ -16970,6 +18707,12 @@ which make use of the date at the cursor." t t)) (org-move-to-column column))) +(defvar org-adaptive-fill-regexp-backup adaptive-fill-regexp + "Variable to store copy of `adaptive-fill-regexp'. +Since `adaptive-fill-regexp' is set to never match, we need to +store a backup of its value before entering `org-mode' so that +the functionality can be provided as a fall-back.") + (defun org-set-autofill-regexps () (interactive) ;; In the paragraph separator we include headlines, because filling @@ -17005,8 +18748,11 @@ which make use of the date at the cursor." ;; and fixed-width regions are not wrapped. That function will pass ;; through to `fill-paragraph' when appropriate. (org-set-local 'fill-paragraph-function 'org-fill-paragraph) - ; Adaptive filling: To get full control, first make sure that + ;; Adaptive filling: To get full control, first make sure that ;; `adaptive-fill-regexp' never matches. Then install our own matcher. + (unless (local-variable-p 'adaptive-fill-regexp (current-buffer)) + (org-set-local 'org-adaptive-fill-regexp-backup + adaptive-fill-regexp)) (org-set-local 'adaptive-fill-regexp "\000") (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) @@ -17035,8 +18781,11 @@ which make use of the date at the cursor." "Return a fill prefix for org-mode files. In particular, this makes sure hanging paragraphs for hand-formatted lists work correctly." - (cond ((looking-at "#[ \t]+") - (match-string 0)) + (cond + ;; Comment line + ((looking-at "#[ \t]+") + (match-string-no-properties 0)) + ;; Description list ((looking-at "[ \t]*\\([-*+] .*? :: \\)") (save-excursion (if (> (match-end 1) (+ (match-beginning 1) @@ -17044,11 +18793,14 @@ work correctly." (goto-char (+ (match-beginning 1) 5)) (goto-char (match-end 0))) (make-string (current-column) ?\ ))) - ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] ?\\)?") + ;; Ordered or unordered list + ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] ?\\)") (save-excursion (goto-char (match-end 0)) (make-string (current-column) ?\ ))) - (t nil))) + ;; Other text + ((looking-at org-adaptive-fill-regexp-backup) + (match-string-no-properties 0)))) ;;; Other stuff. @@ -17149,8 +18901,8 @@ beyond the end of the headline." (if (bobp) nil (backward-char 1) - (if (org-invisible-p) - (while (and (not (bobp)) (org-invisible-p)) + (if (org-truely-invisible-p) + (while (and (not (bobp)) (org-truely-invisible-p)) (backward-char 1) (beginning-of-line 1)) (forward-char 1)))) @@ -17198,7 +18950,7 @@ beyond the end of the headline." (t 'end-of-line))) (let ((pos (point))) (beginning-of-line 1) - (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\)?$")) + (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$")) (if (eq special t) (if (or (< pos (match-beginning 1)) (= pos (match-end 0))) @@ -17215,8 +18967,6 @@ beyond the end of the headline." (define-key org-mode-map "\C-a" 'org-beginning-of-line) (define-key org-mode-map "\C-e" 'org-end-of-line) -(define-key org-mode-map [home] 'org-beginning-of-line) -(define-key org-mode-map [end] 'org-end-of-line) (defun org-backward-sentence (&optional arg) "Go to beginning of sentence, or beginning of table field. @@ -17246,8 +18996,13 @@ depending on context." ((or (not org-special-ctrl-k) (bolp) (not (org-on-heading-p))) + (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible) + org-ctrl-k-protect-subtree) + (if (or (eq org-ctrl-k-protect-subtree 'error) + (not (y-or-n-p "Kill hidden subtree along with headline? "))) + (error "C-k aborted - would kill hidden subtree"))) (call-interactively 'kill-line)) - ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$")) + ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) (kill-region (point) (match-beginning 1)) (org-set-tags nil t)) (t (kill-region (point) (point-at-eol))))) @@ -17273,7 +19028,8 @@ org-yank-adjusted-subtrees *visible* surrounding headings. Any prefix to this command will cause `yank' to be called directly with -no special treatment. In particular, a simple `C-u' prefix will just +no special treatment. In particular, a simple \\[universal-argument] prefix \ +will just plainly yank the text as it is. \[1] The test checks if the first non-white line is a heading @@ -17363,6 +19119,17 @@ interactive command with similar behavior." (outline-invisible-p) (get-char-property (point) 'invisible))) +(defun org-truely-invisible-p () + "Check if point is at a character currently not visible. +This version does not only check the character property, but also +`visible-mode'." + ;; Early versions of noutline don't have `outline-invisible-p'. + (if (org-bound-and-true-p visible-mode) + nil + (if (fboundp 'outline-invisible-p) + (outline-invisible-p) + (get-char-property (point) 'invisible)))) + (defun org-invisible-p2 () "Check if point is at a character currently not visible." (save-excursion @@ -17379,6 +19146,13 @@ interactive command with similar behavior." (error (error "Before first headline at position %d in buffer %s" (point) (current-buffer))))) +(defun org-beginning-of-defun () + "Go to the beginning of the subtree, i.e. back to the heading." + (org-back-to-heading)) +(defun org-end-of-defun () + "Go to the end of the subtree." + (org-end-of-subtree nil t)) + (defun org-before-first-heading-p () "Before first heading?" (save-excursion @@ -17389,6 +19163,15 @@ interactive command with similar behavior." (defun org-at-heading-p (&optional ignored) (outline-on-heading-p t)) +(defun org-point-at-end-of-empty-headline () + "If point is at the end of an empty headline, return t, else nil. +If the heading only contains a TODO keyword, it is still still considered +empty." + (and (looking-at "[ \t]*$") + (save-excursion + (beginning-of-line 1) + (looking-at (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp + "\\)?[ \t]*$"))))) (defun org-at-heading-or-item-p () (or (org-on-heading-p) (org-at-item-p))) @@ -17463,6 +19246,18 @@ move point." (while (org-goto-sibling 'previous) (org-flag-heading nil)))) +(defun org-goto-first-child () + "Goto the first child, even if it is invisible. +Return t when a child was found. Otherwise don't move point and +return nil." + (let (level (pos (point)) (re (concat "^" outline-regexp))) + (when (condition-case nil (org-back-to-heading t) (error nil)) + (setq level (outline-level)) + (forward-char 1) + (if (and (re-search-forward re nil t) (> (outline-level) level)) + (progn (goto-char (match-beginning 0)) t) + (goto-char pos) nil)))) + (defun org-show-hidden-entry () "Show an entry where even the heading is hidden." (save-excursion @@ -17554,7 +19349,9 @@ If there is no such heading, return nil." (defun org-forward-same-level (arg &optional invisible-ok) "Move forward to the arg'th subheading at same level as this one. -Stop at the first and last subheadings of a superior heading." +Stop at the first and last subheadings of a superior heading. +Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil +it wil also look at invisible ones." (interactive "p") (org-back-to-heading invisible-ok) (org-on-heading-p) @@ -17567,7 +19364,7 @@ Stop at the first and last subheadings of a superior heading." (setq l (- (match-end 0) (match-beginning 0) 1)) (= l level) (not invisible-ok) - (org-invisible-p)) + (progn (backward-char 1) (org-invisible-p))) (if (< l level) (setq arg 1))) (setq arg (1- arg))) (beginning-of-line 1))) @@ -17714,11 +19511,11 @@ if no description is present" ;; Speedbar support -(defvar org-speedbar-restriction-lock-overlay (org-make-overlay 1 1) +(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1) "Overlay marking the agenda restriction line in speedbar.") -(org-overlay-put org-speedbar-restriction-lock-overlay +(overlay-put org-speedbar-restriction-lock-overlay 'face 'org-agenda-restriction-lock) -(org-overlay-put org-speedbar-restriction-lock-overlay +(overlay-put org-speedbar-restriction-lock-overlay 'help-echo "Agendas are currently limited to this item.") (org-detach-overlay org-speedbar-restriction-lock-overlay) @@ -17751,8 +19548,8 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (error "Cannot restrict to non-Org-mode file")) (org-agenda-set-restriction-lock 'file))) (t (error "Don't know how to restrict Org-mode's agenda"))) - (org-move-overlay org-speedbar-restriction-lock-overlay - (point-at-bol) (point-at-eol)) + (move-overlay org-speedbar-restriction-lock-overlay + (point-at-bol) (point-at-eol)) (setq current-prefix-arg nil) (org-agenda-maybe-redo))) @@ -17766,14 +19563,13 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (add-hook 'speedbar-visiting-tag-hook (lambda () (and (org-mode-p) (org-show-context 'org-goto)))))) - ;;; Fixes and Hacks for problems with other packages ;; Make flyspell not check words in links, to not mess up our keymap (defun org-mode-flyspell-verify () "Don't let flyspell put overlays at active buttons." - (and (not (get-text-property (point) 'keymap)) - (not (get-text-property (point) 'org-no-flyspell)))) + (and (not (get-text-property (max (1- (point)) (point-min)) 'keymap)) + (not (get-text-property (max (1- (point)) (point-min)) 'org-no-flyspell)))) (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region." @@ -17849,4 +19645,3 @@ Still experimental, may disappear in the future." ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here - |