diff options
| author | Carsten Dominik <carsten.dominik@gmail.com> | 2010-12-11 17:42:53 +0100 |
|---|---|---|
| committer | Carsten Dominik <carsten.dominik@gmail.com> | 2010-12-11 17:42:53 +0100 |
| commit | acedf35ce08b9df4a0dcbcd1413e7d85f1182034 (patch) | |
| tree | 240e26f10d2feb66e8c0cd0634082fcb7bd577e5 /lisp/org | |
| parent | 39321b94bfa4e50401e30caedfd09a06629f5bd2 (diff) | |
Update to Org mode 7.4
Diffstat (limited to 'lisp/org')
97 files changed, 3133 insertions, 1562 deletions
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 29295d67d17..2973ff4b579 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,684 @@ +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. + + * 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 David Maus <dmaus@ictsoc.de> + + * test-org.el (test-org/org-link-escape-url-with-escaped-char): Add + test for escaping and unescaping url with already escaped char. + +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): Fixed 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 David Maus <dmaus@ictsoc.de> + + * org-test.el (org-test-current-file): New function. Run all tests + for current file. + +2010-12-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-parse-header-arguments): Removed addition of + ":" to singleton first header arguments as it was leading to errors. + +2010-12-11 David Maus <dmaus@ictsoc.de> + + * test-org.el (test-org/org-link-escape-ascii-character) + (test-org/org-link-escape-ascii-ctrl-character) + (test-org/org-link-escape-multibyte-character) + (test-org/org-link-escape-custom-table) + (test-org/org-link-escape-custom-table-merge) + (test-org/org-link-unescape-ascii-character) + (test-org/org-link-unescape-ascii-ctrl-character) + (test-org/org-link-unescape-multibyte-character) + (test-org/org-link-unescape-ascii-extended-char): New tests for + unicode aware percent escaping. + +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): Moved 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): Renamed 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> + + * list/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 David Maus <dmaus@ictsoc.de> + + * org-test.el (org-test-current-defun): `which-function' does not + return a list, but the name of the function. + +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 diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index 1c8eac65ace..da0e76894f1 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index 81d628e4206..1f4fd87b0a3 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -2,11 +2,10 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Eric Schulte -;; Dan Davison +;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research, R, statistics ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -277,16 +276,18 @@ last statement in BODY, as elisp." (butlast (delq nil (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)))) 2) "\n")))) + (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. diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el index 43d65462612..ab2abda28d8 100644 --- a/lisp/org/ob-asymptote.el +++ b/lisp/org/ob-asymptote.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el index 426aafd154f..287bad31a29 100644 --- a/lisp/org/ob-calc.el +++ b/lisp/org/ob-calc.el @@ -1,11 +1,11 @@ ;;; ob-calc.el --- org-babel functions for calc code evaluation -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation, Inc ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -40,25 +40,55 @@ (defun org-babel-execute:calc (body params) "Execute a block of calc code with Babel." - (mapcar - (lambda (line) - (when (> (length line) 0) - (if (string= "'" (substring line 0 1)) - (funcall (lookup-key calc-mode-map (substring line 1)) nil) - (calc-push-list - (list ((lambda (res) - (cond - ((numberp res) res) - ((listp res) (error "calc error \"%s\" on input \"%s\"" - (cadr res) line)) - (t res)) - (if (numberp res) res (math-read-number res))) - (calc-eval line))))))) - (mapcar #'org-babel-trim - (split-string (org-babel-expand-body:calc body params) "[\n\r]"))) + (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 - (set-buffer (get-buffer "*Calculator*")) - (calc-eval (calc-top 1)))) + (with-current-buffer (get-buffer "*Calculator*") + (calc-eval (calc-top 1))))) (provide 'ob-calc) diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index 0a76e827125..d88c54b6dbe 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -2,10 +2,10 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Joel Boehland +;; Author: Joel Boehland, Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -24,14 +24,14 @@ ;;; Commentary: -;;; ob support for evaluating clojure code +;;; support for evaluating clojure code, relies on slime for all eval ;;; Requirements: -;;; A working clojure install. This also implies a working java executable -;;; clojure-mode -;;; slime -;;; swank-clojure +;;; - 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 @@ -39,277 +39,47 @@ ;;; Code: (require 'ob) -(require 'ob-eval) -(eval-when-compile (require 'cl)) -(declare-function slime-eval-async "ext:slime" (sexp &optional cont package)) (declare-function slime-eval "ext:slime" (sexp &optional package)) -(declare-function swank-clojure-concat-paths "ext:slime" (paths)) -(declare-function slime "ext:slime" (&optional command coding-system)) -(declare-function slime-output-buffer "ext:slime" (&optional noprompt)) -(declare-function slime-filter-buffers "ext:slime" (predicate)) (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) (defvar org-babel-default-header-args:clojure '()) - -(defvar org-babel-clojure-wrapper-method - " -(defn spit - [f content] - (with-open [#^java.io.PrintWriter w - (java.io.PrintWriter. - (java.io.BufferedWriter. - (java.io.OutputStreamWriter. - (java.io.FileOutputStream. - (java.io.File. f)))))] - (.print w content))) - -(defn main - [] - %s) - -(spit \"%s\" (str (main)))") -;;";; <-- syntax highlighting is messed without this double quote - -;;taken mostly from clojure-test-mode.el -(defun org-babel-clojure-clojure-slime-eval (string &optional handler) - "Evaluate a STRING of clojure code using `slime-eval-async'." - (slime-eval-async `(swank:eval-and-grab-output ,string) - (or handler #'identity))) - -(defun org-babel-clojure-slime-eval-sync (string) - "Evaluate a STRING of clojure code using `slime-eval'." - (slime-eval `(swank:eval-and-grab-output ,string))) - -;;taken from swank-clojure.el -(defvar swank-clojure-binary) -(defvar swank-clojure-classpath) -(defvar swank-clojure-java-path) -(defvar swank-clojure-extra-vm-args) -(defvar swank-clojure-library-paths) -(defvar swank-clojure-extra-classpaths) -(defun org-babel-clojure-babel-clojure-cmd () - "Create the command to start clojure according to current settings." - (or (when swank-clojure-binary - (if (listp swank-clojure-binary) - swank-clojure-binary - (list swank-clojure-binary))) - (when swank-clojure-classpath - (delq - nil - (append - (list swank-clojure-java-path) - swank-clojure-extra-vm-args - (list - (when swank-clojure-library-paths - (concat "-Djava.library.path=" - (swank-clojure-concat-paths swank-clojure-library-paths))) - "-classpath" - (swank-clojure-concat-paths - (append - swank-clojure-classpath - swank-clojure-extra-classpaths)) - "clojure.main")))) - (error "%s" (concat "You must specifiy either a `swank-clojure-binary' " - "or a `swank-clojure-classpath'")))) - -(defun org-babel-clojure-table-or-string (results) - "Convert RESULTS to an elisp value. -If RESULTS looks like a table, then convert to an Emacs-lisp -table, otherwise return the results as a string." - (org-babel-read - (if (string-match "^\\[.+\\]$" results) - (org-babel-read - (concat "'" - (replace-regexp-in-string - "\\[" "(" (replace-regexp-in-string - "\\]" ")" (replace-regexp-in-string - ", " " " (replace-regexp-in-string - "'" "\"" results)))))) - results))) - -(defun org-babel-clojure-var-to-clojure (var) - "Convert an elisp value into a clojure variable. -The elisp value VAR is converted into a string of clojure source -code specifying a variable of the same value." - (if (listp var) - (format "'%s" var) - (format "%S" var))) - -(defun org-babel-clojure-build-full-form (body vars) - "Construct a clojure let form with VARS as the let variables." - (let ((vars-forms - (mapconcat ;; define any variables - (lambda (pair) - (format "%s %s" - (car pair) (org-babel-clojure-var-to-clojure (cdr pair)))) - vars "\n ")) - (body (org-babel-trim body))) - (if (> (length vars-forms) 0) - (format "(let [%s]\n %s)" vars-forms body) - body))) - -(defun org-babel-prep-session:clojure (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (require 'slime) (require 'swank-clojure) - (let* ((session-buf (org-babel-clojure-initiate-session session)) - (vars (mapcar #'cdr (org-babel-get-header params :var))) - (var-lines (mapcar ;; define any top level session variables - (lambda (pair) - (format "(def %s %s)\n" (car pair) - (org-babel-clojure-var-to-clojure (cdr pair)))) - vars))) - session-buf)) - -(defun org-babel-load-session:clojure (session body params) - "Load BODY into SESSION." - (require 'slime) (require 'swank-clojure) - (save-window-excursion - (let ((buffer (org-babel-prep-session:clojure session params))) - (with-current-buffer buffer - (goto-char (point-max)) - (insert (org-babel-chomp body))) - buffer))) - -(defvar org-babel-clojure-buffers '()) -(defvar org-babel-clojure-pending-sessions '()) - -(defun org-babel-clojure-session-buffer (session) - "Return the buffer associated with SESSION." - (cdr (assoc session org-babel-clojure-buffers))) - -(defun org-babel-clojure-initiate-session-by-key (&optional session) - "Initiate a clojure session in an inferior-process-buffer. -If there is not a current inferior-process-buffer in SESSION -then create one. Return the initialized session." - (save-window-excursion - (let* ((session (if session - (if (stringp session) (intern session) - session) - :default)) - (clojure-buffer (org-babel-clojure-session-buffer session))) - (unless (and clojure-buffer (buffer-live-p clojure-buffer)) - (setq org-babel-clojure-buffers - (assq-delete-all session org-babel-clojure-buffers)) - (push session org-babel-clojure-pending-sessions) - (slime) - ;; we are waiting to finish setting up which will be done in - ;; org-babel-clojure-session-connected-hook below. - (let ((timeout 9)) - (while (and (not (org-babel-clojure-session-buffer session)) - (< 0 timeout)) - (message "Waiting for clojure repl for session: %s ... %i" - session timeout) - (sit-for 1) - (decf timeout))) - (setq org-babel-clojure-pending-sessions - (remove session org-babel-clojure-pending-sessions)) - (unless (org-babel-clojure-session-buffer session) - (error "Couldn't create slime clojure process")) - (setq clojure-buffer (org-babel-clojure-session-buffer session))) - session))) - -(defun org-babel-clojure-initiate-session (&optional session params) - "Return the slime-clojure repl buffer bound to SESSION. -Returns nil if \"none\" is specified." - (require 'slime) (require 'swank-clojure) - (unless (and (stringp session) (string= session "none")) - (org-babel-clojure-session-buffer - (org-babel-clojure-initiate-session-by-key session)))) - -(defun org-babel-clojure-session-connected-hook () - "Finish binding an org-babel session to a slime-clojure repl." - (let ((pending-session (pop org-babel-clojure-pending-sessions))) - (when pending-session - (save-excursion - (switch-to-buffer (slime-output-buffer)) - (rename-buffer - (if (stringp pending-session) - pending-session (symbol-name pending-session))) - (org-babel-clojure-bind-session-to-repl-buffer - pending-session (slime-output-buffer)))))) - -(add-hook 'slime-connected-hook 'org-babel-clojure-session-connected-hook) - -(defun org-babel-clojure-bind-session-to-repl-buffer (session repl-buffer) - "Associate SESSION with REPL-BUFFER." - (when (stringp session) (setq session (intern session))) - (setq org-babel-clojure-buffers - (cons (cons session repl-buffer) - (assq-delete-all session org-babel-clojure-buffers)))) - -(defun org-babel-clojure-repl-buffer-pred () - "Test whether the current buffer is an active slime-clojure -repl buffer." - (and (buffer-live-p (current-buffer)) (eq major-mode 'slime-repl-mode))) - -(defun org-babel-clojure-bind-session-to-repl (session) - "Bind SESSION to a clojure repl." - (interactive "sEnter session name: ") - (let ((repl-bufs (slime-filter-buffers 'org-babel-clojure-repl-buffer-pred))) - (unless repl-bufs (error "No existing slime-clojure repl buffers exist")) - (let ((repl-buf (read-buffer "Choose slime-clojure repl: " repl-bufs t))) - (org-babel-clojure-bind-session-to-repl-buffer session repl-buf)))) - -(defun org-babel-clojure-evaluate-external-process - (buffer body &optional result-type) - "Evaluate the body in an external process." - (let ((cmd (format "%s -" (mapconcat #'identity - (org-babel-clojure-babel-clojure-cmd) - " ")))) - (case result-type - (output (org-babel-eval cmd body)) - (value (let* ((tmp-file (org-babel-temp-file "clojure-"))) - (org-babel-eval - cmd - (format - org-babel-clojure-wrapper-method - body - (org-babel-process-file-name tmp-file 'noquote))) - (org-babel-clojure-table-or-string - (org-babel-eval-read-file tmp-file))))))) - -(defun org-babel-clojure-evaluate-session (buffer body &optional result-type) - "Evaluate the body in the context of a clojure session." - (require 'slime) (require 'swank-clojure) - (let ((raw nil) - (results nil)) - (with-current-buffer buffer - (setq raw (org-babel-clojure-slime-eval-sync body)) - (setq results (reverse (mapcar #'org-babel-trim raw))) - (cond - ((equal result-type 'output) - (mapconcat #'identity (reverse (cdr results)) "\n")) - ((equal result-type 'value) - (org-babel-clojure-table-or-string (car results))))))) - -(defun org-babel-clojure-evaluate (buffer body &optional result-type) - "Pass BODY to the Clojure process in BUFFER. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then -return the value of the last statement in BODY as elisp." - (if buffer - (org-babel-clojure-evaluate-session buffer body result-type) - (org-babel-clojure-evaluate-external-process buffer body result-type))) +(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." - (org-babel-clojure-build-full-form - body (mapcar #'cdr (org-babel-get-header params :var)))) + (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." + "Execute a block of Clojure code with Babel." (require 'slime) (require 'swank-clojure) - (let* ((body (org-babel-expand-body:clojure body params)) - (session (org-babel-clojure-initiate-session - (cdr (assoc :session params))))) - (org-babel-reassemble-table - (org-babel-clojure-evaluate session body (cdr (assoc :result-type 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)))))) + (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) diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index d05b7fbfa40..064aad539c2 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, comint ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el index d93f28dcebc..48ea9e3f937 100644 --- a/lisp/org/ob-css.el +++ b/lisp/org/ob-css.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el index a9b6b3ceaf1..097f938e92d 100644 --- a/lisp/org/ob-ditaa.el +++ b/lisp/org/ob-ditaa.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el index c78f3dbee0d..36baddb1cd3 100644 --- a/lisp/org/ob-dot.el +++ b/lisp/org/ob-dot.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index f1d41b3db0d..df6f505ffea 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -1,11 +1,11 @@ ;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el index 57f4dc509aa..a71cb0dd691 100644 --- a/lisp/org/ob-eval.el +++ b/lisp/org/ob-eval.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, comint ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -28,12 +28,13 @@ ;; shell commands. ;;; Code: -(require 'ob) (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 Output*"))) + (let ((buf (get-buffer-create org-babel-error-buffer-name))) (with-current-buffer buf (goto-char (point-max)) (save-excursion (insert stderr))) @@ -44,7 +45,7 @@ "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) + (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code) (with-current-buffer err-buff (erase-buffer)) (with-temp-buffer (insert body) @@ -138,9 +139,9 @@ specifies the value of ERROR-BUFFER." (if error-buffer (make-temp-file (expand-file-name "scor" - (or (unless (featurep 'xemacs) - small-temporary-file-directory) - temporary-file-directory))) + (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory))) nil)) exit-status) (if (or replace @@ -247,6 +248,13 @@ specifies the value of ERROR-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 diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 52da00103f6..8b6914c903c 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -39,8 +39,7 @@ (defvar org-babel-lob-one-liner-regexp) (defvar org-babel-ref-split-regexp) (declare-function org-babel-lob-get-info "ob-lob" ()) -(declare-function org-babel-ref-literal "ob-ref" (ref)) - +(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) @@ -289,6 +288,7 @@ inhibit insertion of results into the buffer." (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")))) diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index 053d154610b..423e47e8669 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index 1ae8fba66b6..734e1f6c891 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -136,16 +136,7 @@ then create one. Return the initialized session." "Convert RESULTS to an Emacs-lisp table or string. If RESULTS look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." - (org-babel-read - (if (and (stringp results) (string-match "^\\[.+\\]$" results)) - (org-babel-read - (concat "'" - (replace-regexp-in-string - "\\[" "(" (replace-regexp-in-string - "\\]" ")" (replace-regexp-in-string - "," " " (replace-regexp-in-string - "'" "\"" results)))))) - results))) + (org-babel-script-escape results)) (defun org-babel-haskell-var-to-haskell (var) "Convert an elisp value VAR into a haskell variable. diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index dc652a95c96..05f8ea41754 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -1,26 +1,28 @@ ;;; ob-js.el --- org-babel functions for Javascript -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, js ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 -;; This file is part of GNU Emacs. +;;; License: -;; GNU Emacs is free software: you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. - +;; ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;; 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: @@ -33,7 +35,7 @@ ;; - 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 diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el index e04d9ade6bc..af8190692cd 100644 --- a/lisp/org/ob-keys.el +++ b/lisp/org/ob-keys.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el index f4cf0802de6..96afbcd92a6 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el index 33ec9d3a898..a02eb6fec86 100644 --- a/lisp/org/ob-ledger.el +++ b/lisp/org/ob-ledger.el @@ -5,7 +5,7 @@ ;; Author: Eric S Fraga ;; Keywords: literate programming, reproducible research, accounting ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index 3f9ac673279..600b79ee7af 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -1,27 +1,28 @@ ;;; ob-lisp.el --- org-babel functions for Common Lisp -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation -;; Author: David T. O'Toole <dto@gnu.org> -;; Eric Schulte +;; Author: David T. O'Toole <dto@gnu.org>, Eric Schulte ;; Keywords: literate programming, reproducible research, lisp ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 -;; This file is part of GNU Emacs. +;;; License: -;; GNU Emacs is free software: you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. - +;; ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;; 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: @@ -40,16 +41,18 @@ (require 'ob-ref) (require 'ob-comint) (require 'ob-eval) -(declare-function slime-eval "ext:slime" (form)) + +(declare-function slime-eval "ext:slime" (sexp &optional package)) +(declare-function slime-process "ext:slime" (&optional connection)) (declare-function slime-connected-p "ext:slime" ()) -(declare-function slime-process "ext:slime" ()) -(require 'slime nil 'noerror) (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.") + "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." @@ -65,6 +68,7 @@ (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)))) @@ -96,6 +100,7 @@ This function is called by `org-babel-execute-src-block'" (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) diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index 243666c0a1b..137a6bce9a3 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -2,11 +2,10 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Eric Schulte -;; Dan Davison +;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -26,7 +25,7 @@ ;;; Commentary: ;; See the online documentation for more information -;; +;; ;; http://orgmode.org/worg/org-contrib/babel/ ;;; Code: @@ -72,7 +71,8 @@ If you change the value of this variable then your files may (concat "^\\([ \t]*\\)#\\+\\(?:" (mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|") - "\\):[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\([^\n]*\\)") + "\\):[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)" + "\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\([^\n]*\\)") "Regexp to match calls to predefined source block functions.") ;; functions for executing lob one-liners @@ -93,13 +93,16 @@ if so then run the appropriate source block from the Library." (beginning-of-line 1) (if (looking-at org-babel-lob-one-liner-regexp) (append - (mapcar #'org-babel-clean-text-properties + (mapcar #'org-babel-clean-text-properties (list - (format "%s(%s)%s" - (match-string 2) (match-string 3) (match-string 4)) - (match-string 5))) + (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 diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el index c75d806cc62..192c73d9081 100644 --- a/lisp/org/ob-matlab.el +++ b/lisp/org/ob-matlab.el @@ -5,7 +5,7 @@ ;; Author: Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el index 119d28cfba0..98230da56a3 100644 --- a/lisp/org/ob-mscgen.el +++ b/lisp/org/ob-mscgen.el @@ -5,7 +5,7 @@ ;; Author: Juan Pechiar ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el index 2217118e537..459dcf336f7 100644 --- a/lisp/org/ob-ocaml.el +++ b/lisp/org/ob-ocaml.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index d6affecd74d..9fcd825f91e 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -5,7 +5,7 @@ ;; Author: Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el index 86abbabfb13..c03fa07602a 100644 --- a/lisp/org/ob-org.el +++ b/lisp/org/ob-org.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el index 23c0353fcb0..1e0cecb1af0 100644 --- a/lisp/org/ob-perl.el +++ b/lisp/org/ob-perl.el @@ -1,12 +1,11 @@ ;;; ob-perl.el --- org-babel functions for perl evaluation -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation -;; Author: Dan Davison -;; Eric Schulte +;; Author: Dan Davison, Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el index 37561020cb0..fb81dc8e60d 100644 --- a/lisp/org/ob-plantuml.el +++ b/lisp/org/ob-plantuml.el @@ -5,7 +5,7 @@ ;; Author: Zhang Weize ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index 22cb5337d7a..27b69bff5ab 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -1,12 +1,11 @@ ;;; ob-python.el --- org-babel functions for python evaluation -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation -;; Author: Eric Schulte -;; Dan Davison +;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -57,11 +56,15 @@ This function is called by `org-babel-execute-src-block'." (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 - body params (org-babel-variable-assignments:python params))) + (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))) + session full-body result-type result-params preamble))) (or (cdr (assoc :file params)) (org-babel-reassemble-table result @@ -118,20 +121,7 @@ specifying a variable of the same value." "Convert RESULTS into an appropriate elisp value. If the results look like a list or tuple, then convert them into an Emacs-lisp table, otherwise return the results as a string." - ((lambda (res) - (if (listp res) - (mapcar (lambda (el) (if (equal el 'None) 'hline el)) res) - res)) - (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 t)))))) - results)))) + (org-babel-script-escape results)) (defvar org-babel-python-buffers '((:default . nil))) @@ -192,35 +182,38 @@ def main(): open('%s', 'w').write( pprint.pformat(main()) )") (defun org-babel-python-evaluate - (session body &optional result-type result-params) + (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))) + body result-type result-params preamble))) (defun org-babel-python-evaluate-external-process - (body &optional result-type result-params) + (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 body)) + (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 - (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))) + (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)) @@ -240,7 +233,7 @@ last statement in BODY, as elisp." (lambda (statement) (insert statement) (comint-send-input)) (if pp (list - "import pp" + "import pprint" (format "open('%s', 'w').write(pprint.pformat(_))" (org-babel-process-file-name tmp-file 'noquote))) (list (format "open('%s', 'w').write(str(_))" diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index e104d6bd693..2ca99ca651c 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -2,11 +2,10 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Eric Schulte -;; Dan Davison +;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -52,11 +51,13 @@ ;;; 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]*") @@ -74,46 +75,39 @@ the variable." (let ((var (match-string 1 assignment)) (ref (match-string 2 assignment))) (cons (intern var) - ((lambda (val) - (if (equal :ob-must-be-reference val) - (org-babel-ref-resolve ref) val)) - (org-babel-ref-literal ref)))))) - -(defun org-babel-ref-literal (ref) - "Return the value of REF if it is a literal value. -Determine if the right side of a header argument variable -assignment is a literal value or is a reference to some external -resource. REF should be a string of the right hand side of the -assignment. If REF is literal then return it's value, otherwise -return nil." - (let ((out (org-babel-read ref))) - (if (equal out ref) - (if (string-match "^\".+\"$" ref) - (read ref) - :ob-must-be-reference) - out))) + (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-referent result lob-info split-file split-ref - index index-row index-col) + 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) + (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) (let ((str (substring ref 0 (match-beginning 0)))) (= (org-count ?( str) (org-count ?) str)))) (setq index (match-string 1 ref)) (setq ref (substring ref 0 (match-beginning 0)))) ;; assign any arguments to pass to source block - (when (string-match "^\\(.+?\\)\(\\(.*\\)\)$" ref) - (setq new-refere (match-string 1 ref)) - (setq new-referent (match-string 2 ref)) + (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) - (if (> (length new-referent) 0) - (setq args (mapcar (lambda (ref) (cons :var ref)) - (org-babel-ref-split-args new-referent)))) + (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)) @@ -155,6 +149,7 @@ return nil." (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))))) @@ -222,6 +217,7 @@ to \"0:-1\"." 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))) diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index 70b46411086..3f2af394603 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -1,11 +1,11 @@ ;;; ob-ruby.el --- org-babel functions for ruby evaluation -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -29,10 +29,10 @@ ;;; 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 @@ -116,16 +116,7 @@ specifying a variable of the same value." "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))) + (org-babel-script-escape results)) (defun org-babel-ruby-initiate-session (&optional session params) "Initiate a ruby session. diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el index 7f241e0320d..b3acc8b8d2c 100644 --- a/lisp/org/ob-sass.el +++ b/lisp/org/ob-sass.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el index c0e0a3fb6f9..b2b9fa6a01d 100644 --- a/lisp/org/ob-scheme.el +++ b/lisp/org/ob-scheme.el @@ -1,26 +1,28 @@ ;;; ob-scheme.el --- org-babel functions for Scheme -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, scheme ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 -;; This file is part of GNU Emacs. +;;; License: -;; GNU Emacs is free software: you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. - +;; ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;; 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: @@ -33,7 +35,7 @@ ;; - 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 diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index 206e51b19fe..7f4af795499 100644 --- a/lisp/org/ob-screen.el +++ b/lisp/org/ob-screen.el @@ -1,11 +1,11 @@ ;;; ob-screen.el --- org-babel support for interactive terminal -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation ;; Author: Benjamin Andresen ;; Keywords: literate programming, interactive shell ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el index e86386426cd..e153d68b575 100644 --- a/lisp/org/ob-sh.el +++ b/lisp/org/ob-sh.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -100,7 +100,7 @@ var of the same value." (if (listp el) (mapcar #'deep-string el) (org-babel-sh-var-to-sh el sep)))) - (format "$(cat <<BABEL_TABLE\n%s\nBABEL_TABLE\n)" + (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"))))) @@ -114,16 +114,7 @@ var of the same value." "Convert RESULTS to an appropriate elisp value. If the results look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." - (org-babel-read - (if (string-match "^\\[.+\\]$" results) - (org-babel-read - (concat "'" - (replace-regexp-in-string - "\\[" "(" (replace-regexp-in-string - "\\]" ")" (replace-regexp-in-string - ", " " " (replace-regexp-in-string - "'" "\"" results)))))) - results))) + (org-babel-script-escape results)) (defun org-babel-sh-initiate-session (&optional session params) "Initiate a session named SESSION according to PARAMS." diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 78e8a3b4377..5bb123d631b 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -47,9 +47,15 @@ (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'." @@ -60,6 +66,10 @@ This function is called by `org-babel-execute-src-block'." (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) @@ -70,11 +80,11 @@ This function is called by `org-babel-execute-src-block'." (or cmdline ""))) (t (error "no support for the %s sql engine" engine))))) (with-temp-file in-file - (insert (org-babel-expand-body:generic body params))) + (insert (org-babel-expand-body:sql body params))) (message command) (shell-command command) (with-temp-buffer - (org-table-import out-file nil) + (org-table-import out-file '(16)) (org-babel-reassemble-table (org-table-to-lisp) (org-babel-pick-name (cdr (assoc :colname-names params)) @@ -82,6 +92,28 @@ This function is called by `org-babel-execute-src-block'." (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." diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el index d1fa9ac4c5f..65e8091741f 100644 --- a/lisp/org/ob-sqlite.el +++ b/lisp/org/ob-sqlite.el @@ -1,11 +1,11 @@ ;;; ob-sqlite.el --- org-babel functions for sqlite database interaction -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -28,6 +28,7 @@ ;;; Code: (require 'ob) +(require 'ob-eval) (require 'ob-ref) (declare-function org-fill-template "org" (template alist)) @@ -52,7 +53,6 @@ "Execute a block of Sqlite code with Babel. This function is called by `org-babel-execute-src-block'." (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (vars (org-babel-get-header params :var)) (db (cdr (assoc :db params))) (separator (cdr (assoc :separator params))) (nullvalue (cdr (assoc :nullvalue params))) @@ -65,15 +65,10 @@ This function is called by `org-babel-execute-src-block'." (unless db (error "ob-sqlite: can't evaluate without a database.")) (with-temp-buffer (insert - (shell-command-to-string + (org-babel-eval (org-fill-template - "%cmd -init %body %header %separator %nullvalue %others %csv %db " + "%cmd %header %separator %nullvalue %others %csv %db " (list - (cons "body" ((lambda (sql-file) - (with-temp-file sql-file - (insert (org-babel-expand-body:sqlite body params))) - sql-file) - (org-babel-temp-file "sqlite-sql-"))) (cons "cmd" org-babel-sqlite3-command) (cons "header" (if headers-p "-header" "-noheader")) (cons "separator" @@ -90,7 +85,9 @@ This function is called by `org-babel-execute-src-block'." (member :html others) separator) "" "-csv")) - (cons "db " db))))) + (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) diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el index cdc7a6250fe..b7f9673c676 100644 --- a/lisp/org/ob-table.el +++ b/lisp/org/ob-table.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -57,9 +57,9 @@ "Replace newline character with ellipses. If STRING ends in a newline character, then remove the newline character and replace it with ellipses." - (if (and (stringp string) (string-match "[\n\r]" string)) - (concat (substring string 0 (match-beginning 0)) "...") - string)) + (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. diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index e197ff37d36..c5ef2a1fcea 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -125,6 +125,7 @@ evaluating BODY." 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) diff --git a/lisp/org/ob.el b/lisp/org/ob.el index fe068de549f..1c9f9fdbc12 100644 --- a/lisp/org/ob.el +++ b/lisp/org/ob.el @@ -2,11 +2,10 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Eric Schulte -;; Dan Davison +;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -31,7 +30,9 @@ ;;; Code: (eval-when-compile + (require 'org-list) (require 'cl)) +(require 'ob-eval) (require 'org-macs) (defvar org-babel-call-process-region-original) @@ -43,7 +44,7 @@ (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" +(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)) @@ -73,6 +74,10 @@ (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." @@ -213,9 +218,13 @@ of potentially harmful code." (if (or (equal eval "never") (equal eval "no") (and query (not (yes-or-no-p - (format "Evaluate this%scode on your system? " - (if info (format " %s " (nth 0 info)) " ")))))) - (prog1 nil (message "evaluation aborted")) + (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 @@ -238,7 +247,8 @@ then run `org-babel-execute-src-block'." (interactive) (let ((info (org-babel-get-src-block-info))) (if info - (progn (org-babel-execute-src-block current-prefix-arg info) t) nil))) + (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 () @@ -363,10 +373,12 @@ block." (new-hash (when cache? (org-babel-sha1-hash info))) (old-hash (when cache? (org-babel-result-hash info))) (body (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) - (org-babel-expand-noweb-references info) - (nth 1 info)))) + (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 @@ -379,7 +391,7 @@ block." result) (unwind-protect (flet ((call-process-region (&rest args) - (apply 'org-babel-tramp-handle-call-process-region 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)) @@ -584,6 +596,60 @@ results already exist." 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 @@ -757,57 +823,6 @@ portions of results lines." (lambda () (org-add-hook 'change-major-mode-hook 'org-babel-show-result-all 'append 'local))) -(defmacro org-babel-map-src-blocks (file &rest body) - "Evaluate BODY forms on each source-block in FILE. -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 ((visited-p (or (null ,file) - (get-file-buffer (expand-file-name ,file)))) - (point (point)) to-be-removed) - (save-window-excursion - (when ,file (find-file ,file)) - (setq to-be-removed (current-buffer)) - (goto-char (point-min)) - (while (re-search-forward org-babel-src-block-regexp nil t) - (goto-char (match-beginning 0)) - (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))) - (defvar org-file-properties) (defun org-babel-params-from-properties (&optional lang) "Retrieve parameters specified as properties. @@ -893,17 +908,31 @@ may be specified at the top of the current buffer." (defun org-babel-parse-header-arguments (arg-string) "Parse a string of header arguments returning an alist." - (if (> (length arg-string) 0) - (delq nil - (mapcar - (lambda (arg) - (if (string-match - "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" - arg) - (cons (intern (concat ":" (match-string 1 arg))) - (org-babel-read (org-babel-chomp (match-string 2 arg)))) - (cons (intern (concat ":" arg)) nil))) - (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t))))) + (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." @@ -1291,6 +1320,7 @@ following the source block." (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]*: ") @@ -1316,6 +1346,10 @@ following the source block." (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. @@ -1349,7 +1383,9 @@ silent -- no results are inserted file ---- the results are interpreted as a file path, and are inserted into the buffer using the Org-mode file syntax -raw ----- results are added directly to the org-mode file. This +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. @@ -1406,16 +1442,24 @@ code ---- the results are extracted in the syntax of the source ((member "replace" result-params) (delete-region (point) (org-babel-result-end))) ((member "append" result-params) - (goto-char (org-babel-result-end)) (setq beg (point))) - ((member "prepend" result-params) ;; already there - ))) + (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)) @@ -1425,24 +1469,34 @@ code ---- the results are extracted in the syntax of the source (goto-char beg) (when (org-at-table-p) (org-table-align))) ((member "file" result-params) (insert result)) - ((member "html" result-params) - (insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n" - results-switches result))) - ((member "latex" result-params) - (insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n" - results-switches result))) - ((member "code" result-params) - (insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n" - (or lang "none") results-switches result))) - ((member "org" result-params) - (insert (format "#+BEGIN_SRC org\n%s#+END_SRC\n" result))) - ((member "raw" result-params) - (save-excursion (insert result)) (if (org-at-table-p) (org-cycle))) - (t - (org-babel-examplize-region - (point) (progn (insert result) (point)) results-switches))) + (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 - (setq end (if (listp result) (org-table-end) (point))) (when (and indent (> indent 0) ;; in this case `table-align' does the work for us (not (and (listp result) @@ -1450,9 +1504,9 @@ code ---- the results are extracted in the syntax of the source (indent-rigidly beg end indent)))) (if (= (length result) 0) (if (member "value" result-params) - (message "No result returned by source block") - (message "Source block produced no output")) - (message "finished")))) + (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." @@ -1466,25 +1520,18 @@ code ---- the results are extracted in the syntax of the source (defun org-babel-result-end () "Return the point at the end of the current set of results" (save-excursion - (if (org-at-table-p) - (progn (goto-char (org-table-end)) (point)) - (let ((case-fold-search t)) - (cond - ((looking-at "[ \t]*#\\+begin_latex") - (re-search-forward "[ \t]*#\\+end_latex" nil t) - (forward-line 1)) - ((looking-at "[ \t]*#\\+begin_html") - (re-search-forward "[ \t]*#\\+end_html" nil t) - (forward-line 1)) - ((looking-at "[ \t]*#\\+begin_example") - (re-search-forward "[ \t]*#\\+end_example" nil t) - (forward-line 1)) - ((looking-at "[ \t]*#\\+begin_src") - (re-search-forward "[ \t]*#\\+end_src" nil t) - (forward-line 1)) - (t (progn (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") - (forward-line 1)))))) - (point)))) + (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. @@ -1505,9 +1552,7 @@ file's directory then expand relative links." (interactive "*r") (let ((size (count-lines beg end))) (save-excursion - (cond ((= size 0) - (error (concat "This should not be impossible:" - "a newline was appended to result if missing"))) + (cond ((= size 0)) ; do nothing for an empty result ((< size org-babel-min-lines-for-block-output) (goto-char beg) (dotimes (n size) @@ -1517,7 +1562,7 @@ file's directory then expand relative links." (insert (if results-switches (format "#+begin_example%s\n" results-switches) "#+begin_example\n")) - (forward-char (- end beg)) + (if (markerp end) (goto-char end) (forward-char (- end beg))) (insert "#+end_example\n")))))) (defun org-babel-update-block-body (new-body) @@ -1534,8 +1579,8 @@ Later elements of PLISTS override the values of previous element. This takes into account some special considerations for certain parameters when merging lists." (let ((results-exclusive-groups - '(("file" "vector" "table" "scalar" "raw" "org" - "html" "latex" "code" "pp") + '(("file" "list" "vector" "table" "scalar" "raw" "org" + "html" "latex" "code" "pp" "wrap") ("replace" "silent" "append" "prepend") ("output" "value"))) (exports-exclusive-groups @@ -1599,7 +1644,7 @@ parameters when merging lists." (:tangle ;; take the latest -- always overwrite (setq tangle (or (list (cdr pair)) tangle))) (:noweb - (setq noweb (e-merge '(("yes" "no")) noweb + (setq noweb (e-merge '(("yes" "no" "tangle")) noweb (split-string (or (cdr pair) ""))))) (:cache (setq cache (e-merge '(("yes" "no")) cache @@ -1718,6 +1763,38 @@ block but are passed literally to the \"example-block\"." "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 @@ -1851,7 +1928,7 @@ of `org-babel-temporary-directory'." (if (file-remote-p default-directory) (make-temp-file (concat (file-remote-p default-directory) - (expand-file-name + (expand-file-name prefix temporary-file-directory) nil suffix)) (let ((temporary-file-directory @@ -1865,17 +1942,22 @@ of `org-babel-temporary-directory'." (when (and (boundp 'org-babel-temporary-directory) (file-exists-p org-babel-temporary-directory)) ;; taken from `delete-directory' in files.el - (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))) + (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) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 1c9d6d4a3de..6bcbf62da02 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -242,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")) @@ -562,6 +566,33 @@ 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, ignore some scheduled TODO items when making TODO list. This applies when creating the global todo list. @@ -632,7 +663,8 @@ to make his option also apply to the tags-todo list." "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 @@ -860,12 +892,25 @@ 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. @@ -922,6 +967,35 @@ 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 @@ -1211,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 @@ -1224,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 @@ -1431,6 +1507,52 @@ determines if it is a foreground or a background color." (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." :tag "Org Agenda Column View" @@ -1720,19 +1842,19 @@ 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 @@ -2778,6 +2900,7 @@ 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 preceded @@ -3065,6 +3188,16 @@ no longer in use." (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 (defvar org-agenda-only-exact-dates nil) ; dynamically scoped @@ -3092,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)) @@ -3129,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 @@ -3144,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) @@ -3172,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) @@ -3210,7 +3340,8 @@ When EMPTY is non-nil, also include days without any entries." (defvar org-agenda-last-arguments nil "The arguments of the previous call to `org-agenda'.") (defvar org-starting-day nil) ; local variable in the agenda buffer -(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) @@ -3247,7 +3378,7 @@ 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. @@ -3258,37 +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) - (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))) @@ -3298,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 @@ -3343,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) @@ -3356,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))) @@ -3400,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)))) @@ -3425,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)) @@ -3444,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 @@ -3723,7 +3877,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (org-set-sorting-strategy 'todo) (org-prepare-agenda "TODO") (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) - (let* ((today (time-to-days (current-time))) + (let* ((today (org-today)) (date (calendar-gregorian-from-absolute today)) (kwds org-todo-keywords-for-agenda) (completion-ignore-case t) @@ -4347,7 +4501,8 @@ the documentation of `org-diary'." "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 @@ -4370,7 +4525,29 @@ the documentation of `org-diary'." (> (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))))))))) + (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.") @@ -4924,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. @@ -4948,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 @@ -5038,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) @@ -5163,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))) @@ -5567,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)))) @@ -5839,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"))))) @@ -5862,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)))) @@ -5926,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. @@ -5936,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. @@ -5961,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." @@ -6094,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" @@ -6151,7 +6340,7 @@ When called with a prefix argument, include all archive files as well." (if org-agenda-include-diary "on" "off"))) (defun org-agenda-toggle-deadlines () - "Toggle diary inclusion in an agenda buffer." + "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)) @@ -6173,33 +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 (get 'org-agenda-files 'org-restrict) " []" "") - (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-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 " 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 () @@ -6216,7 +6408,6 @@ When called with a prefix argument, include all archive files as well." (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)) @@ -6642,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 @@ -7551,25 +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 (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)))) + (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." @@ -7619,7 +7810,7 @@ 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)) @@ -7681,6 +7872,29 @@ The prefix arg is passed through to the command if possible." (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 @@ -7792,6 +8006,9 @@ belonging to the \"Work\" category." (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) @@ -7834,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 8c1f9a13a12..e56b01f952a 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el index b48f8efa1cd..99facb1e431 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index d98254cb659..a894064ed84 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: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index d5a09cab63b..4155f58b5f6 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el index d3f0f47e45c..c88df859f79 100644 --- a/lisp/org/org-beamer.el +++ b/lisp/org/org-beamer.el @@ -2,7 +2,7 @@ ;; ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; -;; Version: 7.3 +;; 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 @@ -246,14 +246,14 @@ in org-export-latex-classes." (if (and (string-match "\\`[0-9.]+\\'" tmp) (or (= (string-to-number tmp) 1.0) (= (string-to-number tmp) 0.0))) - ;; column width 1 means cloase columns, go back to full width + ;; 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) - (when (string-match "C\\(\\[[^][]*\\]\\)" (cdr ass)) + (while (string-match "C\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass)) (setq columns-option (match-string 1 (cdr ass))) (setcdr ass (replace-match "" t t (cdr ass)))) - (when (string-match "c\\(\\[[^][]*\\]\\)" (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) diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index b9018b023ba..e34e1572cd3 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 2abe5c72bf6..5c7b0386e04 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -133,7 +133,10 @@ target Specification of where the captured item should be placed. File to the entry matching regexp (file+datetree \"path/to/file\") - Will create a heading in a date tree + 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 @@ -280,6 +283,9 @@ calendar | %:type %:date" (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 ") @@ -313,6 +319,12 @@ 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 @@ -461,9 +473,11 @@ bypassed." (t (setq txt "* Invalid capture template"))) (org-capture-put :template txt))) -(defun org-capture-finalize () - "Finalize the capture process." - (interactive) +(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")) @@ -548,17 +562,25 @@ bypassed." ;; Restore the window configuration before capture (set-window-configuration return-wconf)) - (when abort-note + + (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")))))) + (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." +already gone. Any prefix argument will be passed to the refile comand." (interactive) (unless (eq (org-capture-get :type 'local) 'entry) (error @@ -640,19 +662,28 @@ already gone." (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) (error "No match for target regexp in file %s" (nth 1 target)))) - ((eq (car target) 'file+datetree) + ((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 - (if org-overriding-default-time - (time-to-days org-overriding-default-time) - (time-to-days - (time-subtract (current-time) - (list 0 (* 3600 org-extend-today-until) 0))))))) + (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)) @@ -1358,5 +1389,3 @@ The template may still contain \"%?\" for cursor positioning." ;; 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 457a4dcb2f0..93b0b524c80 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -34,7 +34,7 @@ (eval-when-compile (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) @@ -222,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 @@ -1586,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) @@ -1611,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', @@ -1633,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)) @@ -1650,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)) @@ -1657,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)) @@ -1671,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))) @@ -1686,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 @@ -1704,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)) @@ -1713,90 +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)) - (tags (plist-get params :tags)) - (matcher (if tags (cdr (org-make-tags-matcher tags)))) - ipos time p level hlc hdl tsp props content recalc formula pcol - cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list st) - (setq org-clock-file-total-minutes nil) + (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)) @@ -1810,166 +1959,271 @@ 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 org-clock-file-total-minutes 0) - (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 - (unless (null matcher) - (lambda () - (let ((tags-list - (org-split-string - (or (org-entry-get (point) "ALLTAGS") "") - ":"))) - (eval matcher))))) - (goto-char (point-min)) - (setq st t) - (while (or (and (bobp) (prog1 st (setq st nil)) - (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)) - total-time))))) + (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)) @@ -2008,29 +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") (setq step-time (org-dblock-write:clocktable p1)) - (re-search-forward "#\\+END:") + (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) + (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. @@ -2051,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)))) @@ -2081,7 +2414,8 @@ The details of what will be saved are regulated by the variable (buffer-file-name b) (or (not org-clock-persist-query-save) (y-or-n-p (concat "Save current clock (" - (substring-no-properties org-clock-heading) + (substring-no-properties + org-clock-heading) ") ")))) (insert "(setq resume-clock '(\"" (buffer-file-name (org-clocking-buffer)) @@ -2162,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 15dc7b37a62..c4f18c7c640 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 324464803f2..452a261fd1b 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -372,15 +372,15 @@ TIME defaults to the current time." (time-to-seconds (or time (current-time))) (float-time time))) -(defun org-string-match-p (&rest args) - (if (fboundp 'string-match-p) - (apply 'string-match-p args) +(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 - (apply 'string-match args)))) + (funcall 'string-match regexp string start)))) -(defun org-looking-at-p (&rest args) - (if (fboundp 'looking-at-p) - (apply 'looking-at-p args) +(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)))) @@ -418,6 +418,12 @@ LIMIT." (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 693f3ac6a87..1d761049bbb 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: 7.3 +;; Version: 7.4 ;; Keywords: org-mode ;; Author: John Wiegley <johnw@gnu.org> ;; Maintainer: Peter Jones <pjones@pmade.com> diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 71e1b1b6a7e..f2c631afe24 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -3,10 +3,10 @@ ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Paul Sexton <eeeickythump@gmail.com> -;; Version: 7.3 +;; Version: 7.4 ;; Keywords: org, wp -;; Version: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index 286cdc9a1ae..8014f8f1f93 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el index 7d90ec32fbe..91ebb971967 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: 7.3 +;; Version: 7.4 ;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Keywords: org, wp, docbook diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el index 0c77b690765..cb0f24139a2 100644 --- a/lisp/org/org-docview.el +++ b/lisp/org/org-docview.el @@ -5,7 +5,7 @@ ;; Author: Jan Böcker <jan.boecker at jboecker dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 5ce5fd7531c..1c99b9eb5a5 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -6,7 +6,7 @@ ;; Ulf Stegemann <ulf at zeitform dot de> ;; Keywords: outlines, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el index 3751e68e057..57087e1dfc7 100644 --- a/lisp/org/org-exp-blocks.el +++ b/lisp/org/org-exp-blocks.el @@ -4,7 +4,7 @@ ;; Free Software Foundation, Inc. ;; Author: Eric Schulte -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. ;; @@ -201,9 +201,6 @@ which defaults to the value of `org-export-blocks-witheld'." (interblock start (point-max)) (run-hooks 'org-export-blocks-postblock-hook))))) -(add-hook 'org-export-preprocess-after-include-files-hook - 'org-export-blocks-preprocess) - ;;================================================================================ ;; type specific functions diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el index 73e0951334d..d45ef9cdd74 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -984,7 +984,7 @@ 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 - (if subtree-p (progn (outline-mark-subtree) (activate-mark))) + (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))) @@ -1080,12 +1080,18 @@ on this string to produce the exported version." ;; 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)) @@ -1536,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)) @@ -2100,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 all) + 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")) @@ -2128,7 +2155,7 @@ 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 "")))) all)) @@ -2145,7 +2172,7 @@ TYPE must be a string, any of: (when intersection (error "Recursive #+INCLUDE: %S" intersection)))))) -(defun org-get-file-contents (file &optional prefix prefix1 markup) +(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. @@ -2167,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) @@ -2235,8 +2265,6 @@ in the list) and remove property and value from the list in LISTVAR." (defvar org-export-latex-listings-langs) ;; defined in org-latex.el (defvar org-export-latex-listings-w-names) ;; defined in org-latex.el (defvar org-export-latex-minted-langs) ;; defined in org-latex.el -(defvar org-export-latex-minted-with-line-numbers) ;; defined in org-latex.el - (defun org-export-format-source-code-or-example (backend lang code &optional opts indent caption) "Format CODE from language LANG and return it formatted for export. @@ -2403,8 +2431,7 @@ INDENT was the original indentation of the block." (format "\n%s $\\equiv$ \n" (replace-regexp-in-string "_" "\\\\_" caption))) - (format - "\\begin{minted}[mathescape,%s\nnumbersep=5pt,\nframe=lines,\nframesep=2mm]{%s}\n" (if org-export-latex-minted-with-line-numbers "\nlinenos," "") minted-lang) + (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)))) @@ -2585,9 +2612,10 @@ 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)) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index e4e17f15c5d..3f8245758f7 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -685,6 +685,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)) diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index 8bda3098e0a..32da49b1cb8 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index 2a97b54db6f..88ffd6e4842 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -303,7 +303,7 @@ 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) - (let ((max (if (and (eq major-mode 'message-mode) + (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))))) diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el index 736cc577ce7..d9486afa0b5 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index 6d782759a75..fccd3e9ee01 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 394b4fb05db..b174a1f0879 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -197,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 diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el index 68fee5b8df5..47e82319873 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -1213,7 +1213,11 @@ lang=\"%s\" xml:lang=\"%s\"> (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) @@ -2316,10 +2320,9 @@ When TITLE is nil, just close all open levels." (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)))) - (remove (or preferred target)) (l org-level-max) snumber snu href suffix) - (setq extra-targets (remove remove extra-targets)) + (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))) @@ -2358,12 +2361,13 @@ 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) diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el index fe6e97c72dd..d4034fe6d36 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index fcca58831d1..a8004afec8a 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -600,15 +600,18 @@ optional argument MARKERP, return the position as a new marker." (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))) - (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)) + (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 39ba445eb93..a177a6f2a04 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -38,6 +38,10 @@ (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 Indent" @@ -219,35 +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 ((inhibit-modification-hooks t) - ov b e n level 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)) - (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 (* (or level 0) 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." @@ -255,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) @@ -268,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 6ea192b1765..250f438ab96 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: 7.3 +;; 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 29d8c40eed2..3f2d6fbbf06 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: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. @@ -100,6 +100,60 @@ 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) @@ -131,24 +185,56 @@ If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'." (end-of-line -1)) (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) +(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* ((nstars (if org-odd-levels-only - (1- (* 2 (or org-inlinetask-min-level 200))) - (or org-inlinetask-min-level 200))) - (stars-re (concat "^\\(?:\\*\\{" - (format "%d" (- nstars 1)) - ",\\}\\)[ \t]+")) + (let* ((stars-re (org-inlinetask-outline-regexp)) (task-beg-re (concat stars-re "\\(?:.*\\)")) - (task-end-re (concat stars-re "\\(?:END\\|end\\)"))) + (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))))))) -(defvar htmlp) ; dynamically scoped into the next function -(defvar latexp) ; dynamically scoped into the next function +(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." @@ -158,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) @@ -179,40 +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 - (org-add-props - (format - "@<span class=\"%s %s\"> %s@</span>" - (if (member (match-string 2 headline) - org-done-keywords) - "done" "todo") - (match-string 2 headline) - (match-string 2 headline)) - nil 'org-protected t) - " ") "") - (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." @@ -247,31 +327,11 @@ 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) diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 3dd9680c8ff..fba274156db 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: 7.3 +;; 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 d435d814679..e5c65b0fb0f 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el index 2cf947312d8..a29c9f37401 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: 7.3 +;; Version: 7.4 ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -295,7 +295,14 @@ markup defined, the first one in the association list will be used." :group 'org-export-latex :type 'string) -(defcustom org-export-latex-hyperref-format "\\href{%s}{%s}" +(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." @@ -453,12 +460,6 @@ pygmentize -L lexers (symbol :tag "Major mode ") (string :tag "Listings language")))) -(defcustom org-export-latex-minted-with-line-numbers nil - "Should source code line numbers be included when exporting -with the latex minted package?" - :group 'org-export-latex - :type 'boolean) - (defcustom org-export-latex-remove-from-headlines '(:todo nil :priority nil :tags nil) "A plist of keywords to remove from headlines. OBSOLETE. @@ -1280,12 +1281,13 @@ OPT-PLIST is the options plist for current buffer." (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" @@ -1297,8 +1299,6 @@ OPT-PLIST is the options plist for current buffer." (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) @@ -1325,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 @@ -1452,6 +1452,33 @@ 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]+\\)" "\\(?:<[^<>\n]*>\\)*" @@ -2016,10 +2043,10 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (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))) @@ -2030,7 +2057,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ;; 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 org-export-latex-hyperref-format 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 @@ -2356,7 +2383,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\n" (match-string 1 res)) t t res))) - (insert res "\n")))) + (insert res)))) (defconst org-latex-entities '("\\!" diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 4ea466f379d..bc8e7bddb5b 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -462,7 +462,8 @@ List ending is determined by indentation of text. See (forward-line -1) (catch 'exit (while t - (let ((ind (org-get-indentation))) + (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) + (org-get-indentation)))) (cond ((looking-at "^[ \t]*:END:") (throw 'exit item-ref)) @@ -502,7 +503,8 @@ List ending is determined by the indentation of text. See (catch 'exit (while t (skip-chars-forward " \t") - (let ((ind (org-get-indentation))) + (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) + (org-get-indentation)))) (cond ((or (>= (point) limit) (looking-at ":END:")) @@ -518,7 +520,11 @@ List ending is determined by the indentation of text. See (setq ind-ref ind) (forward-line 1)) ((<= ind ind-ref) - (throw 'exit (point-at-bol))) + (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)) @@ -636,7 +642,7 @@ function ends." ;; insert bullet above item in order to avoid bothering ;; with possible blank lines ending last item. (goto-char (org-get-item-beginning)) - (indent-to-column ind) + (org-indent-to-column ind) (insert (concat bullet (when checkbox "[ ] ") after-bullet)) ;; Stay between after-bullet and before text. (save-excursion @@ -1060,7 +1066,7 @@ so this really moves item trees." (org-list-exchange-items actual-item next-item bottom) (org-list-repair nil nil bottom) (goto-char (org-get-next-item (point) bottom)) - (move-to-column col))))) + (org-move-to-column col))))) (defun org-move-item-up () "Move the plain list item at point up, i.e. swap with previous item. @@ -1081,7 +1087,7 @@ so this really moves item trees." (error "Cannot move this item further up")) (org-list-exchange-items prev-item actual-item bottom) (org-list-repair nil top bottom) - (move-to-column col))))) + (org-move-to-column col))))) (defun org-insert-item (&optional checkbox) "Insert a new item at the current level. @@ -1481,7 +1487,7 @@ BOTTOM is position at list ending." ;; this is not an empty line (let ((i (org-get-indentation))) (when (and (> i 0) (> (+ i delta) 0)) - (indent-line-to (+ i delta))))) + (org-indent-line-to (+ i delta))))) (beginning-of-line 0))))) (defun org-outdent-item () @@ -1543,7 +1549,7 @@ Return t at each successful move." (ignore-errors (org-list-indent-item-generic 1 t top bottom)))) (t (back-to-indentation) - (indent-to-column (car org-tab-ind-state)) + (org-indent-to-column (car org-tab-ind-state)) (end-of-line) (org-list-repair (cdr org-tab-ind-state)) ;; Break cycle @@ -1629,35 +1635,36 @@ 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") - (let* ((top (org-list-top-point)) - (bullet (save-excursion - (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))) + (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 @@ -2029,7 +2036,7 @@ sublevels as a list of strings." (while (org-search-forward-unenclosed org-item-beginning-re end t) (save-excursion (beginning-of-line) - (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered) + (setq ltype (cond ((org-looking-at-p "^[ \t]*[0-9]") 'ordered) ((org-at-item-description-p) 'descriptive) (t 'unordered)))) (let* ((indent1 (org-get-indentation)) diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el index afac5ca71b1..a146cc86e2b 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: 7.3 +;; Version: 7.4 ;; Keywords: outlines, hypermedia, calendar, wp ;; This file is part of GNU Emacs. diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 5a5612387fd..97a8fdc06e4 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -46,9 +46,16 @@ (if (or (> emacs-major-version 23) (and (>= emacs-major-version 23) (>= emacs-minor-version 2))) - (called-interactively-p ,kind) + (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)) diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el index efedef8ec5c..9636a1aa428 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: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index b1024a000e2..c384062a3fa 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el index 2d429a79152..df4ab3e2e75 100644 --- a/lisp/org/org-mks.el +++ b/lisp/org/org-mks.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index a278fb16d0a..4b16e2b8fcf 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 4a341d4272d..d1540c3f3f9 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -1,11 +1,10 @@ ;;; org-mouse.el --- Better mouse support for org-mode -;; Copyright (C) 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation ;; ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> -;; Version: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -1101,10 +1100,10 @@ This means, between the beginning of line and the point." "--" ["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 diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 274d3f94c8a..374e2d43b5e 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 3a20c5f729c..5d5059fbf0e 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: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. ;; @@ -313,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)) diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el index 51db9f652d1..bb20cc60dff 100644 --- a/lisp/org/org-publish.el +++ b/lisp/org/org-publish.el @@ -5,7 +5,7 @@ ;; Author: David O'Toole <dto@gnu.org> ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> ;; Keywords: hypermedia, outlines, wp -;; Version: 7.3 +;; Version: 7.4 ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index a15825a51ec..c6e21ae057b 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index 5574bf77ac4..73258685232 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index c4f0065ec34..c932b4a70b2 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -240,8 +240,8 @@ buffer." 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 end)) - (save-excursion (goto-char mark) + (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) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 0d61a782270..116c3fc2312 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -48,6 +48,12 @@ (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'. In the optimized version, the table editor takes over all simple keys that @@ -3729,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) @@ -3943,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. diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el index d03cd591b81..d78e10d56a8 100644 --- a/lisp/org/org-taskjuggler.el +++ b/lisp/org/org-taskjuggler.el @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-taskjuggler.el -;; Version: 7.3 +;; Version: 7.4 ;; Author: Christian Egli ;; Maintainer: Christian Egli ;; Keywords: org, taskjuggler, project planning diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index 6c1f4984cf1..bac11870431 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el index 629258dec94..daef6713f41 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index 072020a65e7..6965ac6b337 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index 54d35c98f2f..137bad9de89 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -7,7 +7,7 @@ ;; David Maus <dmaus at ictsoc dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el index b5656d9406f..2ce277ed6ce 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org.el b/lisp/org/org.el index f7e7c9fd2f4..eb919687325 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: 7.3 +;; Version: 7.4 ;; ;; This file is part of GNU Emacs. ;; @@ -75,6 +75,7 @@ (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) @@ -98,6 +99,7 @@ (require 'org-compat) (require 'org-faces) (require 'org-list) +(require 'org-complete) (require 'org-src) (require 'org-footnote) @@ -186,7 +188,7 @@ identifier." ;;; Version -(defconst org-version "7.3" +(defconst org-version "7.4" "The version number of the file org.el.") (defun org-version (&optional here) @@ -1383,12 +1385,15 @@ nil Never use an ID to make a link, instead link using a text search for (defcustom org-context-in-file-links t "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. @@ -1958,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. @@ -2473,6 +2478,16 @@ 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" @@ -2613,7 +2628,7 @@ 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-aread-date-prefer-future" + (const :tag "Use org-read-date-prefer-future" org-read-date-prefer-future) (const :tag "Never" nil) (const :tag "Always" t))) @@ -2719,10 +2734,10 @@ To disable these tags on a per-file basis, insert anywhere in the file: (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 remember buffers, because there no list of +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-remember-mode-hook + (add-hook 'org-capture-mode-hook (lambda () (set (make-local-variable 'org-complete-tags-always-offer-all-agenda-tags) @@ -3422,7 +3437,7 @@ After a match, the match groups contain these elements: (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 @@ -3506,8 +3521,8 @@ 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. -Normal means no org-mode-specific context." + "The expansion command called by \\[pcomplete] in normal context. +Normal means, no org-mode-specific context." :group 'org-completion :type 'function) @@ -3555,10 +3570,13 @@ Normal means no org-mode-specific context." "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)) @@ -4739,6 +4757,17 @@ The following commands are available: ;; 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) @@ -4773,6 +4802,12 @@ 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)) @@ -5581,14 +5616,17 @@ needs to be inserted at a specific position in the font-lock sequence.") (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. @@ -6040,8 +6078,8 @@ With a numeric prefix, show all headlines up to that level." (interactive) (let (org-show-entry-below state) (save-excursion - (goto-char (point-max)) - (while (re-search-backward + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)" nil t) (setq state (match-string 1)) @@ -6982,11 +7020,12 @@ 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. @@ -7501,12 +7540,13 @@ If yes, remember the marker and the distance to BEG." (narrow-to-region (progn (org-back-to-heading t) (point)) (progn (org-end-of-subtree t t) - (if (org-on-heading-p) (backward-char 1)) + (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. @@ -7570,7 +7610,7 @@ and still retain the repeater to cover future instances of the task." (and idprop (if org-clone-delete-id (org-entry-delete nil "ID") (org-id-get-create t))) - (while (re-search-forward org-property-drawer-re nil t) + (while (re-search-forward org-property-start-re nil t) (org-remove-empty-drawer-at "PROPERTIES" (point))) (goto-char (point-min)) (when doshift @@ -8468,7 +8508,8 @@ 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) @@ -8482,6 +8523,13 @@ according to FMT (default from `org-email-link-description-format')." (while (string-match org-ts-regexp 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) @@ -9054,7 +9102,8 @@ application the system uses for this file type." (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))) @@ -9170,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) @@ -10464,6 +10509,7 @@ blocks in the buffer." "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)) @@ -10505,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))) @@ -10512,10 +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_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" + "LATEX_CLASS:" "LATEX_CLASS_OPTIONS:" "ATTR_LaTeX:" "BEGIN:" "END:" "ORGTBL" "TBLFM:" "TBLNAME:" "BEGIN_EXAMPLE" "END_EXAMPLE" @@ -10523,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" "PROPERTY" - "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 '( @@ -10609,137 +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 (or (and (equal (char-before beg1) ?:) - (not (equal (char-after (point-at-bol)) ?*))) - (string-match "^#\\+PROPERTY:.*" - (buffer-substring (point-at-bol) (point))))) - (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) - (append org-entities-user org-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 (and (memq type '(:tag :prop)) - (not (string-match "^#[ \t]*\\+property:" - (org-current-line-string t)))) - (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 () @@ -11962,13 +11884,13 @@ 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 [T]odo-kwd [m]atch [p]roperty [d]eadlines\n [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) @@ -12213,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 @@ -12458,7 +12382,7 @@ also TODO lines." 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 @@ -12498,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 @@ -13459,7 +13382,7 @@ 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. If WHICH -is a string only get exactly this property. Specific can be a string, the +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)) @@ -15025,7 +14948,7 @@ 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)) @@ -16285,9 +16208,9 @@ BEG and END default to the buffer boundaries." (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)) @@ -16352,7 +16275,7 @@ BEG and END default to the buffer boundaries." (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) @@ -16433,6 +16356,7 @@ BEG and END default to the buffer boundaries." (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) @@ -16506,7 +16430,7 @@ BEG and END default to the buffer boundaries." ("^" . 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) @@ -17246,11 +17170,13 @@ When in an #+include line, visit the include file. Otherwise call ((org-edit-fixed-width-region)) ((org-at-table.el-p) (org-edit-src-code)) - ((org-at-table-p) + ((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. @@ -17324,7 +17250,8 @@ This command does many different things, depending on context: (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)) @@ -17681,7 +17608,7 @@ 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 :active t :keys "C-c / t"] @@ -18066,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." @@ -18636,11 +18580,36 @@ 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)) @@ -18648,14 +18617,16 @@ which make use of the date at the cursor." (org-drawer-regexp (or org-drawer-regexp "\000")) (inline-task-p (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))) - column bpos bcol tpos tcol bullet btype bullet-type) - ;; Find the previous relevant line + column bpos bcol tpos tcol) (beginning-of-line 1) (cond ;; Comments - ((looking-at "#") (setq column 0)) + ((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))) @@ -18683,36 +18654,29 @@ which make use of the date at the cursor." (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)) - bullet (match-string 1) - bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) + tcol (progn (goto-char tpos) (current-column))) (if (> tcol (+ bcol org-description-max-indent)) (setq tcol (+ bcol 5))) - (if (not itemp) - (setq column tcol) - (beginning-of-line 1) - (goto-char pos) - (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))))) - ;; This line has nothing special, look upside to get a clue about - ;; what to do. + (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)) + (not (looking-at org-drawer-regexp)) ;; skip comments, verbatim, empty lines, tables, - ;; inline tasks - (or (looking-at "[ \t]*[\n:#|]") + ;; 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))) - (not (looking-at "[ \t]*:END:")) - (not (looking-at org-drawer-regexp))) + (org-inlinetask-in-task-p) + (or (org-inlinetask-goto-beginning) t)))) (beginning-of-line 0)) (cond ;; There was an heading above. @@ -18721,20 +18685,18 @@ which make use of the date at the cursor." (setq column 0) (goto-char (match-end 0)) (setq column (current-column)))) - ;; A drawer had started and is unfinished: indent consequently. + ;; A drawer had started and is unfinished ((looking-at org-drawer-regexp) (goto-char (1- (match-beginning 1))) (setq column (current-column))) - ;; The drawer had ended: indent like its :END: line. - ((looking-at "\\([ \t]*\\):END:") - (goto-char (match-end 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 @@ -19005,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. |