diff options
| author | Bastien Guerry <bastien1@free.fr> | 2011-07-28 17:13:49 +0200 |
|---|---|---|
| committer | Bastien Guerry <bastien1@free.fr> | 2011-07-28 17:13:49 +0200 |
| commit | 3ab2c837b302b01fff610f7b83050ab7e703477c (patch) | |
| tree | efa67ed523bbda4d41488ae6b9ad2782941ddcf2 /lisp | |
| parent | 44a8054f971837447e80d618b6e0c2a77778a2ee (diff) | |
| download | emacs-3ab2c837b302b01fff610f7b83050ab7e703477c.tar.gz | |
Merge changes from Org 7.4 to current Org 7.7.
Diffstat (limited to 'lisp')
102 files changed, 18152 insertions, 6662 deletions
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index d9ca232c9d0..a11db6f7b63 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,5194 @@ +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-agenda.el (org-agenda-filter-by-tag): bugfix: always refresh + the agenda when needed. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-publish.el (org-publish-index-generate-theindex): rename + from `org-publish-index-generate-theindex.inc'. Use the file + theindex.org directly instead of including theindex.inc. + (org-publish-projects): Don't delete .orgx files. + (org-publish-aux-preprocess): Use .file.orgx. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-html-preamble-format): New default for + the HTML preamble: don't include the title. Also improve the + docstring. + (org-export-html-postamble-format): Improve the docstring. + (org-export-as-html): Add the title within the "content" div. + This is necessary for interaction with the org-info.js script. + +2011-07-28 Michael Brand <michael.ch.brand@gmail.com> + + * org-table.el (org-table-edit-field): Display field coordinates. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-publish.el (org-publish-find-title): bugfix: kill buffers + unless they were already visited. + (org-sitemap-sort-files, org-sitemap-sort-folders) + (org-sitemap-ignore-case, org-sitemap-requested) + (org-sitemap-date-format, org-sitemap-file-entry-format): use + a correct prefix. + (org-publish-projects): Make sure to delete .orgx files. + (org-publish-index-generate-theindex.inc): Small docstring + fix. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-table.el (org-table-duration-custom-format): New defcustom + to select output format of durations computations. + (org-table-time-seconds-to-string): Use the new variable. + (org-table-eval-formula): Allow `t' as a flag, on top of `T'. `t' + will use the custom output format defined in + `org-table-duration-custom-format'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el: search blank lines down to the end of the item + instead of stopping at the item, in order to possibly match such + lines within the item. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-latex.el (org-export-latex-href-format): docstring fix to + reflect the fact that you can use only one "%s". + (org-export-latex-links): allow `org-export-latex-href-format' to + have only one "%s". + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-org-menu): Add `org-copy-visible' to the menu. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-copy-visible): New command. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-capture.el (org-capture-templates): docstring fix. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-view-src-block-info): New function to inspect + code blocks. + + * ob-keys.el (org-babel-key-bindings): Key bindings for + org-babel-view-src-block-info. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-exp.el (org-infile-export-plist): Handle recursively + included setup files. The value of the last included file always + takes precedence over previous values. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-timestamp-change): keep point in the same category + when updating a time-stamp. This requires to be careful, as, + depending on the locale, name of day might change of length during + the process. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-create-definition): when skipping + already written footnotes definition, the algorithme would assume + each one was only one-line long. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-table.el (org-table-eval-formula): Fix bug when a formula + "range" is just one cell. + (org-table-time-string-to-seconds): don't check whether + we manipulate a string. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-mark-list-end) + (org-export-mark-list-properties): don't remove the ending regexp + when it consists in blank lines. + + * org-list.el (org-list-parse-list): ditto, but remove it + completely when it isn't made of blank lines (i.e. during export + process). + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-table.el (org-table-time-string-to-seconds): match either + HH:MM:SS or HH:MM (instead of MM:SS). + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-ctrl-c-ctrl-c-final-hook): New hook to be run when + `org-ctrl-c-ctrl-c' cannot do anything useful in the given + context. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-html-with-timestamp) + (org-export-html-html-helper-timestamp): These are obsolete + variables as of Org version 7.7 as you can already export the + timestamp from the preamble or the postamble. + (org-export-html-before-content-div): Delete variable. + (org-export-html-content-div): obsolete variable as of 7.7. + (org-export-html-divs): New variable to define divs used in + HTML export. + (org-export-as-html): Now the preamble and the postamble are + surrounded by a <div ...>. The name of the div is defined + through `org-export-html-divs'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-table.el (org-table-eval-formula): Throw an error when + trying to replace complex range with invalid references. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-macs.el (org-with-limited-levels): some functions, like + `org-back-to-heading', being deeply based on outline-mode, still + refer to `outline-regexp' instead of `org-outline-regexp'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-refile-get-targets): new optional argument + `excluded-entries' to exclude entries from the targets. + (org-refile-get-location): From an org-mode buffer, exclude + current heading and subheadings from the list of targets when + org-refile-use-cache is nil. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-imenu-get-tree): note to self: headlines start at + bol. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-maxima.el: New file. Fixed self-proclaimed file name. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-sha1-hash): Only call copy-seq on proper lists. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-kill-is-subtree-p): matched string needs to start at + bol. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-paste-subtree, org-kill-is-subtree-p) + (org-yank-folding-would-swallow-text, org-yank-generic): use + `org-with-limited-levels' macro. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-macs.el (org-with-limited-levels): also modify, when + appropriate, `org-outline-regexp-at-bol'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-timestamp-change): some locales don't use the same + length for date abbreviations. Set a marker at origin in case + length of new timestamp is different. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-imenu-get-tree): browse only true headlines. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-archive.el (org-archive-subtree): while it might be possible + to archive an headline of a temporary buffer (i.e. not visiting a + file), it wouldn't be really sensical. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-archive.el (org-extract-archive-file) + (org-extract-archive-heading, org-archive-subtree): + buffer-file-name is nil in an indirect buffer. Thus, use + (buffer-file-name (buffer-base-buffer)), which will, in any case, + return the file-name. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-capture.el (org-capture): if dired isn't loaded, + `dired-buffers' isn't defined, and %F will fail. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-java.el (org-babel-execute:java): Don't create empty package + directories. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-java.el: New file. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Replaced call to defunct + function `org-babel-result-hash'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-in-valid-context-p): avoid cited + lines and headers in message-mode. + (org-footnote-at-reference-p): remove check for cited lines, this + is now handled by the previous function. Refactor. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-capture.el (org-capture): if no file is associated to + current buffer, check dired buffer and try to retreive a possibly + directory associated. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-results): Resolve hashes in the current + (not original) file buffer. + + * ob.el (org-babel-current-result-hash): More informative name, + and remove useless optional argument. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-refile-get-location): exclude current heading from + the refile table. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-at-reference-p): test if match is + in cited text, when replying to a message. + (org-footnote-new): do not create a new footnote at bol, as it might + be seen as a definition. + (org-footnote-at-definition-p): ignore definitions in forbidden + blocks, as it is already the case for references. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-bibtex.el (org-bibtex-create, org-bibtex-write): Change + argument of `org-toggle-tag' to 'on. (Other arguments, e.g., t, + have no effect). + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-bibtex.el (org-bibtex-get): Don't let trimming turn nils + into empty strings. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item): actualize code comments. + (org-insert-item): for consistency, point cannot be moved at + a surprising place when the user is being asked to choose a new + description term to insert in the list. Point should stay where the + user called the command. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-toc.el (org-toc-before-first-heading-p, org-toc-show) + (org-toc-get-headlines-status): Use `org-outline-regexp-bol'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-outline-regexp-bol): New defconst. + (org-outline-level, org-set-font-lock-defaults, org-cycle) + (org-overview, org-content, org-flag-drawer) + (org-first-headline-recenter, org-insert-todo-heading) + (org-map-region, org-move-subtree-down, org-paste-subtree) + (org-kill-is-subtree-p, org-context-p, org-refile) + (org-refile-new-child, org-toggle-comment, org-todo) + (org-add-planning-info, org-add-log-setup, org-scan-tags) + (org-set-tags, org-insert-property-drawer) + (org-prepare-agenda-buffers, org-preview-latex-fragment) + (org-speed-command-default-hook, org-check-for-hidden) + (org-toggle-item, org-toggle-heading) + (org-indent-line-function, org-set-autofill-regexps) + (org-fill-paragraph, org-toggle-fixed-width-section) + (org-yank-generic, org-yank-folding-would-swallow-text) + (org-first-sibling-p, org-goto-sibling) + (org-goto-first-child, org-show-entry): Use + `org-outline-regexp' and `org-outline-regexp-bol'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-update-parent-todo-statistics): COOKIE_DATA should + be checked for parent, not current headline. Also, this function + doesn't need to be interactive. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-send-item, org-list-struct-apply-struct) + (org-apply-on-list, org-toggle-checkbox): make markers point + nowhere when they have become useless. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item): when insertion point is in + some white line after the end of the list, remove all unnecessary + white lines there before proceeding. Also refactor a snippet of + code. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-latex.el (org-export-latex-image-default-option): Change + default value. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-fontify-meta-lines-and-blocks-1): blocks cannot be + correctly fontified when the buffer is missing a final newline. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * ob.el (org-babel-strip-protective-commas): Return `nil' instead + of an error if no argument is given. + (org-babel-parse-src-block-match): Make sure body is defined + in the let construct. + +2011-07-28 Jon Anders Skorpen <jonas@ifi.uio.no> (tiny change) + + * org-publish.el (org-publish-cache-file-needs-publishing): Regexp + did not find includes with double quoted file names. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-normalize): footnote section + should be inserted only if there are footnotes to insert. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-at-definition-p) + (org-footnote-normalize): do not grab signature in the definition + of the last footnote. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-bibtex.el (org-babel-trim): Declare this function to the + compiler. + (org-bibtex-get): Trimming whitespace off of bibtex fields read from + properties. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-preprocess-string): add the possibility + to call recursively the function. Also change order of some + function calls. Comment export process for footnotes. + + * org-footnote.el (org-footnote-normalize): change the export + specific parameter to hold properties of export. Thus, the + function can send every footnote definition in the buffer through + `org-export-process-string'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-preprocess): first insert + footnotes in the temporary buffer so their contents can properly + be protected from further transformations if required. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-indent-offset): new variable. + (org-list-struct-fix-ind): make use of the new variable. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-list-parameters): complete + default value with cbtrans option. + + * org-list.el (org-list-to-latex): set a more consistent default + value. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-swap-items): move it to a meaningful + position in source code (i.e. before any function using it), and + rename it to an easier name. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-separating-blank-lines-number): if there + are blank lines already in the whole list, add a blank line. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-use-circular-move): new variable. + (org-previous-item, org-next-item): make use of the new variable. + (org-move-item-down, org-move-item-up): make use of the new + variable. Simplify code. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-delete-item, org-list-send-item): new + functions. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-agenda.el (org-agenda-bulk-custom-functions): New variable + for custom bulk action functions. + (org-agenda-bulk-action): Use it. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-latex.el (org-export-latex-quotes): New defcustom. + (org-export-latex-quotation-marks): Use it. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-capture.el (org-capture-finalize): bugfix about inserted + blank line when killing the capture buffer and + `org-blank-before-new-entry' tells to not insert anything before a + heading. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-html-content-div): Rename from + `org-export-content-div'. + (org-export-as-html): Use new name. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-latex.el (org-export-latex-header-defs-re): Delete. + +2011-07-28 Bastien <bzg@gnu.org> + + * org.el (org-last-set-property): New variable. + (org-read-property-name): Use the new variable: the prompt + defaults to the last property set, unless there is a property + in the line at point. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-capture.el (org-capture-before-finalize-hook) + (org-capture-after-finalize-hook, org-capture-mode-map) + (org-capture-mode, org-capture-goto-last-stored): Fix docstring, + consistently refer to capture, not remember. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-execute:clojure): Respects "scalar" and + "verbatim" results params. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-awk.el (org-babel-execute:awk): Use "verbatim" as synonym for + "scalar". + + * ob-sh.el (org-babel-sh-evaluate): Use "verbatim" as synonym for + "scalar". + + * ob-sqlite.el (org-babel-execute:sqlite): Use "verbatim" as + synonym for "scalar". + + * ob.el (org-babel-merge-params): Use "verbatim" as synonym for + "scalar". + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-script-escape): Parse odd parens when nested + isnide lists. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-execute:clojure): No longer force + results into elisp if they don't naturally fit. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-execute:clojure): Stop re-reading + already parsed lisp results. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-plain-list-ordered-item-terminator): remove + incorrect assumption. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-forbidden-blocks): add missing + exporter specific blocks. + + * org-list.el (org-list-forbidden-blocks): ditto. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-latex.el (org-export-latex-tables): Bugfix: remove + properties from fields. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-shiftcontrolup, org-shiftcontroldown): New commands + to use `org-clock-timestamps-change'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-timestamp-up, org-timestamp-down): mention time + changes in the docstring. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-clock.el (org-clock-remove-empty-clock-drawer): New function + to remove empty clock drawer. + (org-clock-out-hook): Add the new function as a hook. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-in-valid-context-p): use `org-in-block-p'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-in-block-p): new function. + + * org-footnote.el (org-footnote-forbidden-blocks): new variable. + (org-footnote-in-valid-context-p): new function. + (org-footnote-at-reference-p): use new function. Allow inline + footnotes to start at bol. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-lparse.el (org-lparse-use-flashy-warning): New defcustom. + (org-lparse-warn): Use it. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-ascii.el (org-export-as-utf8): fix call to + `org-called-interactively-p': it requires an argument. Also fix + the docstring. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lilypond.el (show-all): Declaring function from outline.el. + (org-babel-default-header-args:lilypond): Declared. + (ly-process-basic): Use the appropriate prefix for the temporary + file, and don't call a function from ob-dot.el. + (ly-version): Let-bind a free variable. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lilypond.el: New file. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-publish.el + (org-publish-cache-file-needs-publishing): only check against .org + files. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-mode): Use org-default as + the default face in org-mode. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-publish.el + (org-publish-cache-file-needs-publishing): Takes care of more + recently included files, returning `t' in case the file including + them needs to be republished. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-preprocess-string): if the last subtree + is a task, footnotes may be removed along with the subtree. This + patch ensures footnotes are put at the end of the buffer after the + subtree has been removed. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-at-reference-p): verify that what + looks like a footnote doesn't belong to a link. + (org-footnote-next-reference-or-definition): check more strictly + footnote definitions. + +2011-07-28 Deech <deech@deech-ThinkPad-X200.(none)> + + * ob-tangle.el (org-babel-tangle): Ignore errors thrown by + language modes. + +2011-07-28 Suvayu Ali <fatkasuvayu+linux@gmail.com> + + * Mention use of keywords like multicolumn and float + + * Remove previous mention of hack with placement option as per + comments on the mailing list. The hack is better suited for Worg. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-python-evaluate-session): Inhibit return + of the eoe string during session evaluation. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-python-evaluate-session): Enough + newlines to ensure a return when ":results output :session". + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-python-evaluate-session): Introduced a + new local function for sending input with a slight delay to allow + pythong to re-draw the prompt. No longer removing newlines inside + code block bodies (was due to a defective regexp). + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-table.el + (org-table-time-seconds-to-string): use `org-format-seconds' + instead of `format-seconds'. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-publish.el (org-publish-cache-ctime-of-src): Properly handle + relative symlinks. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-latex.el (org-export-latex-preprocess): Use function + argument instead of dynamically scoped symbol. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-freemind.el (org-freemind-convert-links-helper) + (org-freemind-convert-text-p, org-freemind-write-mm-buffer) + (org-freemind-get-node-style): Use org-string-match-p for backward + compatibility with Emacs22. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-html.el (org-export-html-protect-char-alist): Add missing + :group keyword in defcustom. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * ob-haskell.el (org-babel-haskell-export-to-lhs): Call + kill-buffer with argument indiciating to kill current + buffer. Emacs 22 compatibility. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-macs.el (org-without-partial-completion): Toggle + partial-completion-mode only if it is turned on. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-add-planning-info): fix + issues with timestamps not being inserted at the same position. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-table.el + (org-table-time-string-to-seconds) + (org-table-time-seconds-to-string): New functions. + (org-table-eval-formula): Implement the "T" (time) flag for + computing durations. + +2011-07-28 Jambunathan K <kjambunathan@gmail.com> + + * org.el (org-modules): Add org-lparse and org-odt as contrib + modules. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-fontify-meta-lines-and-blocks-1): Include header + lines. + (org-additional-option-like-keywords): Include data as a synonym for + results. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-sha1-hash): Improving code layout and removing + export-variable headers in cache sha1. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-goto-headline-id): Don't let org-id + rescan all IDs when trying to resolve a reference. + +2011-07-28 Julien Barnier <julien@nozav.org> + + * org.el (org-fontify-meta-lines-and-blocks-1): Fix test for src + blocks lang attribute + +2011-07-28 Eric S Fraga <e.fraga@ucl.ac.uk> + + * Allow for a different markup for inactive time stamps on latex + export + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-org.el (org-babel-expand-body:org): Implemented this + function, only action is to expand variables. + (org-babel-execute:org): Uses the new body-expansion function. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-full-item-re): allow counter and check-box + to be separated by white spaces. + (org-list-struct-apply-struct): reflect changes made to + `org-list-full-item-re'. + + * org-html.el (org-html-export-list-line): recognize spaces + between counter and check-boxes as valid. + + * org-docbook.el (org-export-docbook-list-line): ditto. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item): make sure point is moved to + the specified POS before starting the function. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-activate-footnote-links): properly fontify inline + footnotes. + (org-set-font-lock-defaults): apply changes to previous function. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-at-reference-p): first check if + point is at the beginning of a footnote. Indeed `org-in-regexp' + first checks backwards and might find an incorrect footnote if + they are side-by-side. + +2011-07-28 Michael Brand <michael.ch.brand@gmail.com> + + * org-agenda.el (org-agenda-compact-blocks): Improve docstring. + (org-agenda-block-separator): Add nil to docstring and customization. + (org-prepare-agenda): Skip agenda block separator additionally if + org-agenda-block-separator is nil. + (org-agenda-overriding-header): Improve docstring. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-set-tags): Remove useless + `org-without-partial-completion'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-footnote.el (org-fill-paragraph): Declare function for the + compiler. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-narrow-to-subtree): Declare unknown function. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-inline-lob-one-liner-regexp): Declare variable + to appease compiler. + +2011-07-28 Michael Markert <markert.michael@googlemail.com> + + * ob.el (org-babel-sha1-hash): Adding optional argument KIND to + all org-called-interactively-p function invocations. + + * org-agenda.el (org-agenda-redo): Adding optional argument KIND + to all org-called-interactively-p function invocations. + (org-agenda-show-1): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-agenda-set-tags): Adding optional argument KIND to all + org-called-interactively-p function invocations. + + * org-ascii.el (org-export-as-latin1): Adding optional argument + KIND to all org-called-interactively-p function invocations. + (org-export-as-latin1-to-buffer): Adding optional argument KIND to + all org-called-interactively-p function invocations. + (org-export-as-utf8-to-buffer): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-export-region-as-ascii): Adding optional argument KIND to all + org-called-interactively-p function invocations. + + * org-docbook.el (org-export-region-as-docbook): Adding optional + argument KIND to all org-called-interactively-p function + invocations. + + * org-html.el (org-export-region-as-html): Adding optional + argument KIND to all org-called-interactively-p function + invocations. + + * org-latex.el (org-export-region-as-latex): Adding optional + argument KIND to all org-called-interactively-p function + invocations. + + * org-table.el (org-table-blank-field): Adding optional argument + KIND to all org-called-interactively-p function invocations. + (org-table-current-column): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-table-current-dline): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-table-sort-lines): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-table-sum): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-table-rotate-recalc-marks): Adding optional argument KIND to + all org-called-interactively-p function invocations. + (org-table-eval-formula): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (orgtbl-send-table): Adding optional argument KIND to all + org-called-interactively-p function invocations. + + * org.el (org-mode): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-copy-subtree): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-paste-subtree): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-store-link): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-todo): Adding optional argument KIND to all + org-called-interactively-p function invocations. + (org-occur): Adding optional argument KIND to all + org-called-interactively-p function invocations. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-action): offer to create + definition when none is found. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-re): avoid matching inactive + time-stamps or check-box cookies. + (org-footnote-next-reference-or-definition): adapt to the new regexp. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-preprocess-string): if the last subtree + is commented, footnotes inserted during normalizing at the end of + the buffer may get deleted. This patch ensures deletion comes + first, normalization second. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-footnotes-data): change docstring. + (org-export-footnotes-seen): renamed from + org-export-footnotes-markers. + + * org-ascii.el (org-export-as-ascii): apply change. + + * org-docbook.el (org-export-as-docbook): apply change. + + * org-footnote.el (org-footnote-normalize): apply change. + + * org-html.el (org-export-as-html): apply change. + + * org-latex.el (org-export-as-latex): apply change. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-preprocess): rely on + `org-export-footnotes-markers' to retreive definition of the + current footnote during export. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-normalize): remember footnotes + seen so far by the exporter when choosing the new marker. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-normalize): make use of + `org-footnote-insert-pos-for-preprocessor'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-normalize): add `org-footnote' + property to footnote markers when preparing for exportation. + + * org-html.el (org-export-as-html): read new property to decide + when to export a footnote. + + * org-docbook.el (org-export-as-docbook): read new property to + decide when to export a footnote. + + * org-latex.el (org-export-latex-preprocess): ensure footnote at + column 0 cannot end a list containing it by adding + `original-indentation' property to it. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp (org-export-preprocess-string): normalize footnotes + before marking lists ending. + + * org-latex.el (org-export-latex-preprocess): work with labels as + strings and not as numbers. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-docbook.el (org-export-docbook-footnote-separator): new + variable + (org-export-as-docbook): add a separator between footnotes. + + * org-html.el (org-export-html-footnote-separator): new variable. + (org-export-as-html): add a separator between footnotes. + + * org-latex.el (org-export-latex-footnote-separator): new + variable. + (org-export-latex-preprocess): add a separator between footnotes. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-footnotes-markers) + (org-export-footnotes-data): new variables. + (org-export-preprocess-string): use a more explicit argument. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-goto-definition): now, determining + if point is at a footnote reference is entirely determined by + `org-footnote-at-reference-p'. No need to check if pattern isn't + at beginning of the line elsewhere. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-next-reference-or-definition): new + function. + + * org.el (org-activate-footnote-links): activate the whole + footnote, but only fontify its label. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-normalize): make use of changes to + `org-footnote-at-reference-p' and creation of various functions.. + Also comment code. + (org-footnote-get-next-reference, org-footnote-delete-references, + org-footnote-delete-definitions): new functions + (org-footnote-goto-previous-reference, org-footnote-all-labels, + org-insert-footnote-reference-near-definition, org-footnote-delete): + rewrite to use org-footnote-get-next-reference. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-footnote.el (org-footnote-re): don't end an inline footnote + at unrelated closing square brackets. + (org-footnote-at-reference-p): improve accuracy of the function to + determine if point is at a reference and to extract definition of an + inline footnote. + (org-footnote-all-labels, org-footnote-action, org-footnote-delete, + org-footnote-auto-adjust-maybe): make use of previous function. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-deadline, org-schedule): + keep warning cookie when rescheduling/redeadlining. + (org-time-stamp): Fix problem with warning cookie. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-execute:clojure): Force escaping of + clojure source into elisp source. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-script-escape): Treats {} in the same manner as + [] and allows for forcing string conversion. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-select-backend-specific-text): Strip + protective commas from literal code blocks. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-goto-headline-id): Fix bug. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-goto-headline-id): Split out into its + own function. + (org-babel-ref-headline-body): Split out into its own function. + (org-babel-ref-resolve): Using new functions, and alignment. + + * ob.el (org-babel-ref-goto-headline-id): Declare function. + (org-babel-ref-headline-body): Declare function. + (org-babel-expand-noweb-references): Now expands noweb references to + headlines during expansion. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-resolve): Now resolves references to + headlines by either global or custom id, in which case the + contents of the headline are returned literally. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-in-example-or-verbatim): Also check for in + verbatim emphasis. + (org-babel-exp-lob-one-liners): Cleaner checking for escaped call + lines. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): cycling back to + original position deleted any additional information in the item, + like a counter or a tag. + +2011-07-28 Pieter Praet <pieter@praet.org> + + * org-crypt.el (org-crypt-disable-auto-save): New defcustom. + (org-decrypt-entry): before decrypting, check whether + `auto-save-mode' is enabled for the current buffer, and act on it + according to how `org-crypt-disable-auto-save' is set. Remove + comment re "encrypt[ing] Org auto-saved buffers". Remove on-init + check for `auto-save-default'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-merge-params): Ensure variable parameters are + not reversed. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): Fix results insertion for + inline blocks which happen to start a line. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-lob-one-liners): Fix the logic checking + if a call line is commented. + +2011-07-28 Vincent Belaïche <vincentb1@users.sourceforge.net> + + * org.el (org-read-property-name): Propose default property name. + +2011-07-28 Achim Gratz <stromeko@nexgo.de> + + * org.el (defcustom org-log-into-drawer): correct typo + + * org-clock.el (org-clock-into-drawer): New function to change the + location of clock events based on properties CLOCK_INTO_DRAWER or, + as fallback, LOG_INTO_DRAWER, like it is already possible for + state change logs. + + * org-clock.el (org-clock-jump-to-current-clock): add statement to + let clause to bind org-clock-into-drawer to result of function + eval + + * org-clock.el (org-clock-find-position): add statement to let + clause to bind org-clock-into-drawer to result of function eval, + change let to let* since the binding is used later in the same + clause + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (require): Ensure 'cl is loaded during compilation so + we can use flet. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-get-info): Correctly indent results of + non-inline call lines. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-lob-one-liners): Don't export inline + call_ blocks which aren't whitespace padded. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-merge-params): Do not reverse variable order, + and be sure to increment variable index as appropriate. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-inline-lob-one-liner-regexp): Updated to + successfully match optional trailing header arguments in square + brackets. + (org-babel-lob-get-info): Updated to match the new regexp. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-get-info): If the arguments are empty, + then allow them to be so. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-merge-params): If variables are not named they + are assigned in order. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el: Remove code comment about online documentation. + + * ob-exp.el: Remove code comment about online documentation. + + * ob-lob.el: Remove code comment about online documentation. + +2011-07-28 Jambunathan K <kjambunathan@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Fix + signature of org-<backend>-format-source-code-or-example function. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-sha1-hash): Replace call to + called-interactively-p with backwards-compatible interactive-p. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-lob-one-liners): Appropriate + replacement of inline call blocks with their results. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-inline-lob-one-liner-regexp): Removing this + trailing space ensures that the insertion of the results looks + nice. + + * ob.el (org-babel-insert-result): Insert inline lob line results + as inline results. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-lob-one-liners): Calculate length + appropriately given the style (block or inline) of the lob line. + + * ob-lob.el (org-babel-block-lob-one-liner-regexp): New regexp + specific for block lob lines. + (org-babel-inline-lob-one-liner-regexp): New regexp specific for + inline lob lines. + (org-babel-lob-one-liner-regexp): Combination of two lob regexps. + (org-babel-lob-get-info): Return info from *either* the block or + inline lob lines. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-lob-one-liners): Corrected the + structure of the resulting info list. + + * ob-lob.el (org-babel-default-lob-header-args): Export the + results of call lines by default. + +2011-07-28 Niels Giesen <niels.giesen@gmail.com> (tiny change) + + * org-icalendar.el (org-print-icalendar-entries): Add 'uid text + property based on the ID property of the org entry to the first + character of the diary entry. + +2011-07-28 Jambunathan K <kjambunathan@gmail.com> + + * org-footnote.el + (org-footnote-insert-pos-for-preprocessor): New variable. + (org-footnote-normalize): Use it. + +2011-07-28 Jambunathan K <kjambunathan@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): + Simplify. Also add `org-native-text' as a text property to the + formatted text and throw error for unknown backends. + +2011-07-28 Jambunathan K <kjambunathan@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Add + support for: - custom formatters for existing backends - seamless + plugging in of new backends. + +2011-07-28 Jambunathan K <kjambunathan@gmail.com> + + * org-exp.el (org-export-backends): New variable. + (org-export-select-backend-specific-text): Use above + variable. Also mark text between #+BACKEND and + #+BEGIN_BACKEND...#+END_BACKEND with org-native-text + property. This text property is currently used only by the new + line-oriented generic exporter (which is not yet part of the + repo). + +2011-07-28 Jambunathan K <kjambunathan@gmail.com> + + * org-exp.el (org-export): Reserve keys 'o' and 'O' for + OpenDocumentText export and bind them to org-export-as-odt and + org-export-as-odt-and-open. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-src-block): Less verbose when in batch + mode. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-execute:clojure): Convert vectors to + lists before reading into emacs-lisp. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el (ob-tangle): initialize variable from ob-tangle. + + * ob-asymptote.el (ob-tangle): initialize variable from ob-tangle. + + * ob-awk.el (ob-tangle): initialize variable from ob-tangle. + + * ob-clojure.el (ob-tangle): initialize variable from ob-tangle. + + * ob-haskell.el (ob-tangle): initialize variable from ob-tangle. + + * ob-latex.el (ob-tangle): initialize variable from ob-tangle. + + * ob-lisp.el (ob-tangle): initialize variable from ob-tangle. + + * ob-ocaml.el (ob-tangle): initialize variable from ob-tangle. + + * ob-perl.el (ob-tangle): initialize variable from ob-tangle. + + * ob-python.el (ob-tangle): initialize variable from ob-tangle. + + * ob-ruby.el (ob-tangle): initialize variable from ob-tangle. + + * ob-tangle.el (ob-tangle): initialize variable from ob-tangle. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-awk.el: New file. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-emacs-lisp.el (org-babel-execute:emacs-lisp): Respects + ":results verbatim". + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-float): Aliases for `diary-float'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-python-evaluate-session): Send + comint-send-input after every line when interacting with an + interactive python process. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-reset-checkbox-state-subtree): make the command + more robust, and correctly update check-boxes in the whole + sub-tree. + (org-update-checkbox-count): fix bug accumulating count of checkboxes + when walking a subtree. + (org-update-checkbox-count-maybe): add an optional argument passed to + org-update-checkbox-count. + +2011-07-28 Ted Zlatanov <tzz@lifelogs.com> + + * org.el (org-fontify-meta-lines-and-blocks): Ignore errors. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-emacs-lisp.el (org-babel-execute:emacs-lisp): Respect the + ":results scalar" header argument combination. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org-src.el: Append a space character to copied text so that the + final text property change is picked up correctly. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-file): Use the new argument list + to org-babel-tangle. + (org-babel-tangle): Now when called with a prefix argument, only the + current code block is tangled. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-parse-list): replace transitional + check-boxes with "[CBTRANS]" string during parsing. + (org-list-to-generic): use the new property `:cbtrans' to configure + export string for transitional check-boxes. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-add-entry-to-org-agenda-diary-file): + Use stable internal `org-anniversary' instead of + diary-anniversary. + (org-class): New function. + (org-diary-class): Use `org-class'. + (org-anniversary, org-cyclic, org-date, org-block): New functions. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-header-arg-names): Adding noweb-ref to the list + of header argument names. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-expand-noweb-references): Concatenating all + bodies with the appropriate name or :noweb-ref header argument. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) + + * org.el (org-find-dblock): + (org-clocktable-try-shift): Make regexp work also when #+begin + line is indentex. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-src-block-regexp): Babel: code block may have + empty bodies. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-macs.el (org-without-partial-completion): Avoid calling by + name a function unknown to the compiler but explicitly checked by + program logic. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-mouse.el (org-agenda-earlier): Declaring previously unknown + function. + (org-agenda-later): Declaring previously unknown function. + (org-agenda-mode-map): Declaring previously unknown variable. + + * org.el (org-read-date-analyze): Explicitly ignore the return + value of a function. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-agenda.el (org-agenda-mode): Globally replace + buffer-substring-filters with filter-buffer-substring-functions. + + * org-indent.el (org-indent-mode): Globally replace + buffer-substring-filters with filter-buffer-substring-functions. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-ascii.el (org-export-as-ascii): Replacing '(λ...) with + #'(λ...). + + * org-attach.el: Replacing '(λ...) with #'(λ...). + (org-attach-commit): Replacing '(λ...) with #'(λ...). + + * org-exp.el: Replacing '(λ...) with #'(λ...). + (org-export-handle-include-files): Replacing '(λ...) with #'(λ...). + + * org-html.el: Replacing '(λ...) with #'(λ...). + (org-export-as-html): Replacing '(λ...) with #'(λ...). + + * org-mouse.el: Replacing '(λ...) with #'(λ...). + (org-mouse-popup-global-menu): Replacing '(λ...) with + (org-mode-hook): Replacing '(λ...) with #'(λ...). + (org-agenda-mode-hook): Replacing '(λ...) with #'(λ...). + + * org-src.el: Replacing '(λ...) with #'(λ...). + (org-src-mode-configure-edit-buffer): Replacing '(λ...) with #'(λ...). + + * org-table.el: Replacing '(λ...) with #'(λ...). + (org-table-fix-formulas-confirm): Replacing '(λ...) with #'(λ...). + + * org.el: Replacing '(λ...) with #'(λ...). + (org-confirm-shell-link-function): Replacing '(λ...) with + (org-category): Replacing '(λ...) with #'(λ...). + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org.el (mailcap-parse-mailcaps): Declaring functions used by + `org-open-file'. + (mailcap-extension-to-mime): Declaring functions used by + `org-open-file'. + (mailcap-mime-info): Declaring functions used by `org-open-file'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-agenda.el (org-agenda-redo): Replacing call to now-defunct + function `interactive-p'. + (org-agenda-show-1): Replacing call to now-defunct function + `interactive-p'. + (org-agenda-set-tags): Replacing call to now-defunct function `interactive-p'. + + * org-ascii.el: Replacing call to now-defunct function + `interactive-p'. + (org-export-as-latin1): Replacing call to now-defunct function + `interactive-p'. + (org-export-as-latin1-to-buffer): Replacing call to now-defunct + function `interactive-p'. + (org-export-as-utf8): Replacing call to now-defunct function + `interactive-p'. + (org-export-as-utf8-to-buffer): Replacing call to now-defunct function + `interactive-p'. + (org-export-region-as-ascii): Replacing call to now-defunct function + `interactive-p'.Replacing call to now-defunct function `interactive-p'. + + * org-docbook.el: Replacing call to now-defunct function + `interactive-p'. + (org-export-region-as-docbook): Replacing call to now-defunct function + `interactive-p'.Replacing call to now-defunct function `interactive-p'. + + * org-html.el: Replacing call to now-defunct function + `interactive-p'. + (org-export-region-as-html): Replacing call to now-defunct function + `interactive-p'.Replacing call to now-defunct function `interactive-p'. + + * org-latex.el: Replacing call to now-defunct function + `interactive-p'. + (org-export-region-as-latex): Replacing call to now-defunct function + `interactive-p'.Replacing call to now-defunct function `interactive-p'. + + * org-macs.el: Replacing call to now-defunct function + `interactive-p'. + (org-called-interactively-p): Replacing call to now-defunct function + `interactive-p'.Replacing call to now-defunct function `interactive-p'. + + * org-table.el: Replacing call to now-defunct function + `interactive-p'. + (org-table-blank-field): Replacing call to now-defunct function + `interactive-p'. + (org-table-current-column): Replacing call to now-defunct function + `interactive-p'.Replacing call to now-defunct function + `interactive-p'. + (org-table-current-dline): Replacing call to now-defunct function + `interactive-p'.Replacing call to now-defunct function + `interactive-p'. + (org-table-sort-lines): Replacing call to now-defunct function + `interactive-p'. + (org-table-sum): Replacing call to now-defunct function + `interactive-p'. + (org-table-rotate-recalc-marks): Replacing call to now-defunct + function `interactive-p'. + (org-table-eval-formula): Replacing call to now-defunct function + `interactive-p'. + (orgtbl-send-table): Replacing call to now-defunct function `interactive-p'. + + * org.el: Replacing call to now-defunct function `interactive-p'. + (org-mode): Replacing call to now-defunct function `interactive-p'. + (org-copy-subtree): Replacing call to now-defunct function + `interactive-p'. + (org-paste-subtree): Replacing call to now-defunct function + `interactive-p'. + (org-store-link): Replacing call to now-defunct function + `interactive-p'. + (org-todo): Replacing call to now-defunct function `interactive-p'. + (org-occur): Replacing call to now-defunct function `interactive-p'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-R.el (ess-local-process-name): This variable wasn't known to + be defined. + + * ob-lisp.el (org-babel-lisp-dir-fmt): This defcustom now has a + group specified. + + * ob-tangle.el (org-bracket-link-regexp): This variable wasn't + known to be defined. + (org-babel-tangle-combine-named-blocks): Roll my own version of a + forbidden common lisp function. + + * ob.el (org-babel-sha1-hash): Using a non-deprecated version of + called-interactively. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-tables): Check for the + "multiline" option and set the `floatp' option to true when + multicolumn tables are requested. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-as-html): + (org-html-level-start): Only convert section number underscores to dashes. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-bulk-action): Fix bug caused by + `days-to-time, converting relative to 1 BC, while the code assumed + it would return a time relative to 1970. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-combine-named-blocks): No longer + inserting newlines between appended code blocks. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el: We may no longer need to export names along with code + blocks. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-preprocess): Ensure + balanced nested begin/end blocks in block bodies. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org-latex.el: Add -shell-escape to pdflatex commands. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-named-block-combination): Block + combination can now take a number of values. + (org-babel-tangle-combine-named-blocks): More sophisticated block + combination behavior. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-do-combine-named-blocks): Switch + to turn on the combination of code blocks of the same name. + (org-babel-tangle-combine-named-blocks): Combine blocks of the same + name. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ruby.el (xmp): Declaring this function to appease the + compiler. + (org-babel-execute:ruby): "xmp" result option for outputting + annotated source code. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> (tiny change) + + * org-list.el (org-list-to-latex): the enumerate environment in + latex increments the counter before using it. Therefore, org-mode + should set the enumeration counter to the desired value minus one. + +2011-07-28 Michael Brand <michael.ch.brand@gmail.com> (tiny change) + + * org.el (org-toggle-heading): More comments and fix number of + stars when toggling from list items. + +2011-07-28 Christian Egli <christian.egli@sbszh.ch> + + * org-taskjuggler.el (org-taskjuggler-clean-effort): handle any + effort that is accepted by `org-duration-string-to-minutes´. + +2011-07-28 Julien Barnier <julien@nozav.org> + + * ob-sh.el (org-babel-sh-evaluate) : when sending input to comint, + wait until previous line execution is finished + + * ob-comint.el (org-babel-comint-with-output) : when looking for + end-of-evaluation indicator, search forward for the indicator + before searching forward for the prompt + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-entities.el (org-entities): Fix HTML entity for degree. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-auto-align-tags): change docstring. + (org-update-parent-todo-statistics): keep tags aligned even when + statistics cookies are shifting them. + + * org-list.el (org-update-checkbox-count): keep tags aligned even + when statistics cookies are shifting them. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * ob.el (org-babel-sha1-hash): Don't modify info argument by + side-effect when sorting result-params list. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * ob.el (org-babel-result-regexp): Use non-shy group around + org-babel-data-names. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-link): Set truncate-line in the *Org Link* + buffer and make sure that it really is set there. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lisp.el (org-babel-lisp-dir-fmt): Defcustom for use in + changing how/if the current directory is represented to lisp code. + (org-babel-execute:lisp): More general handling of the default + directory value. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lisp.el (org-babel-execute:lisp): Setting the value of + *default-pathname-defaults* to either the value of the :dir header + argument or the directory of the containing Org-mode file. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lisp.el (org-babel-execute:lisp): No real functional change, + just aesthetic. + +2011-07-28 Sébastien Delafond <sdelafond@gmail.com> + + * org.el (org-mode-flyspell-verify): This is useful when using + flyspell with a non-English dictionary, or if some of your + keywords are in another language. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-exp.el (org-export): Use new compatibility function + `org-activate-mark'. + + * org-compat.el (org-activate-mark): New function. Provide + `activate-mark' if not present (e.g. Emacs22). + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-table.el (org-table-follow-field-mode): Declare variable to + keep byte compiler happy. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-footnote.el (org-id-uuid): Declare function, silence byte + compiler. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-bibtex.el (org-bibtex-headline): Don't use equalp at + run-time, compare downcased strings. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-bibtex.el (org-id-locations): Declare variable to silence + byte compiler. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-id.el (org-id-locations): Fix docstring, remove reference to + non-existent option. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-self-insert-command): Use `delete-char' instead of + `delete-backward-char'. + + * org-table.el (orgtbl-self-insert-command): Dto. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-special-chars): Save match data + when checking for table.el table. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-re-property): Move before its first use. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-preprocess): add + `original-indentation' property to footnotes so they cannot + possibly end a list by being less indented than the item they + belong to. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lisp.el (org-babel-expand-body:lisp): No longer wraps biddies + in `progn'. + (org-babel-execute:lisp): Wraps bodies in `progn' as they are passed + to swank. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clocktable-write-default): Implement adding + property columns to the clock table. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-toggle-item): Move parenthesis to correct location. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-default-priority): + (org-priority-start-cycle-with-default): Improve docstring. + (org-priority): Throw error when priority is out of range. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-self-insert-command): Catch the case of + buffer-undo-list eq t. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-toggle-heading): region should be considered as made + of full lines, without the last one if region-end is at bol. + Removed unused variables. Refactored and commented code. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-toggle-item): when region includes an headline less + indented than first one, set it as the new reference. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-to-subtree): if the list is before first + heading and `org-odd-levels-only' is non-nil, the first item gets + two stars instead of one. + + * org.el (org-reduced-level): a level of 0 was reduced to 1 with + `org-odd-levels-only' non-nil. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-toggle-item): converting an heading to an item would + sometimes insert unnecessary spaces before it, and unwanted space + with `org-indent-mode' on. Changing some text into an item + wouldn't always preserve indentation. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-current-plist): Improve docstring. + (org-capture-put): Add docstring. + (org-capture-get): Add docstring. + (org-capture-member): Add LOCAL argument. Add docstring. + (org-capture-set-target-location): Store the time received from a date + prompt into the :prompt-time property. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-mark-list-properties): even if context is + invalid, mark list item with `list-context' property. + + * org-list.el (org-list-forbidden-blocks): add exporters specific + blocks to the list of forbidden blocks. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-sort-list): function tries to intern + getkey-func before it is defined, so it's always nil. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-babel-load-languages): Adding ob-awk to the list of + executable languages. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-get-field): Make sure the new field + content is at least one space character. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-crypt.el: Check for `daemonp' before using it. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-sh.el (ob-ref): Uses ob-ref to resolve the value of the + :stdin header argument. + (org-babel-execute:sh): Use the :stdin header argument. + (org-babel-sh-var-to-sh): Split the bulk of this function off into a + new sub-function. + (org-babel-sh-var-to-string): New function for converting elisp + values to strings that make sense for parsing with sh. + (org-babel-sh-evaluate): Adding "stdin" option to session and + external evaluation options. + +2011-07-28 Roland Kaufmann <rlndkfmn+orgmode@gmail.com> (tiny change) + + * org-exp.el (org-remove-formatting-on-newlines-in-region): New + function. + (org-export-format-source-code-or-example): Call + `org-remove-formatting-on-newlines-in-region'. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-entry-put): Prevent adding of extra space to value + if property already exists. + +2011-07-28 Jambunathan K <kjambunathan@gmail.com> + + * org-html.el (org-export-as-html): Don't expand non-data lines of + table.el tables. + (org-html-expand): Removed the (buggy) test for non-data lines + in table.el tables. The test is now done as part of + org-export-as-html. + (org-format-table-table-html-using-table-generate-source): + Added test for spanning of cells in table.el tables using + table.el's own library routine. Optionlly Suppress export of + simple table.el tables. + (org-format-table-html): Removed the (buggy) test for spanned + table.el tables. The test is now done as part of + org-format-table-table-html-using-table-generate-source. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-special-chars): Do nothing in + table.el tables. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture): Ignore errors when creating a + link. + +2011-07-28 Nick Dokos <nick@dokosmarshall.org> (tiny change) + + * org-exp.el (org-export-define-heading-targets): Use dash instead + of underscore to make labels valid. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-R.el (org-babel-R-write-object-command): Ensure that all data + is written to the results file before Emacs notices that the file + exists. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-code): Remove usage of a macro which is + defined locally on my system, but not globally in Emacs. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-do-export): Use `org-babel-exp-code' to + generate code block output. + (org-babel-exp-code): Re-create the code block body for exporting + source code. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) + + * org.el (org-read-date): Bury Calendar buffer after using it for + selecting a date. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-separating-blank-lines-number): fix + confusion between point and item beginning. Now, if no information + is avalaible, truly follow user preference when it inserts blank + lines manually. + (org-list-insert-item): send correct argument to the preceding + function. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-src-block-regexp): Keep the now-mandatory + newline inside of the code block body. + +2011-07-28 Sean O'Halpin <sean.ohalpin@gmail.com> + + * ob.el: Avoid spurious matches to literal. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): don't include #+include + lines. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-keys.el (org-babel-key-bindings): Adding key sequence for + org-babel-check-src-block. + + * ob.el (org-babel-expand-src-block): Fit within 80 cols. + (org-babel-edit-distance): Returns the edit distance of two strings. + (org-babel-check-src-block): Check a code block for errors. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) + + * org-capture.el (org-capture-templates): Fix bug in customization + setup. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el + (org-table-exit-follow-field-mode-when-leaving-table): New option. + (org-table-check-inside-data-field): New optional argument `noerror'. + When set, the function will only return nil instead of throwing an + error. + (org-table-edit-field): Interpret double prefix argument, and improve + the properties of the editing window. + (org-table-follow-field-mode): New minor mode. + (org-table-follow-fields-with-editor): New function. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-todos): Call `org-agenda-skip' + first, then check if timestamps cause exclusion. + + * org.el (org-scan-tags): Call `org-agenda-skip' first, then check + if timestamps cause exclusion. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-full-item-re): allow description term to + have a newline character after the colons. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-sort-list): no longer ignore with-case + argument: the function sorted case-sensitively, regardless of + argument. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-resolve): Using the new result regexp. + + * ob.el (org-babel-data-names): Configurable list of names of + data. + (org-babel-result-regexp): Using new results regexp. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-special-properties): Add CLOCKSUM to the special + properties. + +2011-07-28 Robert P. Goldman <rpgoldman@real-time.com> + + * ob-exp.el (org-babel-exp-in-export-file): Bind + `org-link-search-inhibit-query' to t to inhibit prompts. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-contacts.el: Merge org-contacts-wl.el. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-add-options-to-plist): Use the right + match group. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Protect index string + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Pipe index entries + through org-export-latex-fontify-headline. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-add-options-to-plist): Fix the option + parser + +2011-07-28 Robert P. Goldman <rpgoldman@real-time.com> + + * org-latex.el (org-export-latex-preprocess): Replace index + entries. + +2011-07-28 Robert P. Goldman <rpgoldman@real-time.com> + + * org.el (org-structure-template-alist): Add an easy template for + index (i), and move include file to I from i. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-agenda.el (org-agenda-open-link): Pass entire text of agenda + line to org-offer-links-in-entry. + +2011-07-28 Michael Markert <markert.michael@googlemail.com> + + * org-contacts-wl.el: New file. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-bibtex.el (org-bibtex-search): New function. + (org-bibtex-export-to-kill-ring): New function. Export to kill + ring. + (org-bibtex-create-in-current-entry): New function + (org-bibtex-create): Make it easier to add bib fields to an + existing headline. + (org-bibtex-export-arbitrary-fields) + (org-bibtex-treat-headline-as-title): Fix typos + (org-bibtex-fleshout): Don't upcase optional field; remove ":" from + type completion. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-bibtex.el (org-bibtex-treat-headline-as-title): New + defcustom. + (org-bibtex-headline): Only use headline text (not TODO or other + metadata) to generate title field and auto key. + (org-bibtex-fleshout): Allow user to choose whether to treat + headline as title. + +2011-07-28 Tom Dye <tsd@tsdye.com> + + * org-bibtex.el: Added crossref field to other fields + +2011-07-28 Tom Dye <tsd@tsdye.com> + + * org-bibtex.el: Add crossref option to incollection + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-bibtex.el (org-bibtex-headline): Don't export TYPE property + as field. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-bibtex.el (org-bibtex-key-property): When storing key in ID, + warn if a duplicate ID is generated. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-bibtex.el (org-bibtex-tags): New variable + (org-bibtex-tags-are-keywords): New variable + (org-bibtex-no-export-tags): New variable + (org-bibtex-headline): Export tags as comma-separated bibtex keywords + (org-bibtex-read): Import bibtex keywords field as tags + +2011-07-28 Manuel Giraud <manuel.giraud@univ-nantes.fr> + + * org-publish.el (org-publish-find-date): optimization + +2011-07-28 Tassilo Horn <tassilo@member.fsf.org> + + * org-gnus.el (org-gnus-follow-link): Don't request scan of group + when following link. + +2011-07-28 Manuel Giraud <manuel.giraud@univ-nantes.fr> + + * org-publish.el (org-publish-project-alist): Document new + :sitemap-sans-extension property. + (org-publish-org-sitemap): Use new sitemap-sans-extension setting. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-remove-uninherited-tags): Renamed from + org-remove-iniherited-tags. + (org-scan-tags): Fix typo in function call. + (org-get-tags-at): Fix typo in function call. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org.el (org-get-tags-at): Don't include filetags if local is t. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-expand-body:clojure): Qualify pp + dispatch functions, wrap body in `(do )'. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-fontify-meta-lines-and-blocks): Fix bug which + resulted in the creation of multiple overlays in src blocks. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-execute:clojure): If results are not + readable by lisp, then return them as a string. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-bibtex.el (org-bibtex): Now prompts for a file name. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-bibtex.el (org-bibtex-create): Adding prefix argument which + will result in prompting for optional fields. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-bibtex.el (org-bibtex-headline): Renamed flet function `get' + which was causing compile problems. + (org-bibtex-fleshout): Renamed flet function `get' which was causing + compile problems. + (org-bibtex-write): Renamed flet function `get' which was causing + compile problems. + +2011-07-28 Christian Egli <christian.egli@sbszh.ch> + + * org-taskjuggler.el (org-taskjuggler-clean-id): Make sure an id + never starts with a number. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-bibtex.el (org-bibtex-export-arbitrary-fields): New option. + (org-bibtex-key-property): New option. + (org-bibtex-put): Make use of new `org-bibtex-key-property' variable. + (org-bibtex-headline): Make use of new + `org-bibtex-export-arbitrary-fields' and `org-bibtex-key-property' + variables. + (org-bibtex-autokey): Make use of new `org-bibtex-key-property' + variable. + (org-bibtex-fleshout): Make use of new `org-bibtex-key-property' + variable. + (org-bibtex-write): Make use of new `org-bibtex-key-property' + variable. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-bibtex.el: Updating Copyright dates, author information, + commentary and history notes. + (org-bibtex-types): List of bibtex types with descriptions and + required and optional fields. + (org-bibtex-fields): List of bibtex fields with descriptions. + (*org-bibtex-entries*): Special variable to hold parsed bibtex + entries. + (org-bibtex-autogen-keys): Custom variable controlling whether + bibtex keys are automatically generated + (org-bibtex-prefix): Custom variable allowing use of optional prefix + for bibtex properties in Org-mode headlines. + (org-bibtex-get): Helper function for accessing bibtex elements of a + property list. + (org-bibtex-put): Helper function for inserting bibtex element into + a property list. + (org-bibtex-headline): Return a bibtex entry of the given headline + as a string. + (org-bibtex-ask): Prompt the user to fill in the value of a bibtex + field. + (org-bibtex-autokey): Generate a bibtex key for the current + headline. + (org-bibtex-fleshout): Fill in missing bibtex properties of the + current headline. + (org-bibtex): Export the current Org-mode buffer to a bibtex buffer. + (org-bibtex-check): Check that all bibtex properties are present in + the current headline. + (org-bibtex-check-all): Check all headlines in the current buffer. + (org-bibtex-create): Create a new bibtex headline at the current + level. + (org-bibtex-read): Read the current bibtex entry from a bibtex file. + (org-bibtex-write): Write the most recently read bibtex entry into + an Org-mode file. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-clock-consistency-checks): Allow to + set properties. + (org-agenda-show-clocking-issues): Handle faces. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ditaa.el (org-babel-default-header-args:ditaa): Specify utf8 + content by default with "-Dfile.encoding=UTF-8". + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ditaa.el (org-babel-execute:ditaa): New ":java" header + argument. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-preprocess-string): mark list end before + expanding macros. Thus, a macro inside a list and containing blank + lines cannot break the list structure. + (org-export-preprocess-apply-macros): multi-lines macros get + indented with the same indentation as the first line. Thus, we are + sure that every line belongs to the same list as the first line, if + such list exists. Also add comments in code. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-clock-consistency-checks): New option. + (org-agenda-list): Handle display change to clock check. + (org-agenda-get-progress): Show only clock entries if we are doing the + consistency check. + (org-agenda-show-clocking-issues): New function. + (org-agenda-check-clock-gap): New function. + (org-agenda-view-mode-dispatch): Offer consistency check. + (org-agenda-log-mode): Handle switch to clock only display. + (org-agenda-set-mode-name): Show lighter for Clockcheck. + + * org.el (org-hh:mm-string-to-minutes): Accept an integer argument + and return it unchanged. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct): when walking down the list, the + function would not pay attention to drawers or blocks indentation. + Thus, such constructs couldn't consistently end an item or a list. + This patch ensures line indentation is stored (if applicable) + before skipping them. Also fixed doc-string and comments. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export): Add EXPORT_FILE_NAME to the enclosing + tree properties + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export): Define a bound for finding enclosing + tree with class/title definition. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export): Go to next heading before searching + backward, so make this also work if we are on the headline of the + entry with the property... + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-promote): + (org-demote): Soften the previous change, by only removing the + flyspell function from after-change functions, because that was the + one causing the slowdown - at least much of it. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-promote): + (org-demote): Turn off after-change-functions to speed up the + reindentation of text. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ocaml.el (org-babel-ocaml-read-list): Using + `org-babel-script-escape'. + (org-babel-ocaml-read-array): Using `org-babel-script-escape'. + +2011-07-28 Manuel Giraud <manuel.giraud@univ-nantes.fr> + + * org-html.el (org-html-handle-links): add an alternate for inline + images + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-bulk-action): Do not use the entries + variable before it is defined + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-src.el (org-src-lang-modes): Added a language alias of "C" + to "c". + +2011-07-28 Shaun Johnson <shaun@slugfest.demon.co.uk> (tiny change) + + * ob-tangle.el (org-babel-tangle): Make it work in an indirect + buffer. + +2011-07-28 Manuel Giraud <manuel.giraud@univ-nantes.fr> + + * org-html.el (org-html-make-link): correct a bug in coderef link. + +2011-07-28 Bernt Hansen <bernt@norang.ca> + + * org-agenda.el (org-agenda-filter-by-tag): Fix variable name typo + +2011-07-28 Bernt Hansen <bernt@norang.ca> + + * org-agenda.el (org-agenda-get-timestamps): Fix agenda display + when headlines are missing + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-mobile.el (org-mobile-push): Move call to hook, make it the + first thing of the push operation. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-params-from-buffer): Now looking for header + arguments in #+Properties: as well as #+Babel:. Also, we're no + longer caching these results into a file local variable. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-python-evaluate-external-process): Allow + parsing as a table in the case of ":results output table". + (org-babel-python-evaluate-session): Allow parsing as a table in + the case of ":results output table". + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-bulk-action): Allow bulk scatter in + all possible agenda views. Use `org-agenda-schedule' instead of + `org-agenda-date-later'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-emacs-lisp.el (org-babel-execute:emacs-lisp): Now supports + ":results output". + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org.el (org-entry-get): + (org-entry-delete): + (org-entry-put): + (org-property-values): + (org-delete-property-globally): Use org-re-property. + (org-re-property): New function allowing to build a regexp to match a + property. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org.el (org-property-values): Enhance docstring. + +2011-07-28 Ethan Ligon <ligon@are.berkeley.edu> + + * Illustration of bug in html export - This has a space after the + colons :: so will work in latex and html - This doesn't have a + space after the colons ::so is an invalid description item + according to the org manual. Won't work in html or docbook. Will + nevertheless work in latex, provided /first/ description item is + valid. - Has a terminating space :: - So it works in both html + and latex export! - Even though it's difficult to distinguish + from the next example. - Lacks a terminating space :: - At + present, *doesn't* work in html or docbook export, does in latex. + This is the case that the following patch fixes. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-table.el (org-table-cleanup-narrow-column-properties): Use + point-min rather than 1 when moving in the buffer. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-in-valid-context-p): renamed from + org-list-in-valid-block-p. + (org-at-item-p,org-list-search-generic): use renamed function. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-set-font-lock-defaults): Be more strict when + recognizing description items, and do not fontify wrong cases + like: "- term ::description" or "1. term :: description" + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el: pay attention to end of footnote. Before closing + the command, ensure that list is properly closed or that last link + is separated from the curly brace. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): footnote definition must stay + at column 0 to be recognized as such. Body below can have normal + indentation, so it should ignore its definition when computing + indentation. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-protocol.el (org-protocol-remember) + (org-protocol-capture): More appropriate message. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-capture.el (org-capture-clock-keep): New local variable. + (org-capture, org-capture-finalize): Use it and fix a bug when + :clock-keep is set to `t'. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) + + * org-exp.el (org-export-preprocess-string): Handle include files + before processing macros. + +2011-07-28 Bernt Hansen <bernt@norang.ca> + + * org-agenda.el: Remove obsolete code for adding todo list in + front of the agenda + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-latex.el (org-export-latex-convert-table.el-table): Fix + format-string for insertion of captions. + +2011-07-28 Nick Dokos <nicholas.dokos@hp.com> + + * org-exp.el (org-export-remove-comment-blocks-and-subtrees): Fix + regexp. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) + + * org.el (org-read-date-analyze): Help matching dotted European + dates, like 31. 12. 2007 + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lisp.el (org-babel-execute:lisp): Fix typo. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lisp.el (org-babel-execute:lisp): Turn vectors into lists + before reading by elisp + (org-bable-lisp-vector-to-list): Stub of a vector->list function, + should be replaced with a cl-vector->el-vector function. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lisp.el (org-babel-execute:lisp): Now using + `org-babel-reassemble-table' to apply the appropriate header + arguments to results. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-end-of-meta-data-and-drawers): New function. + + * org-capture.el (org-capture-place-plain-text): Implement adding + plain text templates to Org nodes. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-environments-extra): Fix docstring + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-exp.el (org-export-handle-comments): Add the org-protected + property to the replacement string. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-html.el (org-export-as-html) (org-html-level-start): Fix + logic for section number printing when NUM is an integer. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-latex.el (org-export-latex-special-chars): Fix regexp for + `single' special characters and ellipsis. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org.el (org-point-at-end-of-empty-headline): Bind + case-fold-search to nil. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-fill-template): Resolve new %<...> + template escape. + (org-capture-templates): Document new %<...> template escape. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-process-params): Make this function idempotent, + as it will sometimes be called multiple times. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-ts-regexp-both): Add "]" to class of characters that + should not be matched. + (org-ts-regexp0): + (org-ts-regexp1): Do not start a class with "^]-+", because that tries + to (not) match characters between "]" and "+". Instead, move the "-" + to the end of the class where it causes no harm. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-R.el (org-babel-edit-prep:R): Associate the appropriate R + process with the edit buffer when :session is specified. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Brought the link + extraction code into line with a newer version of the + org-store-link function. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-lisp.el (org-babel-expand-body:lisp): New body expansion + wrapping the expression in either a let or progn, and possibly a + pretty-print function invocation. + (org-babel-execute:lisp): Greatly simplified method of executing + lisp code blocks. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el: move org-update-checkbox-count-maybe call outside + of save-excursion to get back to original position. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-numbered-action-format): New option. + (org-new-numbered-action): New command. + (org-collect-todos-in-subtree): New command. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-with-tasks): New option. + (org-export-plist-vars): Add :tasks property. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-ascii.el (org-export-as-ascii): + + * org-docbook.el (org-export-as-docbook): + + * org-html.el (org-export-as-html): + + * org-latex.el (org-export-as-latex): Pass the :done-tasks + property to the export preprocessor. + + * org-exp.el (org-export-with-done-tasks): New option. + (org-export-plist-vars): Add entry for :done-tasks. + (org-export-preprocess-string): Call `org-export-remove-done-tasks'. + (org-export-remove-done-tasks): New function. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-keywords-maybe): Protect # in + tags. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-find-olp): Use the level of the correct match to + continue search. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-toggle-checkbox): build value of + org-keyword-time-regexp instead of using it directly, as it's + buffer-local, and function might be called outside Org. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct,org-in-item-p): don't assume end of + blocks or drawers necessarily start somewhere. It it isn't the + case, treat them as normal text. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-results): Use code block name when + finding cached results. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-latex.el (org-export-latex-date-format): Change default date + format to \today. This has the same result but respects the + language set in the document by default. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-checkbox): when called from an headline, + function would normally skip drawers, but not if a SCHEDULED or + DEADLINE keyword is standing before the drawer. Also avoid + problems if function is called in buffers not is Org mode. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-clock.el (org-clock-report): change the scope of the + inserted clock report depending on whether the point is within a + subtree (:scope subtree) or not (:scope file). + +2011-07-28 Puneeth Chaganti <punchagan@gmail.com> + + * org-html.el (org-export-as-html): Fix export of footnotes + containing lists, tables, quotes, etc. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-latex.el (org-export-latex-preprocess): Correctly match + starred command names. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-html.el (org-export-as-html): Get local value of + org-export-with-section-numbers from the buffer's plist. Deal + specially with the case the resulting value is an integer. + (org-html-level-start): New optional argument of the option plist used + instead of `org-export-with-section-numbers'. Also deal specially + with the case that the value is an integer. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-latex.el (org-export-latex-subcontent): Deal specially with + the case that NUM is an integer. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-protocol.el (org-protocol-do-capture): allow template keys + of two characters. + (org-protocol-default-template-key): Update the docstring to + reflect the change in `org-protocol-do-capture'. + +2011-07-28 Christian Egli <christian.egli@sbszh.ch> + + * org-taskjuggler.el: Fix a typo in the commentary. + +2011-07-28 Christian Egli <christian.egli@sbszh.ch> + + * org-taskjuggler.el (org-taskjuggler-open-task): Only emit a + "purge allocations" statement if we are not targeting tj3. + +2011-07-28 Christian Egli <christian.egli@sbszh.ch> + + * org-taskjuggler.el (org-taskjuggler-assign-resource-ids): + Replace recursive implementation with an iterative one. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-sh.el (org-babel-sh-var-to-sh): Fixed insertion of tabular + data into shell variables. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-html.el (org-html-handle-time-stamps): Protected linebreak + element after timestamp markup. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-html.el (org-html-handle-links): Don't protect img tag in + link description. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-formula-handle-first/last-rc): Bind + `char'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-in-item-p): re-build org-drawer-regexp, + whatever the major mode is. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-inlinetask.el (org-inlinetask-export-templates): fix default + templates. + (org-inlinetask-export-handler): Ensure contents of inline task, if + any, starts and ends with a newline character. Refactor and comment + code. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-datetree-find-date-create): Lower-case for + variable names in define-function form. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-convert-region): Throw error when + SEPARATOR is smaller than 1. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-colview.el (org-columns-display-here): Fix heading retrieval + in Org buffers. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-preprocess): last brace shouldn't + be on the same line as a list end marker. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org.el (org-icompleting-read): Do not use useless lambda. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-format-agenda-item): Fix length computing. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-format-agenda-item): Fix comment and use + `add-text-properties'. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-highlight-todo): Remove useless + `concat'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-to-generic): set a default term for + ill-formed description lists. Do not insert newline characters + unless told to. + (org-list-to-texinfo,org-list-to-html): apply changes to + `org-list-parse-liste'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-clock.el (org-clock-clocktable-language-setup): Add a + string. + (org-clocktable-write-default): Use the new localized string + in `org-clock-clocktable-language-setup'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-taskjuggler.el (org-taskjuggler-compute-task-leafiness): + (org-taskjuggler-assign-resource-ids): Replace recursive + implementation with an iterative one. + +2011-07-28 Christian Egli <christian.egli@alumni.ethz.ch> + + * org-taskjuggler.el (org-taskjuggler-components): Escape quotes + in headlines. + +2011-07-28 Christian Egli <christian.egli@alumni.ethz.ch> + + * org-taskjuggler.el (org-taskjuggler-compute-task-leafiness): + Compute the leafiness of a node. + (org-taskjuggler-open-task, org-export-as-taskjuggler): Mark a node as + a milestone if it is a leaf and has no effort. + +2011-07-28 Christian Egli <christian.egli@alumni.ethz.ch> + + * org-taskjuggler.el (org-export-taskjuggler-target-version): + (org-taskjuggler-targeting-tj3-p): Add some minimal infrastructure to + handle export to both tj2 and tj3. + (org-taskjuggler-open-task): Use a different way to purge allocations + for tj2 and tj3. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-footnote.el (org-footnote-auto-label): New random option. + + * org-footnote.el (org-footnote-new): Create random footnote + labels with unique ids. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-footnote.el (org-footnote-create-definition): Allow for + footnote sections above the current footnote insertion point. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-footnote.el (org-footnote-create-definition): Don't search + for last footnote when in org-mode file. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-as-html): Handle links with + `org-html-handle-links' after we handle special characters + conversions. + (org-html-make-link, org-export-html-format-image): Don't + protect html with @ anymore, as links are now handled after + special characters conversions. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-get-timestamps): + (org-agenda-get-scheduled): Fix call to `org-format-agenda-item'. + (org-format-agenda-item): Remove no-prefix argument. + (org-agenda-change-all-lines): Call org-format-agenda-item without the + no-prefix argument. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-highlight-todo): Stop using + prefix-length. + (org-cmp-alpha): Stop using prefix-length. + (org-agenda-open-link): Stop using prefix-length. + (org-agenda-change-all-lines): Stop using prefix-length. + + * org-colview-xemacs.el (org-columns-display-here): Stop using + prefix-length. Always return claned items. + + * org-colview.el (org-columns-display-here): Stop using + prefix-length. Always return claned items. + + * org-mobile.el (org-mobile-write-agenda-for-mobile): Stop using + prefix-length. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Don't call + `org-store-link' interactively as it can confuse the setting of + `org-link-to-org-use-id' and cause undue edits to the org-mode + buffer during tangling. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-html.el (org-export-html-format-image): Protect <p> element + of image caption. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-read-date-force-compatible-dates): New option. + (org-read-date, org-read-date-analyze): Check representable date range. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-as-html): fix export of email. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-spec-to-string): Check value of padline + on tangling, no longer use the now-removed variable + `org-babel-tangle-pad-newline'. + + * ob.el (org-babel-header-arg-names): Add padline to the list of + header argument names. + (org-babel-default-header-args): Set the default value of padline to + "yes". + (org-babel-merge-params): Cleaned up the merge logic, added padline. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-header-arg-names): Adding "shebang" to known + code block header argument names. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-crypt.el: remove useless TODO in comments. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-as-html): the default postamble now only + export a date paragraph if `org-export-time-stamp-file' is + non-nil. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-exp.el (org-export-xml): Remove the defgroup of + org-export-xml. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-html-insert-plist-item): Remove. + (org-export-html-preamble): Default to `t'. Accept functions. + (org-export-html-postamble): Default to `auto'. Accept + functions and distinguish between 'auto (no formatting string) + and `t' (default formatting string). + (org-export-as-html): Handle org-export-html-preamble and + org-export-html-postamble new defaults/allowed values. + Define email and creator-info before using them. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-html-protect-char-alist): Fix typo in + custom type definition. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-do-export): Now runs for empty :session + arguments. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-parse-list): fixed regexp. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-html.el (org-export-html-format-image): Protect image + elements. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-body-hook): Hook for changing the + contents of a code block body on export. + (org-babel-tangle-collect-blocks): Apply + `org-babel-tangle-body-hook' to the collected bodies of code blocks. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-html.el (org-html-make-link, org-html-handle-links): Protect + generated XHTML elements. + (org-export-as-html): Expand character entities after creating markup + for links and timestamps. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-as-html): bugfix: insert email + correctly. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el: Bugfix: prevent infinite matching of the `&' + character. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-fill-paragraph): fill-forward-paragraph function has + been introduced with emacs 23.1. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-attach.el: Allow to store a link to the attach-dir location. + +2011-07-28 Puneeth Chaganti <punchagan@gmail.com> + + * org-agenda.el (org-agenda-bulk-action): Allow the user to run a + function. + +2011-07-28 Bernt Hansen <bernt@norang.ca> + + * org-clock.el (org-clock-in): Allow clocking in new tasks + inserted before the current clocking task + +2011-07-28 Bernt Hansen <bernt@norang.ca> + + * org-clock.el (org-clock-in): Set default clocking task when + already clocking the task + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-adaptive-fill-function): when a region is specified + first line of paragraph isn't skipped, so fill-paragraph have to + be computed even if point is at an item. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-in-valid-block-p): new function. + (org-at-item-p,org-list-search-generic): use new function. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): text in both a list and a + valid block is indented with regards to current item, not to block + boundaries. + +2011-07-28 Manuel Giraud <manuel.giraud@univ-nantes.fr> + + * org-html.el (org-format-org-table-html): fix anchors in HTML + export (thanks to <aankhen@gmail.com>) + (org-html-protect): fix a bug that prevents some target to be + rendered correctly. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-default-properties): Add EXPORT_TEXT. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-footnote.el (org-footnote-create-definition) + (org-insert-footnote-reference-near-definition): Fix sorting + of footnotes. + +2011-07-28 Manuel Giraud <manuel.giraud@univ-nantes.fr> + + * org-html.el (org-export-as-html): Bugfix: don't insert closing + HTML tags when exporting body only. + +2011-07-28 Jason Dunsmore <emacs-orgmode@deathroller.dunsmor.com> + + * org.el (org-back-over-empty-lines): Bugfix. Honor + `org-blank-before-new-entry' correctly in various contexts. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-macs.el (org-with-wide-buffer): Bugfix: use `save-excursion' + and `save-restriction'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-timer.el (org-timer-item): save-excursion prevents + `org-list-struct' to get the list structure when point isn't on + the first line of the item. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-capture.el (org-capture-templates): New option + :no-clock-out. + (org-capture): Use the new option. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-update-checkbox-count): Ensure cookies on an + heading are correctly updated when checkboxes are hidden. It + allows, for example, to use C-c C-x C-b on a collapsed tree and + still get the update. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-exp.el (org-export-visible): Accept keys for + `org-export-as-html-to-buffer' and `org-export-region-as-html'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-duration-string-to-minutes): Don't use + `rx-to-string'. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org.el (org-effort-durations): New variable. + + * org.el (org-duration-string-to-minutes): New function. + + * org-agenda.el (org-agenda-filter-effort-form) + (org-format-agenda-item): Use it. + + * org-clock.el (org-clock-notify-once-if-expired) + (org-clock-modify-effort-estimate, org-clock-get-clock-string): Use it. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-agenda.el (org-agenda-run-series): Rename from + `org-run-agenda-series'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-capture.el: Don't allow currentfile anymore. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-agenda.el (org-agenda-list): Fix bug: don't rely on + `org-agenda-current-span' when calling `org-agenda-list'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-capture.el (org-capture-put-target-region-and-position): New + function to store information about the target buffer. + (org-capture-set-target-location): Use it. + (org-capture-finalize): restore the target buffer in its + possibly narrowed state. Also restore the cursor position. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-crypt.el (auto-save-default): make sure entries are + encrypted before auto-saving. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-inlinetask.el (org-inlinetask-promote) + (org-inlinetask-demote): new functions. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-demote-subtree,org-promote-subtree): wrap + org-map-tree into org-with-limited-levels macro, so it avoids + operating on inline tasks. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-narrow-to-subtree): ensure `org-back-to-heading' + will move point to a real heading and not an inline task by + wraping function into a org-with-limited-levels macro. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-capture.el (org-capture-finalize): New argument clock-out, + to tell whether finalizing the capture process should clock out + the running clock. + (org-capture): Use the new argument. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-refile-get-targets): Rename from + `org-get-refile-targets.' + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-exp.el (org-export-table-remove-empty-lines): New custom + variable. + (org-export-remove-special-table-lines): Use it. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-table.el (org-table-fix-formulas-confirm): new custom + variable. + (org-table-insert-column, org-table-delete-column) + (org-table-move-column, org-table-move-row) + (org-table-insert-row, org-table-kill-row): Use it. + +2011-07-28 Tassilo Horn <tassilo@member.fsf.org> + + * org.el (org-refile-get-location): Set and show default value. + (org-goto, org-refile): Adapt calls. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-mobile.el (org-mobile-files-exclude-regexp): New custom + variable. + (org-mobile-files-alist): Use it. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-todo): Bugfix: use `org-with-wide-buffer' to check + against headings outside of a narrowed buffer. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-confirm-shell-link-not-regexp) + (org-confirm-elisp-link-not-regexp): New custom variables. + (org-open-at-point): Use the new custom variables. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-latex.el: place \title \author \date before + \begin{document}. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-html-preamble) + (org-export-html-postamble): now default to `nil'. + (org-export-as-html): when :html-pre/postamble is nil, fall + back on the default pre/postamble, which depends on the + :author-info, :email-info, :creator-info options. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-results): Don't use cached results if + there is no hash. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-eval-formula): Treat relative column + refs. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-use-standard-references): Change default + to `from'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-move-subtree-down): leave the cursor at the same + column we were at. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-attach.el (org-attach-store-link-p): New variable. + (org-attach-store-link): New function. + (org-attach-attach): When `org-attach-store-link-p' is + non-nil, store a link in `org-stored-links' to a newly + attached file. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-exp.el (org-export-remove-headline-metadata): bugfix: don't + case-fold-search to avoid mixing TODO keywords with real headline + words. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-fedit-finish): Read more general LHS of + formulas. + (org-table-formula-handle-@L): New function to hanle @L references. + (org-table-current-ncol): New variable. + (org-table-line-to-dline): New function. + (org-table-get-stored-formulas): Accept range formulas as matches. + (org-table-get-specials): Compute and store the number of columns. + (org-table-get-range): New optional argument CORNERS-ONLY, to retrieve + only the region marked by the range, not the content. + (org-table-recalculate): Call `org-table-expand-lhs-ranges' to expand + range targets. Also check for duplicate access to fields. + (org-table-expand-lhs-ranges): New funktion. + (org-table-get-remote-range): Bind `org-table-current-ncol' to protect + the caller's value. + (org-table-edit-formulas): Support highlighting of range targets. + (org-table-field-info): Handle renge formulas. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-html-postamble-format) + (org-export-html-preamble-format): explain how to escape the + `%' character. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-exp-bibtex.el (org-export-bibtex-preprocess): Use + `org-export-current-backend'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-read): Read string variable values wrapped in + double quotes, removing the quotes. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-results): Ensure that processed params + are send to org-babel-execute-src-block. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-special-blocks.el + (org-special-blocks-make-special-cookies): Use + `org-export-current-backend'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-in-export-file): Now takes the language + as an argument. + (org-babel-exp-src-block): Explicitly pass language to + `org-babel-exp-in-export-file'. + (org-babel-exp-inline-src-blocks): Removed unused code. + (org-babel-exp-results): Explicitly pass language to + `org-babel-exp-in-export-file'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el (org-babel-execute:calc): Unquote quoted vectors + returned from calc-eval. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-read): Pass elisp vectors through to code + blocks. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * ob.el (org-src-lang-modes): Defvar. + (org-at-item-p): Declare function. + + * ob-calc.el (calc-store): Require. + (var-syms): Defvar. + + * ob-python.el (py-default-interpreter): Defvar. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp-blocks.el (backend): defvar. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-scheduled): + (org-agenda-get-timestamps): Bind local variable `show-all'. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * ob-ref.el (org-at-item-p): Declare function. + + * org-agenda.el (diary-time-regexp): defvar. + + * org-archive.el (org-archive-subtree): Bind local variable + `infile-p'. + + * org-capture.el (org-capture-insert-template-here): Get template + text from property list, to avoid byte compiler message. + + * org-latex.el (org-export-latex-tables): Bind local variable + `width'. + + * org-special-blocks.el (org-compat): Add require statement. + + * org-table.el (orgtbl-ctrl-c-ctrl-c): Bind local variable + `const-str'. + + * org.el (org-eval): Moved function here from org-agenda.el. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-read-table): Inhibit lisp evaluation of values + when reading from tables. + (org-babel-read-list): Inhibit lisp evaluation of values when + reading from lists. + (org-babel-read): Add optional argument which can be used to inhibit + lisp evaluation of value. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-table.el (sbe): Ensure that ob-trim is only called on + strings. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-results): On export, ensure that the + result hash is resolved in the original org-mode file. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-mark-list-end): change end marker + + * org-docbook.el (org-export-docbook-list-line): use new marker. + + * org-html.el (org-html-export-list-line): use new marker + + * org-latex.el (org-export-latex-lists): use new marker + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-lists): make sure markers used + for export are taken into account by temporarily setting an + appropriate value for `org-list-ending-method'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-exp-blocks-block-regexp): Wrapping block + regexp into its own variable, also allowing match of empty bodies. + (org-export-blocks-preprocess): Using new regexp variable. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-src-block-regexp): Code block regexp now + matches blocks with empty bodies. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-script-escape): If script escaped value doesn't + parse cleanly, then return it literally. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-src-block): When block will eventually + be evaluated, pre-calculate the hash before noweb expansion, and + expand the parameters before hash calculation. + (org-babel-exp-do-export): Pass pre-calculated hash through to + `org-babel-exp-results'. + (org-babel-exp-results): Compare pre-calculated hash to results hash. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-sha1-hash): Sort list values to header + arguments, and sort the words in strings. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-index-list): Special handling of hline + rows. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-macs.el (org-with-point-at): Store evaluated version of + pom. This fixes a potential bug when using (org-with-point-at + (func) …), where (func) would be evaluated multiple times, + therefore might return different results if a marker was returned + and different each time. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-open-at-point): if a link to a radio target is the + first, (resp. the last), element of a buffer, function cannot find + the property change required to get its boundaries, and + `buffer-substring' is called with an invalid nil argument. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-table.el (org-table-copy-down): fix docstring. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-latex.el (org-babel-execute:latex): Add imagemagick options, + and for file types other than png and pdf it uses imagemagick to + convert a compiled pdf file to the desired file type. + (convert-pdf): Convert a pdf file to a new file type using + imagemagick. + +2011-07-28 Puneeth Chaganti <punchagan@gmail.com> + + * org-capture.el (org-capture-fill-template): fix bug with the + display of interactive prompt in templates expansion. + +2011-07-28 Reiner Steib <reinersteib+gmane@imap.cc> + + * org-clock.el (org-clock-display): docstring fiw. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-format-comment): Explicitly + append a newline to the body. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item): when computing size of item + being inserted, function has to take into account that indentation + may not only be made of spaces. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-clock.el (org-clock-find-position): if a list was adjacent + to some clocks and a drawer was going to be created, only the + first element of the list would make it into the drawer. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-toggle-checkbox): fix bug where top item in + list was omitted when checking boxes. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-R.el: Don't print result to echo area after evaluation. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-capture.el (org-capture-refile): Fix typo in docstring. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el (org-babel-execute:calc): Call out to new function + for variables resolution. + (ob-calc-maybe-resolve-var): Resolve (possibly recursively) + variables in calc expressions. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el (org-babel-tangle-lang-exts): Replace "c++" with "C++". + (org-babel-C++-compiler): Replace "c++" with "C++". + (org-babel-execute:cpp): Replace "c" with "C++". + (org-babel-execute:C++): Replace "c" with "C++". + (org-babel-expand-body:C++): Replace "c" with "C++". + (org-babel-C-execute): Replace "c" with "C++". + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-at-ref-p): Only try to read results as + a list if at the *beginning* of a list item. + + * ob.el (org-babel-read-result): Only try to read results as a + list if at the *beginning* of a list item. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list (org-cycle-item-indentation): do not break an + indentation cycle because visibility cycling is requested. This + happens when an item becomes a parent, due to indentation change. + Not considered empty anymore, the function cannot change its + indentation again. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-clock.el (org-clocktable-write-default): Bugfix: falls back + on `org-export-default-language' when no :lang parameter is set. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-expand-file): New function. + (org-capture-target-buffer): + (org-capture-set-target-location): Use `org-capture-expand-file'. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-read-list): Reading the value of a list has + been updated to reflect the new structure of org-mode lists in + elisp. + (org-babel-insert-result): Writing code block results to lists has + been updated to reflect the new list structure. + (org-babel-result-end): Remove a previous change to end-of-list + marker detection + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): each time the function + moves item back to child position, a white space is added to the + line. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-process-params): Allow elisp code in + specification of results header arguments. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-agenda.el (org-agenda-append-agenda): New command. + (org-agenda-mode-map): New keybinding to this new command. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-ctrl-c-ctrl-c): call `org-list-send-list' only when + cursor it at very first item of the list, as specified in the + manual. Also refactored the list part of the function a bit. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-agenda.el (org-agenda): Set the 'last-args property to nil + when calling `org-agenda'. Don't kill the local variable + `org-agenda-current-span'. + (org-run-agenda-series): Use the new property 'last-args. + (org-agenda-change-time-span): Use the dynamically set + `org-agenda-overriding-arguments' variable when non-nil. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-result-end): Adjust marker of list end to + changes in the list format. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-toggle-checkbox, org-update-checkbox-count): no + need to wrap org-entry-get in ignore-errors since commit + 7dd425cc5d42fb297f547f713edfdc936f9271f0 + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-toggle-item, org-toggle-heading): make sure every + sub-item in a list is changed into a sub-heading and sub-headings + are translated into sub-items. Also ignore inline tasks in the + process. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-select-backend-specific-text): add + `original-indentation' property when replacing #+begin_backend and + #+backend blocks with their content. This is needed for lists, as + they must know if the block belonged to them. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el (org-html-export-list-line): insert a newline + character before ending an item, as anchor could be on a line + going to be deleted, like a drawer ending string. + + * org-list.el (org-list-to-html): same. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-set-autofill-regexps): use `org-item-re' in + `paragraph-start' to recognize alphabetical lists. + (org-fill-paragraph): enforce a pre-computed fill-prefix before + calling fill-paragraph when point in in an item. Also prevent + paragraphs getting merged into an adjacent list upon filling. + (org-adaptive-fill-function): make sure to determine real fill-prefix + for auto-fill. + (org-auto-fill-function): use a pre-computed fill-prefix before + calling do-auto-fill. + + * org-list.el (org-list-item-body-column): new function + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-inlinetask.el (org-inlinetask-at-task-p) + (org-inlinetask-toggle-visibility): new functions. + + * org-list.el (org-list-set-item-visibility): new function. + + * org.el (org-cycle, org-cycle-internal-local): separate lists and + inline tasks from headlines. + (org-outline-level): do not consider lists as headlines. + Cycling visibility is using different tools. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct): mark items less indented than top + item of the list, so that they will be modified. + (org-list-struct-apply-struct): compare struct's indentation with + line's indentation instead of old-struct's. This is needed because + `org-list-struct' automatically fixes indentation so changes might not + be seen otherwise. + + * org.el (org-ctrl-c-ctrl-c): small refactoring. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-update-checkbox-count): when a part of the + buffer is processed to count checkboxes, lists are read from top + to bottom, but inside lists (in drawers, blocks, or inline tasks) + are skipped. Thus, cookies cannot be updated. This patch enforces + reading of such lists if counter is itself in a special context. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct-apply-struct): inline tasks along + with their content must stay at column 0 even if the item is + gaining indentation. Moreover, fix indentation of text in an + inline task, now it can be in such a task within a list. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-at-item-p): also verify context is valid. + Otherwise it would recognize valid items where org-in-item-p + wouldn't. + (org-in-item-p, org-list-struct-apply-struct): use shorter version of + org-at-item-p. + (org-cycle-list-bullet): fix typo. + (org-list-parse-list): avoid calling org-at-item-p two times by using + an appropriate regexp + + * org.el (org-indent-line-function): use an appropriate regexp + instead of calling org-at-item-p two times. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-in-item-p): When point was just after + org-list-end-re, check wouldn't be done for starting line. So, if + the first line was an item, it wouln't be noticed and function + would return nil. Simplify and comment code. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-toggle-item): when used on normal text, ensure every + line in region is included in the new item, regardless of its + original indentation. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct-apply-struct): if end of list was + at eol, for example, with list inside a block, the last list + wouldn't be shifted. Thus, the patch ensures no blank lines is + skipped. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-toggle-item): Now accepts a prefix argument. When + used without argument on normal text, it will make the whole + region one item. With an argument, it defaults to old behavior: + change each line in region into an item. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-return): when called from inside an item with the + indent flag, function should keep text moved inside the item. This + allows to use C-j to separate lines in an item: cursor won't go + back to column 0. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct): when a line has org-example + property, skip the entire block. This is needed during export, for + example when src blocks in org markup contain lists, and are + returned verbatim because org isn't in the list of interpreted + languages. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-in-item-p): handle special cases when function + is called with cursor amidst `org-list-end-re' or at an inline + task. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * ob.el (org-babel-result-end): apply renaming. + + * org-exp.el (org-export-mark-list-properties): apply renaming. + + * org-list.el (org-list-prevs-alist): renamed from + org-list-struct-prev-alist. + (org-list-parents-alist): renamed from org-list-struct-parent-alist. + (org-list-write-struct): renamed from org-list-struct-fix-struct. + (org-list-parse-list, org-sort-list, org-list-indent-item-generic, + org-toggle-checkbox, org-update-checkbox-count, org-cycle-list-bullet, + org-list-repair, org-insert-item, org-move-item-up, org-move-item-up, + org-move-item-down, org-next-item, org-previous-item, + org-end-of-item-list, org-beginning-of-item-list, org-apply-on-list): + apply renaming. + (org-get-bullet): removed function, as it is not needed anymore. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item-generic): change arguments. + The function now accepts structure and previous items alist. This + allow to insert an item programmatically more easily. + (org-insert-item): Apply changes to org-list-insert-item-generic. The + function now takes care about repairing structure and updating + checkboxes. + + * org-timer.el (org-timer-item): Apply changes to + org-list-insert-item-generic. The function now takes care about + repairing structure. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-make-subtree): function now uses + org-list-parse-list mechanism. + (org-list-make-subtrees): removed function. + (org-list-to-generic): added a parameter and every parameter can be a + sexp returning a string, for finer control. + (org-list-to-html, org-list-to-latex, org-list-to-texinfo): slight + modifications to apply changes to org-list-to-generic. + (org-list-to-subtree): new function. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-beginning-of-line): apply changes to + `org-item-beginning-re' to correct sub-expression reference. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-docbook.el (org-export-docbook-list-line): even with + alphabetical lists, Org shouldn't enforce a particular list type + to exporters. This is a job for style files. + + * org-html.el (org-html-export-list-line): ib idem. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-at-item-counter-p): new function. + (org-list-parse-list): handle counters and list depth. + (org-list-to-generic): a special string is used when an item has a + counter. + (org-list-to-latex): use new special string for counters. This fixes + the counter bug in LaTeX export, as the enumi counter was the only one + modified. + + * org-latex.el (org-export-latex-lists): use new + `org-list-parse-list' output. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-get-list-type): new function. + (org-list-parse-list): use new function. + + * org-html.el (org-html-export-list-line): use new function. + + * org-docbook.el (org-export-docbook-list-line): use new function. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-alphabetical-lists): new variable + (org-item-re, org-list-full-item, org-cycle-list-bullet, + org-list-struct-fix-bul, org-list-inc-bullet-maybe): reflect + introduction of the new variable. + (org-item-beginning-re): changed into a function, so any modification + of `org-alphabetical-lists' will not require reloading Org. + (org-at-item-p, org-toggle-checkbox, org-update-checkbox-count, + org-list-parse-list, org-list-send-list): reflect changes to + `org-item-beginning-re'. + (org-list-use-alpha-bul-p): new function. + + * org.el (org-check-for-hidden): reflect changes to + `org-item-beginning-re'. + + * org-capture.el (org-capture-place-item): reflect changes to + `org-item-beginning-re'. + + * org-docbook.el (org-export-docbook-list-line): handle new type + of items. + + * org-exp.el (org-export-mark-list-end) + (org-export-mark-list-properties): reflect changes to + `org-item-beginning-re'. + + * org-html.el (org-html-export-list-line): handle new type of + items. + + * org-latex.el (org-export-latex-lists): handle new type of items + and reflect changes to `org-item-beginning-re'. + + * org-ascii.el (org-export-ascii-preprocess): handle new counters. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-end-re): removed function and made it a + variable. There's no need for the overhead of calling the function + every at every line in a list. User will have to reload Org if he + change value of either `org-list-end-regexp' or + `org-empty-line-terminates-plain-lists'. + (org-in-item-p,org-list-struct,org-list-parse-list): apply change. + + * org-exp.el (org-export-mark-list-end) + (org-export-mark-list-properties): apply change + + * org-latex.el (org-export-latex-lists): apply change. Also + prevent items with org-example property to be considered as real + items. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-inlinetask.el (org-inlinetask-export-templates): slightly + modify templates so environment boundaries don't interfere with + content of task. Unprotect content of task so it might benefit + from further transformations. Set original-indentation property to + a high value to ensure that task is always in the last item of the + list. Also, apply templates later in export process. + + * org-list.el (org-list-struct): fix inline task skipping. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-lists): Search for unprotected + items only, and redefine `org-at-item'. This change is required + when verbatim lists are inserted during export, usually by Babel. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * ob.el (org-babel-result-end): end position is end of current + sublist instead of bottom point, as results might be inserted in a + list themselves. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-automatic-rules): removed insert rule. + (org-list-insert-item-generic): removed code preventing user to insert + another item in a block within a list. It is because new list context + make it impossible to see if a point in a block is also in a list. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-preprocess-string): mark list endings + before babel blocks preprocessing starts, so blank lines that may + be inserted do not break list's structure. Then, mark list with + special properties required by exporters. Thus output from babel + can easily be included in lists. + (org-export-mark-list-end): new function + (org-export-mark-list-properties): new function + (org-export-mark-lists): removed function. It was split into the two + preceding functions. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-update-checkbox-count): do not recompute every + list before next heading when there are more than one cookie in an + headline. Moreover, ignore the case where cookie is inserted + neither at an heading nor at an item. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-sort-list): fix number of arguments to + `org-list-repair', plus make end-record go to end of item before + any blank line to keep them from being swallowed in the sorting. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-forbidden-blocks): variable renamed from + org-list-blocks. + (org-list-export-context): new variable + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-search-generic): renamed form + org-search-unenclosed-generic to reflect now behavior. Now, match + can only be in a valid context for lists, as determined by + `org-list-context'. + (org-list-search-backward): renamed from + org-search-backward-unenclosed. + (org-list-search-forward): renamed from org-search-forward-unenclosed. + (org-toggle-checkbox,org-update-checkbox-count): use new functions. + (org-sort-list): using default regexp search functions as context is + not required in this case. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-mark-lists): new function, replacing + org-export-mark-list-ending. It adds information as text + properties to every list, before changes done by exporter destruct + them. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-get-first-item): new alias for + org-list-get-list-begin + (org-list-get-last-item): new function + (org-list-get-list-end): use org-list-get-last-item + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-get-string-indentation): moved in generally useful + functions section, as it wasn't specific to plain lists and that + no code was using it in org-list.el. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-skip-over-state-notes,org-store-log-note): use new + accessors. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-indent-item-generic): remove error + messages happening before process. This belongs to interactive + functions. + (org-indent-item,org-indent-item-tree) + (org-outdent-item,org-outdent-item-tree): ensure point or region + is correct before computing list structure. Return an error + message otherwise. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-apply-on-list): use new structures. Function is + now applied in reverse order so modifications do not change + positions of items in buffer. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-parse-list): rewrite of function to allow + text following a sub-list in the same item. See docstring for an + example of output. + (org-list-to-generic): use new parsing function. + (org-list-to-latex,org-list-to-html): minor change for clearer + export. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-has-child-p): renamed from + org-list-get-child. Returning first child is only useful as a + predicate, as we're allowing an item to have more than one + sub-list. + (org-list-indent-item-generic): use `org-list-has-child-p' instead of + org-list-get-child. + (org-in-item-p): also return item beginning when list starts at + context beginning. + (org-list-get-parent): use of `org-list-struct-parent-alist' helper + function is not optional anymore. + (org-list-get-all-items): shorten code with the help of cl.el. + (org-list-get-children): now returns all children of item, even if + they do not belong to the same list. Renamed from + org-list-get-all-children. + (org-list-get-list-begin): function wasn't return value when item was + already the first item of the list at point. + (org-list-get-list-end): function wasn't return value when item was + already the last item of the list at point. + (org-list-struct-fix-box,org-update-checkbox-count): now uses + `org-list-get-children'. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): Indentation of item's body + starts just after the bullet, not after a checkbox. Moreover, As + `org-in-item-p' also returns item beginning position when point is + in a list, do not compute it a second time. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-ctrl-c-ctrl-c): when called at a list item, replace + usage `org-repair-list', forcing another reading of the list, with + only needed subroutines. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-separating-blank-lines-number): use new + accessors. + (org-list-insert-item-generic): use list structures to insert a new + item. + (org-list-exchange-items): refactor and comment code. Now return new + struct instead of modifying it, as list sorting would sometimes eat + first item. + (org-move-item-down,org-move-item-up): reflect changes to + `org-list-exchange-items'. + (org-insert-item): as `org-in-item-p' also computes item beginning + when applicable, reuse the result. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-in-item-p): unify methods for this + predicate. + (org-list-in-item-p-with-indent): removed function + (org-list-ending-between): removed function + (org-list-maybe-skip-block): removed function + (org-list-in-item-p-with-regexp): removed function + (org-list-top-point-with-regexp): removed function + (org-list-top-point-with-indent): removed function + (org-list-bottom-point-with-indent): removed function + (org-list-bottom-point-with-regexp): removed function + (org-list-get-item-same-level): removed function + (org-list-top-point): removed function + (org-list-bottom-point): removed function + (org-get-item-beginning): renamed to org-list-get-item-begin to be + consistent with naming policy of non-interactive functions. + (org-get-beginning-of-list): removed function + (org-beginning-of-item-list): use new accessors + (org-get-end-of-list): removed function + (org-end-of-list): use new accessors + (org-get-end-of-item): removed function + (org-end-of-item): use new accessors + (org-get-previous-item): removed function + (org-previous-item): use new accessors + (org-get-next-item): removed function + (org-next-item): use new accessors + (org-end-of-item-before-blank): renamed to + (org-list-get-item-end-before-blank): Use new accessors. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-repair): removed optional argument + FORCE-BULLET. The job of this interactive function is to + completely fix a list at point. Changing bullets is a separate + task. Also removed others optional arguments TOP and BOTTOM to + follow the new structures. + (org-list-indent-item-generic): remove need for TOP and BOTTOM. STRUCT + is a new required argument. This avoids computing a list structure + many times when function is called more than once in a row, for + example in org-cycle-item-indentation. Use new accessors. Now, also + call `org-update-checkbox-count-maybe'. + (org-outdent-item,org-indent-item,org-outdent-item-tree,org-indent-item-tree): + remove need for TOP and BOTTOM. + (org-list-insert-item-generic): reflect changes to `org-list-repair'. + (org-list-exchange-items): use new accessors. Now modify struct to + avoid re-reading it later. + (org-move-item-down): reflect changes to `org-list-repair'. Use new + accessors. + (org-move-item-up): reflect changes to `org-list-repair'. Use new + accessors. + (org-cycle-list-bullet): use new structures. Also use a shortcut to + `org-list-struct-fix-struct' in order to avoid unnecessary fixes, like + `org-list-struct-fix-box' + (org-sort-list): use of new structures. Renamed an internal function + for a little more clarity. + (org-cycle-item-indentation): remove dependency on org-list-repair. + Use new accessors. + (org-list-get-child): correct bug when asking for the child of the + last item + (org-list-exchange-items): use new accessors. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-blocks): new variable + (org-list-context): new function + (org-list-full-item-re): new variable + (org-list-struct-assoc-at-point): use new varible + (org-list-struct): rewrite of function. Now, list data is collected by + looking at the list line after line. It reads the whole list each time + because reading only a subtree was not enough for some operations, + like fixing checkboxes. It also removes the need to get + `org-list-top-point' and `org-list-bottom-point' first. An added data + is the position of item ending. This aims to be able to have list + followed by text inside an item. + (org-list-struct-assoc-end): new function + (org-list-struct-parent-alist): new function + (org-list-get-parent): new function + (org-list-get-child): new function + (org-list-get-next-item): new function + (org-list-get-prev-item): new function + (org-list-get-subtree): use helper function `org-list-struct-prev-alist'. + (org-list-get-all-items): new function + (org-list-get-all-children): new function + (org-list-get-top-point): new function + (org-list-get-bottom-point): new function + (org-list-get-counter): new function + (org-list-get-item-end): new function + (org-list-struct-fix-bul): rewrite for cleaner code. Make use of new + accessors. + (org-list-struct-fix-ind): make use of new accessors. + (org-list-struct-fix-box): new function + (org-list-struct-fix-checkboxes): removed function + (org-list-struct-outdent): use new accessors. Use the fact that there + is no longer a virtual item at beginning of structure. + (org-list-struct-indent): use helper functions + `org-list-struct-prev-alist' and `org-list-struct-parent-alist'. Also + use new accessors. + (org-list-struct-fix-struct): comment function. Call directly + `org-list-struct-apply-struct', without removing unchanged items + first. + (org-list-struct-apply-struct): comment function. Rewrite using new + accessors. Use new variable `org-list-full-item-re'. + (org-list-shift-item-indentation): removed function, now included in + `org-list-struct-apply-struct' because it is too specific. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-toggle-checkbox): use structures to fix + checkboxes of a list + (org-update-checkbox-count): use structures to update cookies + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct-fix-checkboxes): new function + (org-checkbox-blocked-p): removed function + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-get-all-items): new function + (org-list-get-all-children): new function + (org-list-get-nth): new function + (org-list-set-nth): new function + (org-list-get-ind): new function + (org-list-set-ind): new function + (org-list-get-bullet): new function + (org-list-set-bullet): new function + (org-list-get-checkbox): new function + (org-list-set-checkbox): new function + (org-list-struct-fix-bul): use new accessors + (org-list-repair): use new accessors + (org-list-indent-item-generic): make use of accessors + (org-list-get-parent): renamed from org-list-struct-get-parent + (org-list-get-child): renamed from org-list-struct-get-child + (org-list-struct-fix-ind): make use of accessors + (org-list-get-next-item): new function + (org-list-get-subtree): new function + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct-assoc-at-point): add checkbox to + list structure + + * org-list.el (org-list-struct-assoc-at-point): add checkbox as + value in structure + + * org-list.el (org-list-struct-apply-struct): also apply + checkboxes + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-latex.el (org-export-latex-content): bind local variables + for export in the temporary export buffer. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-protocol.el (org-protocol-unhex-single-byte-sequence) + (org-protocol-unhex-string, org-protocol-unhex-compound): Change date + of obsolete declaration to 2011-02-17. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-escape): Throw error if encoding character in + utf8 fails. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-protocol.el (org-protocol-split-data) + (org-protocol-open-source): Use `org-link-unescape' instead of + obsolete unhex string function. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-escape, org-link-escape-chars-browser) + (org-link-escape-chars): Always percent escape the percent sign. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-unescape): Simpler algorithm for replacing + percent escapes. + (org-link-unescape-compound): Use cond statements instead of nested + if, convert hex string with string-to-number, save match data. + (org-link-unescape-single-byte-sequence): Use mapconcat and + string-to-number for unescaping single byte sequence. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-escape): Rename lambda argument. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-escape-chars-browser, org-link-escape-chars): + Add percent sign to list of escape chars. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-mobile.el (org-mobile-escape-olp): Use new percent escape + character table format. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-mobile.el (org-mobile-locate-entry): Remove obsolete + argument in call to org-link-unescape. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-protocol.el (org-protocol-unhex-string) + (org-protocol-unhex-compound) + (org-protocol-unhex-single-byte-sequence): Declare obsolete and + alias to respective org-link-unescape-* functions. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-unescape, org-link-unescape-compound) + (org-link-unescape-single-byte-sequence): Functions moved and renamed + from org-protocol.el. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-macs.el (org-char-to-string): Inline function to properly + decode utf8 characters in Emacs 22. Moved and renamed from + org-protocol.el. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-escape): New optional argument. Merge user + table with default table. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-escape): Fixup doc string. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-escape-chars, org-link-escape-chars-browser): + New format of percent escape table. + (org-link-escape): Use new table format. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-escape): New unicode aware percent encoding + algorithm. + +2011-07-28 Sebastian Rose <sebastian_rose@gmx.de> + + * org-protocol.el (org-protocol-unhex-single-byte-sequence): New + function. Decode hex-encoded singly byte sequences. + (org-protocol-unhex-compound): Use new function if decoding sequence + as unicode character failed. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-as-html): expand the HTML title. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-publish.el (org-publish-cache-ctime-of-src): improve + docstring. + (org-publish-find-title): New option to explicitly reset the + title in the cache. + (org-publish-format-file-entry): Use this new option. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org-exp.el (org-export-preprocess-string): Set the source buffer + and use `org-clone-local-variables' to get local variables from + it. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Allow + empty string as second element in minted/listings options + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Support + new user-customizable options + (org-export-latex-custom-lang-environments): Ensure new variable is defined + (org-export-latex-listings-options): Ensure new variable is defined + (org-export-latex-minted-options): Ensure new variable is defined + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-as-html): handle the case when + `org-export-html-validation-link' is nil to keep backward + compatible with the old default value of this variable. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): Don't choke if indent is not a + number. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * 2011 + ** 2011-02 monthname + *** 2011-02-13 dayname + +2011-07-28 Christian Moe <mail@christianmoe.com> (tiny change) + + * org-bbdb.el (org-bbdb-export): When a link description has been + added by org-export-normalize-links, use path instead (remove the + `bbdb:' prefix). + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-ascii.el (org-export-ascii-underline): Put the level's + characters in the right order, as documented by the docstring. + (org-ascii-level-start): select the right char for underlining + headlines. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-src.el (org-edit-src-code): allow to edit source code from + modes derived from Org. + +2011-07-28 Niels Giesen <niels.giesen@gmail.com> + + * org-clock.el (org-clock-clocktable-language-setup): Add list of + dutch strings. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org-beamer.el: Mark frame as fragile when it is using minted for + src block export. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-agenda.el (org-agenda-date-later) + (org-agenda-date-earlier): Enhance docstrings. + (org-agenda-bulk-mark-regexp): Only match against headlines. + Send a message when no entry is marked. + (org-agenda-bulk-action): Fix bug about scattering deadlines. + Send an error when trying to scatter outside an agenda or a + timeline view. Silently fail when trying to scatter sexp + entries. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-clock.el (org-clock-clocktable-language-setup): New custom + variable. + (org-clocktable-defaults): Set the default language. + (org-clocktable-write-default): Use the new variable. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-src-block-names): Don't strip text properties + from search hits. + (org-babel-result-names): Don't strip text properties from search + hits. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-python.el (org-babel-python-evaluate-session): Pass nil as + remove-echo part of META argument to + `org-babel-comint-with-output'. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-script-escape): Use `substring' comparison + instead of regexp matching. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org-src.el (org-edit-src-code): When generating the code edit + buffer, it is necessary for several variables to inherit their + values from the parent org buffer. These changes collect all such + variables together into a single association list of + (variable-name value) pairs. In addition, a new variable is added + to the list: `org-edit-src-content-indentation'. This has the + effect that a buffer local value can be used for that variable. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-table.el (sbe): Don't truncate sbe results. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-exp.el (org-export-add-options-to-plist): Require match to + start at a word-boundary. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-latex.el (org-export-latex-hyperref-format): Update + docstring. + +2011-07-28 Tom Dye <tsd@tsdye.com> + + * org.el: Update documentation of `org-add-link-type'. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org.el (org-open-at-point): Fix bug when using prefix arg to + construct `org-link-search' call. Rename prefix arg with a more + generic name, to reflect its diverse uses in this function. + +2011-07-28 Rémi Vanicat <vanicat@debian.org> + + * org-icalendar.el (org-icalendar-use-UTC-date-time): remove. + (org-icalendar-date-time-format): New custom variable. + (org-icalendar-use-UTC-date-timep): New function. + (org-ical-ts-to-string): Use the new variable. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-vm.el (org-vm-store-link): Make sure the buffer is + associated with a file when trying to store an Org link. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-params-from-properties): Test for + "header-arg-name" and ":header-arg-name", in that order. + +2011-07-28 Bastien <bastien.guerry@wikimedia.fr> + + * org-capture.el (org-capture-templates): document currentfile for + capture template. + (org-capture-templates): Allow to use currentfile for capture + templates. + (org-capture-set-target-location): Handle currentfile as a way + to setting the capture buffer. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * ob.el (org-babel-params-from-properties): don't wrap + org-entry-get into condition-case. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org.el (org-entry-get): Don't look for a property drawer if we + are before the first heading in the file. + (org-entry-get-with-inheritance): Don't attempt to move up the tree if + we are before the first heading in the file. Also, enclose less of the + function in the save-excursion. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-params-from-buffer): Return desired value + rather than nil from failed re search. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-agenda.el (org-get-entries-from-diary): Put multiline diary + entries on a single line when lines don't start with a diary time. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-html-protect-char-alist): New custom + variable to define characters to be HTML protected. + (org-html-protect): Use the new variable. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-info.el (org-info-store-link): use "#" to separate the info + file and the node. + (org-info-follow-link): use both "#" to separate the info file + and the node. Continue to use ":" for backward compatibility. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-icalendar.el (org-icalendar-honor-noexport-tag): New custom + variable. + (org-print-icalendar-entries): Use this new variable to + prevent export of entries with a :noexport: tag. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-exp.el (org-export-initial-scope): new custom variable. + (org-export): Use this new variable. If there is an active + region, tell it when prompting the user for an export command. + Also change the way the function handles selection of buffer + and subtree export. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-html-auto-preamble) + (org-export-html-auto-postamble): Remove. + (org-export-html-preamble, org-export-html-postamble): Turn + into custom variables. Update the docstrings. + (org-export-html-preamble-format) + (org-export-html-postamble-format): New custom variables. + (org-export-as-html): Use org-export-html-postamble-format and + org-export-html-preamble-format. + (org-export-html-title-format): delete. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-format-ditaa): This + function is begin deprecated in favor of begin_src blocks. + (org-export-blocks-format-dot): This function is begin deprecated in + favor of begin_src blocks. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-header-arg-names): no-expand is now part of the + default header argument names list. + +2011-07-28 Manuel Giraud <manuel.giraud@univ-nantes.fr> + + * org-publish.el (org-publish-sitemap-date-format) + (org-publish-sitemap-file-entry-format): new custom variables. + (org-publish-projects): use these variables to format the sitemap + entries. + +2011-07-28 Ulf Stegemann <ulf-news@zeitform.de> + + * org-gnus.el (org-gnus-store-link): Allow org-link creation from + message-mode. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-filter-by-tag): Refresh agenda when + updating the filter while the clock report is following the + filter. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda): Kill all local variables. This + assures we are not keeping buffer variable from an old agenda view + when switching to a new custom agenda. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-crypt.el (org-encrypt-string): New function. + (org-encrypt-entry): Use org-encrypt-string to encrypt, so we use cached + crypted values. + (org-decrypt-entry): Store crypted text in decrypted text. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-exp.el (org-babel-exp-lob-one-liners): Only replace the match + if a non-nil result is returned + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-day-entries): Compare DATE with + modified today. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-update-parent-todo-statistics): fix bug when + updating statistics from the column view. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-agenda.el (org-agenda-bulk-mark-regexp): New command. + (org-agenda-menu): Add the new command to the menu. + (org-agenda-mode-map): Add % as the keybinding for the new + command. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-exp.el (org-export-target-internal-links): Locally turn on + `org-link-search-must-match-exact-headline' to match exact + internal links. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-faces.el (org-special-keyword): Make it inherited from + font-lock-keyword-face. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-faces.el (org-link): Make org-link inherits from link face. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-narrow-to-block): New function to narrow to block. + Bound this function to `C-x n b'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-schedule, org-deadline): Fix bug: take care of + repeating timestamps like ".+1d/3d" or "+1d 10d". + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-agenda.el (org-agenda-repeating-timestamp-show-all): Allow + to use a list of TODO keywords as the value of this variable. The + agenda will show repeating stamps for entries matching these TODO + keywords. + (org-agenda-get-timestamps, org-agenda-get-deadlines) + (org-agenda-get-scheduled): Allow the use of a list of keywords in + `org-agenda-repeating-timestamp-show-all'. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-latex.el (org-export-latex-emph-format): Don't use + `org-export-latex-use-verb'. Remove this variable. + +2011-07-28 Jason Dunsmore <emacs-orgmode@dunsmor.com> + + * org-html.el (org-html-handle-time-stamps): fix bug when exporing + inactive timestamps. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-archive.el (org-archive-save-context-info): Fix docstring + typo. + (org-archive-subtree-add-inherited-tags): New variable to control + whether inherited tags should be appended to local tags when + archiving subtrees. + (org-archive-subtree): Use the new variable. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-archive.el (org-archive-save-context-info): Fix docstring + typo. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-crypt.el (org-decrypt-entry): Delete \n on top level + heading. This avoids a display bug showing the heading outlined + where the text is not since it does not have the outline property. + Restore subtree visibility state after decryption. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-list): Use org-agenda-current-span as + a possible default span if it is set. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org-src.el (org-edit-src-persistent-message): Change docstring. + (org-edit-src-code): Get rid of help message in echo area. + + * ob.el (org-babel-do-in-edit-buffer): Do not pass 'quietly + argument to org-edit-src-code as this has been removed + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-latex.el (org-export-latex-emphasis-alist): use + \protectedtexttt for the =...= emphasis and \verb for the ~...~ + emphasis. + (org-export-latex-use-verb): now defaults to t. + (org-export-latex-emph-format): distinguish between =...= and + ~...~ emphasis. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * test-org-html.el (test-org-html/export-link-alist): New + variable. Abstract link export test definition. + (test-org-html/export-link-factory): New function. Create tests for + link export. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-test.el (org-test-strip-text-props): New function. Strip + text properties. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org.el (org-link-expand-abbrev): Allow any type of character in + link expand. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-lob.el (org-babel-lob-ingest): Add prefix to file prompt. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-ref.el (org-babel-ref-resolve): save-window-excursion when + resolving references. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org-html.el (org-export-html-html-helper-timestamp): use <hr/> + instead of <hr> to keep w3c validator happy. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-where-is-src-block-head): Detect src block if + point is on a #+header line. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-where-is-src-block-head): Skip over intervening + #+header lines when searching for block associated with block name + line. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-result-end): Replace call to org-in-item-p to + the more specific org-at-item-p. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-latex-default-figure-position): New defcustom + for default placement of latex figures. + (org-export-latex-tables): Positioning tables using the new + defcustom variable. + (org-export-latex-format-image): Positioning images using the new + defcustom variable. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ditaa.el (org-babel-execute:ditaa): Throw error when + evaluated and :file header argument is missing. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-do-export): Simplified, no longer need + to do anything to export code. + (org-babel-exp-results): No longer returns a replacement for the + code block. + (org-babel-exp-inline-src-blocks): Simplified. + (org-babel-exp-src-block): Removed unnecessary pluralization from + function name. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-inline-src-blocks): Simplified + exportation of inline code blocks using normal code block + execution mechanism to insert results. + (org-babel-exp-results): Results exportation mechanism is unified + for both inline and regular code blocks. + + * ob.el (org-babel-where-is-src-block-result): Returns the point + after an inline code block for inline code blocks. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): Special handling of the + position of results of inline code blocks. + (org-babel-examplize-region): Now able to comment inline regions. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-exp.el (org-export-with-LaTeX-fragments): Fix docstring so + that \\[ a = b \\] is not interpreted as a keybinding by + `substitute-command-keys'. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org-latex.el (org-export-as-latex): Process export property list + with `org-export-process-option-filters' early in latex export + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org.el: Remove org-invisible-p: outline-invisible-p is available + in Emacs 22 and in recent XEmacs 21. Replace in various files. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-get-progress): Fix regexp for statep: + it must has \\ at the end of the line. This avoid matching the + following heading when there's no newline between the logged state + and the next heading. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-format-agenda-item): Simplify time comuting. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-current-level): + (org-store-link): + (org-mark-subtree): Use `org-with-limited-levels'. + +2011-07-28 Jan Seeger <jan.seeger@thenybble.de> + + * org-publish.el (org-publish-get-base-files): Add sitemap file. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-agenda.el (org-agenda-todo-ignore-deadlines): New option. + (org-agenda-todo-ignore-scheduled): New option. + (org-agenda-todo-ignore-timestamp): New option. + (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item): + Allow user to specify custom distance to ignore (future or past). + (org-agenda-todo-custom-ignore-p): New function. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-habit.el (org-habit-parse-todo) Don't parse more days than + needed. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-map-inline-src-blocks): Macro for executing + code in each inline code block. + (org-babel-execute-buffer): Executes inline code blocks as well as + regular code blocks. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-result-end): Now recognizes "#+begin_org" + blocks for removal. + +2011-07-28 Benjamin Drieu <bdrieu@april.org> (tiny change) + + * org-clock.el (org-clock-before-select-task-hook): New hook. + (org-clock-select-task): Run new hook. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-get-blocks): Fix time of start/end of + events with range. This display things like: <2011-01-22 Sat + 14:00>--<2011-01-23 Sun 20:00> correctly, with the event starting + at 14:00 and ending at 20:00. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-inline-src-block-regexp): Character preceding + "src_" can now be anything as long as it is neither alphanumeric + nor '-'. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-merge-params): docstring typo. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-params-from-buffer): Process all #+babel: lines + in the buffer. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-get-src-block-info): Alter order of merge + arguments + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-python.el: Test whether non-nil buffer is #<killed buffer> + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): Ensure all parts of result + wrappers end in newlines. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle): New :mkdirp header argument + optionally creates parent directories of tangle targets. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-ascii.el (org-ascii-level-start): Catch the case of levels + which do not have an equivalent in the list of underline + characters. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-sh.el (org-babel-sh-var-quote-fmt): Now possible to customize + the format string used to escape arguments to shell code blocks. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-reset-view): New function. + (org-agenda-view-mode-dispatch): Bind space to org-agenda-reset-view. + +2011-07-28 Puneeth Chaganti <punchagan@gmail.com> + + * org-exp.el (org-export-handle-include-files): Support :lines + property. + (org-get-file-contents): New argument lines to include specify a range + of lines to include. + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-fast-tag-selection): Fix bug when assigning keys + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org-latex.el (org-export-latex-make-header): Export email in + author line if `org-export-email-info' is non-nil. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-goto-today): Respect current span. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-complete.el (pcomplete/org-mode/link): + (pcomplete/org-mode/todo): + (pcomplete/org-mode/prop): Copy list before uniquifying. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-spec-to-string): Adding "noweb" as a + linking comment type + (org-babel-tangle-comment-links): Returns comment links for the + source code block at point + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * org.el (org-refile-check-position): send a more explicit message + on how to clear the cache before refiling again. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-skip-function-global): New option. + (org-agenda-skip-eval): New function. + (org-agenda-skip): Use `org-agenda-skip-eval' and also check for the + global skipping condition. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-html.el (org-export-as-html): Handle timestamps after + handling links. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-jump-to-org): Ever wider searches + until either a matching block is found, or the limits of the file + are reached. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-update-block-body): Literal argument to + `replace-match' to allow insertion of text containing '\'. + +2011-07-28 Tassilo Horn <tassilo@member.fsf.org> + + * org-gnus.el (org-gnus-store-link): + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-parse): Allow passing empty strings + into code blocks. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * test-org-table.el + (test-org-table/org-table-convert-refs-to-rc/3) + (test-org-table/org-table-convert-refs-to-rc/2) + (test-org-table/org-table-convert-refs-to-rc/1) + (test-org-table/org-table-convert-refs-to-an/3) + (test-org-table/org-table-convert-refs-to-an/2) + (test-org-table/org-table-convert-refs-to-an/1): Provide tests for + table formular format conversion. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-sort-entries): Fix sorting with a bold emphasis at + bol + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-open-src-block-result): Must collect result + *before* jumping to the result buffer. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-src-block-names): Fix bug, wrong match-string + used after update to regexp. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-temp-file): Ensure that + org-babel-temporary-directory is bound before using. + (org-babel-remove-temporary-directory): Safer error throwing. + +2011-07-28 niels giesen <niels.giesen@gmail.com> + + * org-docbook.el (org-export-docbook-finalize-table): Do literal + replacements. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Uses org-src-lang-modes to + resolve language names for evaluation. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-templates): Add %f and %F escapes + (org-capture): Add more information to capture property list + (org-capture-fill-template): Handle %f and %F escapes + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-publish.el (org-publish-cache-ctime-of-src): Use mtime of + symlink target. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-occur-next-match): New function. + (org-mode): Set the variable `next-error-function'. + (org-highlight-new-match): Add an `org-type' property to the overlays. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el: No longer require `calc-trail' on XEmacs + +2011-07-28 Bastien Guerry <bzg@gnu.org> + + * simple.el (mail-user-agent): Default to the + upwardly-UI-compatible and more featureful message-mode. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-modules): Add `org-eshell'. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-special-blocks.el (htmlp): + (latexp): + (line): Add defvars for dynamically scoped variables. + + * org.el (org-modules): Move org-special-blocks into the core + modules section. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-special-blocks.el: New file. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-plist-delete): Remove duplicate definition. + +2011-07-28 Bernt Hansen <bernt@norang.ca> + + * org-agenda.el (org-agenda-goto): Display invisible entry text + + * org-agenda.el (org-agenda-switch-to): Display invisible entry + text + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-get-category): New optional argument FORCE-REFRESH. + Automatically refresh if the property is not there. + (org-entry-properties): Remove refresh - this is now done in + org-get-category. + + * org-clock.el (org-clock-insert-selection-line): Let + `org-get-category' do the property refresh. + + * org-archive.el (org-archive-subtree): Force a refresh of + category properties. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-icalendar.el (org-print-icalendar-entries): Do not manually + refresh categories. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org.el (org-display-inline-images): Check for clear-image-cache + before using it. + +2011-07-28 Bernt Hansen <bernt@norang.ca> + + * org.el: Document missing value for org-link-frame-setup. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-R.el (org-babel-R-write-object-command): Force evaluation of + user code prior to the R exception-handling, so that errors in + user code are unhandled. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * org-src.el (org-src-font-lock-fontify-block): Test, early on, + that a major-mode function corresponding to the language string + exists. + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-mark-list-ending): insert additional + newline characters if end-list-marker is at a wrong position. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-script-escape): Replace commas with spaces for + better list reading when list items are packed with commas, + e.g. Haskell list output. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-sass.el (org-babel-execute:sass): Uses ob-eval for better + error reporting. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-confirm-evaluate): Fix for the case when + org-confirm-babel-evaluate is a function (used to always ask no + matter what the function returns). + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-R.el: Delete duplicated function. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Removed unused flet + function. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-asymptote.el (org-babel-execute:asymptote): Return nil to + signal that the intended content has been written to file. + + * ob-ditaa.el (org-babel-execute:ditaa): Return nil to signal that + the intended content has been written to file. + + * ob-dot.el (org-babel-execute:dot): Return nil to signal that the + intended content has been written to file. + + * ob-gnuplot.el (org-babel-execute:gnuplot): Return nil to signal + that the intended content has been written to file. + + * ob-latex.el (org-babel-execute:latex): Return nil to signal that + the intended content has been written to file. + + * ob-mscgen.el (org-babel-execute:mscgen): Return nil to signal + that the intended content has been written to file. + + * ob-octave.el (org-babel-execute:octave): Return result; not name + of output file. + + * ob-plantuml.el (org-babel-execute:plantuml): Return nil to + signal that the intended content has been written to file. + + * ob-python.el (org-babel-execute:python): Return result; not name + of output file. + + * ob-ruby.el (org-babel-execute:ruby): Return result; not name of + output file. + + * ob-sass.el (org-babel-execute:sass): Return nil if result has + been written to file + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob-R.el (org-babel-R-graphical-output-file): New function + returns the name of the output file iff R has been instructed to + send graphical output to file by means of the ":results graphics" + directive. + (org-babel-expand-body:R): Use `org-babel-R-graphical-output-file' + when constructing the R code to evaluate, which may be augmented with + code implementing the writing of graohical output to file. + (org-babel-execute:R): Use `org-babel-R-graphical-output-file' to + determine whether R is taking responsibility for writing output to + file; if so, this is signalled to ob.el by returning a nil result. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-format-result): New function to format results + of src block execution. + (org-babel-execute-src-block): Use `org-babel-format-result' when + writing to file. + (org-babel-open-src-block-result): Use `org-babel-format-result' when + displaying results in a buffer; name results buffer differently. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-execute-src-block): Avoid calling + `orgtbl-to-generic' on number results. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Allow specification of + table separator with :sep header argument. + (org-babel-open-src-block-result): Allow specification of table + separator with :sep header argument. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-execute-buffer): Wipe error buffer at outset of + executing buffer (note that this handles execute subtree also). + +2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-inlinetask.el (org-inlinetask-in-task-p): small refactoring, + do not modify match data either. + (org-inlinetask-goto-end): small refactoring, remove case-sensitivity. + (org-inlinetask-goto-beginning): small refactoring, remove case-sensitivity. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-target-location): Use + `current-time'. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-target-location): Use + `current-time'. + +2011-07-28 Bernt Hansen <bernt@norang.ca> + + * org.el (org-before-first-heading-p): If point is on an org-mode + heading line then we are not before the first heading. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) + + * org-timer.el (org-timer-continue-hook): Define the variable + (org-timer-pause-or-continue): Run hook after relative timer is + continued. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-compile-prefix-format): Allow %() expression. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-capture.el (org-capture-fill-template): Use org-eval. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-eval): New function. + +2011-07-28 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-execute-src-block): With :results file, when + :file is not supplied, interpret result as a file link as long as + it is a string. + +2011-07-28 David Maus <dmaus@ictsoc.de> + + * org-latex.el (org-export-latex-preprocess): Don't convert link + description parts that look like numeric footnote. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-tables): Allowing specification + of tabular[xy] inner environments through the ATTR_LaTeX line. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-capture.el (org-capture-fill-template): Use + `org-set-property' directly. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-agenda.el (org-agenda-prefix-format): Add missing `search' + item in docstring. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-string): Use `format' to construct + function call to allow symbolic or string arguments. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-place-entry): + (org-capture-insert-template-here): Check tree for validity before + pasting it. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org-gnus.el (org-gnus-store-link): Trim date. + +2011-07-28 Julien Danjou <julien@danjou.info> + + * org.el (org-email-link-description): Allow to retrieve email + link date. + +2011-07-28 Lawrence Mitchell <wence@gmx.li> + + * org.el (org-make-target-link-regexp): regexp-quote target before + replacing whitespace. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-expand-noweb-references): Noweb references can + now be resolved from the library of babel. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-result-end): No longer leaving trailing new + line after block removal. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-first-lines): Anchor outline + regexp during LaTeX tree export + +2011-07-28 Konrad Hinsen <konrad.hinsen@fastmail.net> + + * ob-python.el (org-babel-python-initiate-session-by-key): Make + sure that py-which-bufname is initialized, as otherwise it will be + overwritten the first time a Python buffer is created. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-sh.el (org-babel-sh-var-to-sh): Better escaping of variables + with spaces. + +2011-07-28 Eric Schulte <schulte.eric@gmail.com> + + * ob-org.el (org-babel-execute:org): Padding code block with an + empty title on LaTeX export. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org.el (org-entry-properties): Stop scanning for timestamps if a + specific timestamp property (e.g., DEADLINE, SCHEDULED, etc.) is + requested and a match is found. Also, if a specific timestamp + property is requested, do not push non-relevant timestamps onto + property list. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-add-time-grid-maybe): Show time only + when grid is being made for today. + +2011-07-28 Matt Lundin <mdl@imapmail.org> + + * org-agenda.el (org-agenda-get-scheduled): Don't call + `org-is-habit-p' until after checking for + `org-agenda-skip-scheduled-if-done'. + +2011-07-28 Achim Gratz <Stromeko@nexgo.de> + + * org.el: remove spurious linebreak introduced by earlier patch. + + * ob.el, ob-ref.el: remove double fix of the same problem. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (orgtbl-ctrl-c-ctrl-c): Parse buffer for constants. + +2011-07-28 Łukasz Stelmach <lukasz.stelmach@iem.pw.edu.pl> + + * org-html.el (org-export-html-mathjax-template): displaymath + environment and MathJax. + +2011-07-28 Carsten Dominik <carsten.dominik@gmail.com> + + * org-faces.el (org-agenda-current-time): New face. + + * org-agenda.el (org-agenda-show-current-time-in-grid): + (org-agenda-current-time-string): New options. + (org-agenda-add-time-grid-maybe): Add current time to time grid. + 2011-05-10 Jim Meyering <meyering@redhat.com> Fix doubled-word typos. diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index 6d81e1978fa..cc44ece4ea8 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -1,11 +1,11 @@ ;;; ob-C.el --- org-babel functions for C and similar languages -;; Copyright (C) 2010-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -38,7 +38,9 @@ (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) -(add-to-list 'org-babel-tangle-lang-exts '("c++" . "cpp")) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp")) (defvar org-babel-default-header-args:C '()) @@ -46,8 +48,8 @@ "Command used to compile a C source code file into an executable.") -(defvar org-babel-c++-compiler "g++" - "Command used to compile a c++ source code file into an +(defvar org-babel-C++-compiler "g++" + "Command used to compile a C++ source code file into an executable.") (defvar org-babel-c-variant nil @@ -56,15 +58,15 @@ is currently being evaluated.") (defun org-babel-execute:cpp (body params) "Execute BODY according to PARAMS. This function calls -`org-babel-execute:C'." - (org-babel-execute:C body params)) +`org-babel-execute:C++'." + (org-babel-execute:C++ body params)) -(defun org-babel-execute:c++ (body params) +(defun org-babel-execute:C++ (body params) "Execute a block of C++ code with org-babel. This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) -(defun org-babel-expand-body:c++ (body params) +(defun org-babel-expand-body:C++ (body params) "Expand a block of C++ code with org-babel according to it's header arguments (calls `org-babel-C-expand')." (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params))) @@ -81,7 +83,7 @@ header arguments (calls `org-babel-C-expand')." (defun org-babel-C-execute (body params) "This function should only be called by `org-babel-execute:C' -or `org-babel-execute:c++'." +or `org-babel-execute:C++'." (let* ((tmp-src-file (org-babel-temp-file "C-src-" (cond @@ -98,7 +100,7 @@ or `org-babel-execute:c++'." (format "%s -o %s %s %s" (cond ((equal org-babel-c-variant 'c) org-babel-C-compiler) - ((equal org-babel-c-variant 'cpp) org-babel-c++-compiler)) + ((equal org-babel-c-variant 'cpp) org-babel-C++-compiler)) (org-babel-process-file-name tmp-bin-file) (mapconcat 'identity (if (listp flags) flags (list flags)) " ") @@ -189,5 +191,6 @@ of the same value." (provide 'ob-C) +;; arch-tag: 8f49e462-54e3-417b-9a8d-423864893b37 ;;; ob-C.el ends here diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index 5f94240f22f..35cdcb90926 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -1,11 +1,11 @@ ;;; ob-R.el --- org-babel functions for R code evaluation -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research, R, statistics ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -51,15 +51,24 @@ (defvar org-babel-R-command "R --slave --no-save" "Name of command to use for executing R code.") -(defun org-babel-expand-body:R (body params) +(defvar ess-local-process-name) +(defun org-babel-edit-prep:R (info) + (let ((session (cdr (assoc :session (nth 2 info))))) + (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) + (save-match-data (org-babel-R-initiate-session session nil)) + (setq ess-local-process-name (match-string 1 session))))) + +(defun org-babel-expand-body:R (body params &optional graphics-file) "Expand BODY according to PARAMS, return the expanded body." - (let ((out-file (cdr (assoc :file params)))) + (let ((graphics-file + (or graphics-file (org-babel-R-graphical-output-file params)))) (mapconcat #'identity ((lambda (inside) - (if out-file + (if graphics-file (append - (list (org-babel-R-construct-graphics-device-call out-file params)) + (list (org-babel-R-construct-graphics-device-call + graphics-file params)) inside (list "dev.off()")) inside)) @@ -75,8 +84,8 @@ This function is called by `org-babel-execute-src-block'." (cdr (assoc :session params)) params)) (colnames-p (cdr (assoc :colnames params))) (rownames-p (cdr (assoc :rownames params))) - (out-file (cdr (assoc :file params))) - (full-body (org-babel-expand-body:R body params)) + (graphics-file (org-babel-R-graphical-output-file params)) + (full-body (org-babel-expand-body:R body params graphics-file)) (result (org-babel-R-evaluate session full-body result-type @@ -86,8 +95,7 @@ This function is called by `org-babel-execute-src-block'." (or (equal "yes" rownames-p) (org-babel-pick-name (cdr (assoc :rowname-names params)) rownames-p))))) - (message "result is %S" result) - (or out-file result)))) + (if graphics-file nil result)))) (defun org-babel-prep-session:R (session params) "Prepare SESSION according to the header arguments specified in PARAMS." @@ -177,6 +185,11 @@ current code buffer." (process-name (get-buffer-process session))) (ess-make-buffer-current)) +(defun org-babel-R-graphical-output-file (params) + "Name of file to which R should send graphical output." + (and (member "graphics" (cdr (assq :result-params params))) + (cdr (assq :file params)))) + (defun org-babel-R-construct-graphics-device-call (out-file params) "Construct the call to the graphics device." (let ((devices @@ -214,7 +227,8 @@ current code buffer." (defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") (defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") -(defvar org-babel-R-write-object-command "{function(object, transfer.file) {invisible(if(inherits(try(write.table(object, file=transfer.file, sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE), silent=TRUE),\"try-error\")) {if(!file.exists(transfer.file)) file.create(transfer.file)})}}(object=%s, transfer.file=\"%s\")") + +(defvar org-babel-R-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")") (defun org-babel-R-evaluate (session body result-type column-names-p row-names-p) @@ -298,5 +312,6 @@ Insert hline if column names in output have been requested." (provide 'ob-R) +;; arch-tag: cd4c7298-503b-450f-a3c2-f3e74b630237 ;;; ob-R.el ends here diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el index 06407542468..d360cfc2274 100644 --- a/lisp/org/ob-asymptote.el +++ b/lisp/org/ob-asymptote.el @@ -1,11 +1,11 @@ ;;; ob-asymptote.el --- org-babel functions for asymptote evaluation -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -49,6 +49,7 @@ (declare-function orgtbl-to-generic "org-table" (table params)) (declare-function org-combine-plists "org" (&rest plists)) +(defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy")) (defvar org-babel-default-header-args:asymptote @@ -80,7 +81,7 @@ This function is called by `org-babel-execute-src-block'." body params (org-babel-variable-assignments:asymptote params)))) (message cmd) (shell-command cmd) - out-file)) + nil)) ;; signal that output has already been written to file (defun org-babel-prep-session:asymptote (session params) "Return an error if the :session header argument is set. @@ -159,5 +160,6 @@ of int, where every cell must be of int type." (provide 'ob-asymptote) +;; arch-tag: f2f5bd0d-78e8-412b-8e6c-6dadc94cc06b ;;; ob-asymptote.el ends here diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el new file mode 100644 index 00000000000..368957c2f9b --- /dev/null +++ b/lisp/org/ob-awk.el @@ -0,0 +1,119 @@ +;;; ob-awk.el --- org-babel functions for awk evaluation + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.7 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Commentary: + +;; Babel's awk can use special header argument: +;; +;; - :in-file takes a path to a file of data to be processed by awk +;; +;; - :stdin takes an Org-mode data or code block reference, the value +;; of which will be passed to the awk process through STDIN + +;;; Code: +(require 'ob) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function org-babel-ref-resolve "ob-ref" (ref)) +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("awk" . "awk")) + +(defvar org-babel-awk-command "awk" + "Name of the awk executable command.") + +(defun org-babel-expand-body:awk (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (dolist (pair (mapcar #'cdr (org-babel-get-header params :var))) + (setf body (replace-regexp-in-string + (regexp-quote (concat "$" (car pair))) (cdr pair) body))) + body) + +(defun org-babel-execute:awk (body params) + "Execute a block of Awk code with org-babel. This function is +called by `org-babel-execute-src-block'" + (message "executing Awk source code block") + (let* ((result-params (cdr (assoc :result-params params))) + (cmd-line (cdr (assoc :cmd-line params))) + (in-file (cdr (assoc :in-file params))) + (full-body (org-babel-expand-body:awk body params)) + (code-file ((lambda (file) (with-temp-file file (insert full-body)) file) + (org-babel-temp-file "awk-"))) + (stdin ((lambda (stdin) + (when stdin + (let ((tmp (org-babel-temp-file "awk-stdin-")) + (res (org-babel-ref-resolve stdin))) + (with-temp-file tmp + (insert (org-babel-awk-var-to-awk res))) + tmp))) + (cdr (assoc :stdin params)))) + (cmd (mapconcat #'identity (remove nil (list org-babel-awk-command + "-f" code-file + cmd-line + in-file)) + " "))) + (org-babel-reassemble-table + ((lambda (results) + (when results + (if (or (member "scalar" result-params) + (member "verbatim" result-params) + (member "output" result-params)) + results + (let ((tmp (org-babel-temp-file "awk-results-"))) + (with-temp-file tmp (insert results)) + (org-babel-import-elisp-from-file tmp))))) + (cond + (stdin (with-temp-buffer + (call-process-shell-command cmd stdin (current-buffer)) + (buffer-string))) + (t (org-babel-eval cmd "")))) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + +(defun org-babel-awk-var-to-awk (var &optional sep) + "Return a printed value of VAR suitable for parsing with awk." + (flet ((echo-var (v) (if (stringp v) v (format "%S" v)))) + (cond + ((and (listp var) (listp (car var))) + (orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var))) + ((listp var) + (mapconcat #'echo-var var "\n")) + (t (echo-var var))))) + +(defun org-babel-awk-table-or-string (results) + "If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + +(provide 'ob-awk) + +;; arch-tag: 844e2c88-6aad-4018-868d-a2df6bcdf68f + +;;; ob-awk.el ends here diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el index 8682a06e243..0f88ccf4dae 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-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -29,7 +29,8 @@ ;;; Code: (require 'ob) (require 'calc) -(require 'calc-trail) +(require 'calc-store) +(unless (featurep 'xemacs) (require 'calc-trail)) (eval-when-compile (require 'ob-comint)) (defvar org-babel-default-header-args:calc nil @@ -68,21 +69,16 @@ ((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)))))))) + (t (replace-regexp-in-string + "'\\[" "[" + (calc-eval + (math-evaluate-expr + ;; resolve user variables, calc built in + ;; variables are handled automatically + ;; upstream by calc + (mapcar #'ob-calc-maybe-resolve-var + ;; 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]")))) @@ -90,7 +86,19 @@ (with-current-buffer (get-buffer "*Calculator*") (calc-eval (calc-top 1))))) +(defvar var-syms) ; Dynamically scoped from org-babel-execute:calc +(defun ob-calc-maybe-resolve-var (el) + (if (consp el) + (if (and (equal 'var (car el)) (member (cadr el) var-syms)) + (progn + (calc-recall (cadr el)) + (prog1 (calc-top 1) + (calc-pop 1))) + (mapcar #'ob-calc-maybe-resolve-var el)) + el)) + (provide 'ob-calc) +;; arch-tag: 5c57a3b7-5818-4c6c-acda-7a94831a6449 ;;; ob-calc.el ends here diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index f9087e8358e..d9bc213dfa2 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -1,11 +1,11 @@ ;;; ob-clojure.el --- org-babel functions for clojure evaluation -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Joel Boehland, Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -42,6 +42,7 @@ (declare-function slime-eval "ext:slime" (sexp &optional package)) +(defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) (defvar org-babel-default-header-args:clojure '()) @@ -61,27 +62,36 @@ 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))) + (cond ((or (member "code" result-params) (member "pp" result-params)) + (format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)] " + "(clojure.pprint/with-pprint-dispatch clojure.pprint/%s-dispatch " + "(clojure.pprint/pprint (do %s) org-mode-print-catcher) " + "(str org-mode-print-catcher)))") + (if (member "code" result-params) "code" "simple") body)) + ;; if (:results output), collect printed output + ((member "output" result-params) + (format "(clojure.core/with-out-str %s)" body)) + (t body)))) (defun org-babel-execute:clojure (body params) "Execute a block of Clojure code with Babel." (require 'slime) (require 'swank-clojure) (with-temp-buffer (insert (org-babel-expand-body:clojure body params)) - (read + ((lambda (result) + (let ((result-params (cdr (assoc :result-params params)))) + (if (or (member "scalar" result-params) + (member "verbatim" result-params)) + result + (condition-case nil (org-babel-script-escape result) + (error result))))) (slime-eval `(swank:interactive-eval-region - ,(buffer-substring-no-properties (point-min) (point-max))) + ,(buffer-substring-no-properties (point-min) (point-max))) (cdr (assoc :package params)))))) (provide 'ob-clojure) +;; arch-tag: a43b33f2-653e-46b1-ac56-2805cf05b7d1 ;;; ob-clojure.el ends here diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index 7607f802914..4e238880ec2 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -1,11 +1,11 @@ ;;; ob-comint.el --- org-babel functions for interaction with comint buffers -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, comint ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -93,9 +93,9 @@ or user `keyboard-quit' during execution of body." (goto-char comint-last-input-end) (not (save-excursion (and (re-search-forward - comint-prompt-regexp nil t) + (regexp-quote ,eoe-indicator) nil t) (re-search-forward - (regexp-quote ,eoe-indicator) nil t))))) + comint-prompt-regexp nil t))))) (accept-process-output (get-buffer-process (current-buffer))) ;; thought the following this would allow async ;; background running, but I was wrong... @@ -158,5 +158,6 @@ FILE exists at end of evaluation." (provide 'ob-comint) +;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889 ;;; ob-comint.el ends here diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el index 6c96d53a993..25d75ccf80a 100644 --- a/lisp/org/ob-css.el +++ b/lisp/org/ob-css.el @@ -1,11 +1,11 @@ ;;; ob-css.el --- org-babel functions for css evaluation -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -44,5 +44,6 @@ CSS does not support sessions." (provide 'ob-css) +;; arch-tag: f4447e8c-50ab-41f9-b322-b7b9574d9fbe ;;; ob-css.el ends here diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el index 336ca8cde7f..810af9411f4 100644 --- a/lisp/org/ob-ditaa.el +++ b/lisp/org/ob-ditaa.el @@ -1,11 +1,11 @@ ;;; ob-ditaa.el --- org-babel functions for ditaa evaluation -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -40,7 +40,7 @@ (require 'ob) (defvar org-babel-default-header-args:ditaa - '((:results . "file") (:exports . "results")) + '((:results . "file") (:exports . "results") (:java . "-Dfile.encoding=UTF-8")) "Default arguments for evaluating a ditaa source block.") (defvar org-ditaa-jar-path) @@ -48,10 +48,15 @@ "Execute a block of Ditaa code with org-babel. This function is called by `org-babel-execute-src-block'." (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (cdr (assoc :file params))) + (out-file ((lambda (el) + (or el + (error + "ditaa code block requires :file header argument"))) + (cdr (assoc :file params)))) (cmdline (cdr (assoc :cmdline params))) + (java (cdr (assoc :java params))) (in-file (org-babel-temp-file "ditaa-")) - (cmd (concat "java -jar " + (cmd (concat "java " java " -jar " (shell-quote-argument (expand-file-name org-ditaa-jar-path)) " " cmdline @@ -61,7 +66,7 @@ This function is called by `org-babel-execute-src-block'." (error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) (with-temp-file in-file (insert body)) (message cmd) (shell-command cmd) - out-file)) + nil)) ;; signal that output has already been written to file (defun org-babel-prep-session:ditaa (session params) "Return an error because ditaa does not support sessions." @@ -69,5 +74,6 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-ditaa) +;; arch-tag: 492cd006-07d9-4fac-bef6-5bb60b48842e ;;; ob-ditaa.el ends here diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el index 09476cd2592..4bb4d532a43 100644 --- a/lisp/org/ob-dot.el +++ b/lisp/org/ob-dot.el @@ -1,11 +1,11 @@ ;;; ob-dot.el --- org-babel functions for dot evaluation -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -77,7 +77,7 @@ This function is called by `org-babel-execute-src-block'." " " (org-babel-process-file-name in-file) " " cmdline " -o " (org-babel-process-file-name out-file)) "") - out-file)) + nil)) ;; signal that output has already been written to file (defun org-babel-prep-session:dot (session params) "Return an error because Dot does not support sessions." @@ -85,5 +85,6 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-dot) +;; arch-tag: 817d0516-7b47-4f77-a8b2-2aadd8e4d0e2 ;;; ob-dot.el ends here diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index 9b9fe68a25a..5892aa5dc7a 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-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -56,15 +56,26 @@ (defun org-babel-execute:emacs-lisp (body params) "Execute a block of emacs-lisp code with Babel." (save-window-excursion - (org-babel-reassemble-table - (eval (read (format "(progn %s)" - (org-babel-expand-body:emacs-lisp body params)))) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))) + ((lambda (result) + (if (or (member "scalar" (cdr (assoc :result-params params))) + (member "verbatim" (cdr (assoc :result-params params)))) + (let ((print-level nil) + (print-length nil)) + (format "%S" result)) + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params)))))) + (eval (read (format (if (member "output" + (cdr (assoc :result-params params))) + "(with-output-to-string %s)" + "(progn %s)") + (org-babel-expand-body:emacs-lisp body params))))))) (provide 'ob-emacs-lisp) +;; arch-tag: e9a3acca-dc84-472a-9f5a-23c35befbcd6 ;;; ob-emacs-lisp.el ends here diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el index 84d0354fc77..cc089cbaa32 100644 --- a/lisp/org/ob-eval.el +++ b/lisp/org/ob-eval.el @@ -1,11 +1,11 @@ ;;; ob-eval.el --- org-babel functions for external code evaluation -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, comint ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -257,5 +257,6 @@ This buffer is named by `org-babel-error-buffer-name'." (provide 'ob-eval) +;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d ;;; ob-eval.el ends here diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 3215bcf4d8a..d65441e95c5 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -1,11 +1,11 @@ ;;; ob-exp.el --- Exportation of org-babel source blocks -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -22,12 +22,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -;;; Commentary: - -;; See the online documentation for more information -;; -;; http://orgmode.org/worg/org-contrib/babel/ - ;;; Code: (require 'ob) (require 'org-exp-blocks) @@ -44,7 +38,7 @@ (add-to-list 'org-export-interblocks '(lob org-babel-exp-lob-one-liners)) (add-hook 'org-export-blocks-postblock-hook 'org-exp-res/src-name-cleanup) -(org-export-blocks-add-block '(src org-babel-exp-src-blocks nil)) +(org-export-blocks-add-block '(src org-babel-exp-src-block nil)) (defcustom org-export-babel-evaluate t "Switch controlling code evaluation during export. @@ -54,30 +48,9 @@ process." :type 'boolean) (put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) -(defvar org-babel-function-def-export-keyword "function" - "The keyword to substitute for the source name line on export. -When exporting a source block function, this keyword will -appear in the exported version in the place of source name -line. A source block is considered to be a source block function -if the source name is present and is followed by a parenthesized -argument list. The parentheses may be empty or contain -whitespace. An example is the following which generates n random -\(uniform) numbers. - -#+source: rand(n) -#+begin_src R - runif(n) -#+end_src") - -(defvar org-babel-function-def-export-indent 4 - "Number of characters to indent a source block on export. -When exporting a source block function, the block contents will -be indented by this many characters. See -`org-babel-function-def-export-name' for the definition of a -source block function.") - -(defmacro org-babel-exp-in-export-file (&rest body) - `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" lang))) +(defmacro org-babel-exp-in-export-file (lang &rest body) + (declare (indent 1)) + `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang))) (heading (nth 4 (ignore-errors (org-heading-components)))) (link (when org-current-export-file (org-make-link-string @@ -92,7 +65,8 @@ source block function.") (set-buffer (get-file-buffer org-current-export-file)) (save-restriction (condition-case nil - (org-open-link-from-string link) + (let ((org-link-search-inhibit-query t)) + (org-open-link-from-string link)) (error (when heading (goto-char (point-min)) (re-search-forward (regexp-quote heading) nil t)))) @@ -100,7 +74,7 @@ source block function.") (set-buffer export-buffer) results))) -(defun org-babel-exp-src-blocks (body &rest headers) +(defun org-babel-exp-src-block (body &rest headers) "Process source block for export. Depending on the 'export' headers argument in replace the source code block with... @@ -115,22 +89,26 @@ results - just like none only the block is run on export ensuring none ----- do not display either code or results upon export" (interactive) - (message "org-babel-exp processing...") + (unless noninteractive (message "org-babel-exp processing...")) (save-excursion (goto-char (match-beginning 0)) (let* ((info (org-babel-get-src-block-info 'light)) (lang (nth 0 info)) - (raw-params (nth 2 info))) + (raw-params (nth 2 info)) hash) ;; bail if we couldn't get any info from the block (when info - (org-babel-exp-in-export-file - (setf (nth 2 info) - (org-babel-merge-params - org-babel-default-header-args - (org-babel-params-from-buffer) - (org-babel-params-from-properties lang) - (if (boundp lang-headers) (eval lang-headers) nil) - raw-params))) + ;; if we're actually going to need the parameters + (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results")) + (org-babel-exp-in-export-file lang + (setf (nth 2 info) + (org-babel-process-params + (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties lang) + (if (boundp lang-headers) (eval lang-headers) nil) + raw-params)))) + (setf hash (org-babel-sha1-hash info))) ;; expand noweb references in the original file (setf (nth 1 info) (if (and (cdr (assoc :noweb (nth 2 info))) @@ -138,11 +116,11 @@ none ----- do not display either code or results upon export" (org-babel-expand-noweb-references info (get-file-buffer org-current-export-file)) (nth 1 info))) - (org-babel-exp-do-export info 'block))))) + (org-babel-exp-do-export info 'block hash))))) (defun org-babel-exp-inline-src-blocks (start end) "Process inline source blocks between START and END for export. -See `org-babel-exp-src-blocks' for export options, currently the +See `org-babel-exp-src-block' for export options, currently the options and are taken from `org-babel-default-inline-header-args'." (interactive) (save-excursion @@ -150,21 +128,22 @@ options and are taken from `org-babel-default-inline-header-args'." (while (and (< (point) end) (re-search-forward org-babel-inline-src-block-regexp end t)) (let* ((info (save-match-data (org-babel-parse-inline-src-block-match))) - (params (nth 2 info)) - (replacement - (save-match-data - (if (org-babel-in-example-or-verbatim) - (buffer-substring (match-beginning 0) (match-end 0)) - ;; expand noweb references in the original file - (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) - (org-babel-expand-noweb-references - info (get-file-buffer org-current-export-file)) - (nth 1 info))) - (org-babel-exp-do-export info 'inline))))) - (setq end (+ end (- (length replacement) (length (match-string 1))))) - (replace-match replacement t t nil 1))))) + (params (nth 2 info)) code-replacement) + (save-match-data + (goto-char (match-beginning 2)) + (when (not (org-babel-in-example-or-verbatim)) + ;; expand noweb references in the original file + (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references + info (get-file-buffer org-current-export-file)) + (nth 1 info))) + (setq code-replacement (org-babel-exp-do-export info 'inline)))) + (if code-replacement + (replace-match code-replacement nil nil nil 1) + (org-babel-examplize-region (match-beginning 1) (match-end 1)) + (forward-char 2)))))) (defun org-exp-res/src-name-cleanup () "Clean up #+results and #+srcname lines for export. @@ -187,141 +166,106 @@ Example and verbatim code include escaped portions of an org-mode buffer code that should be treated as normal org-mode text." (or (org-in-indented-comment-line) - (save-excursion - (save-match-data + (save-match-data + (save-excursion (goto-char (point-at-bol)) (looking-at "[ \t]*:[ \t]"))) + (org-in-verbatim-emphasis) (org-in-regexps-block-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src"))) +(defvar org-babel-default-lob-header-args) (defun org-babel-exp-lob-one-liners (start end) "Process Library of Babel calls between START and END for export. -See `org-babel-exp-src-blocks' for export options. Currently the +See `org-babel-exp-src-block' for export options. Currently the options are taken from `org-babel-default-header-args'." (interactive) - (let (replacement) - (save-excursion - (goto-char start) - (while (and (< (point) end) - (re-search-forward org-babel-lob-one-liner-regexp nil t)) - (setq replacement - (let ((lob-info (org-babel-lob-get-info))) - (save-match-data - (org-babel-exp-do-export - (list "emacs-lisp" "results" - (org-babel-merge-params - org-babel-default-header-args - (org-babel-params-from-buffer) - (org-babel-params-from-properties) - (org-babel-parse-header-arguments - (org-babel-clean-text-properties - (concat ":var results=" - (mapconcat #'identity - (butlast lob-info) " "))))) - (car (last lob-info))) - 'lob)))) - (setq end (+ end (- (length replacement) (length (match-string 0))))) - (replace-match replacement t t))))) + (save-excursion + (goto-char start) + (while (and (< (point) end) + (re-search-forward org-babel-lob-one-liner-regexp nil t)) + (unless (and (match-string 12) (org-babel-in-example-or-verbatim)) + (let* ((lob-info (org-babel-lob-get-info)) + (inlinep (match-string 11)) + (inline-start (match-end 11)) + (inline-end (match-end 0)) + (rep (let ((lob-info (org-babel-lob-get-info))) + (save-match-data + (org-babel-exp-do-export + (list "emacs-lisp" "results" + (org-babel-merge-params + org-babel-default-header-args + org-babel-default-lob-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-babel-clean-text-properties + (concat ":var results=" + (mapconcat #'identity + (butlast lob-info) " "))))) + "" nil (car (last lob-info))) + 'lob))))) + (setq end (+ end (- (length rep) + (- (length (match-string 0)) + (length (or (match-string 11) "")))))) + (if inlinep + (save-excursion + (goto-char inline-start) + (delete-region inline-start inline-end) + (insert rep)) + (replace-match rep t t))))))) -(defun org-babel-exp-do-export (info type) +(defun org-babel-exp-do-export (info type &optional hash) "Return a string with the exported content of a code block. The function respects the value of the :exports header argument." (flet ((silently () (let ((session (cdr (assoc :session (nth 2 info))))) - (when (and session - (not (equal "none" session))) + (when (not (and session (equal "none" session))) (org-babel-exp-results info type 'silent)))) - (clean () (org-babel-remove-result info))) + (clean () (unless (eq type 'inline) (org-babel-remove-result info)))) (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) - (none (silently) (clean) "") - (code (silently) (clean) (org-babel-exp-code info type)) - (results (org-babel-exp-results info type)) - (both (concat (org-babel-exp-code info type) - "\n\n" - (org-babel-exp-results info type)))))) + ('none (silently) (clean) "") + ('code (silently) (clean) (org-babel-exp-code info)) + ('results (org-babel-exp-results info type nil hash) "") + ('both (org-babel-exp-results info type nil hash) + (org-babel-exp-code info))))) -(defvar backend) -(defun org-babel-exp-code (info type) - "Prepare and return code in the current code block for export. -Code is prepared in a manner suitable for export by -org-mode. This function is called by `org-babel-exp-do-export'. -The code block is not evaluated." - (let ((lang (nth 0 info)) - (body (nth 1 info)) - (switches (nth 3 info)) - (name (nth 4 info)) - (args (mapcar #'cdr (org-babel-get-header (nth 2 info) :var)))) - (case type - (inline (format "=%s=" body)) - (block - (let ((str - (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body - (if (and body (string-match "\n$" body)) - "" "\n")))) - (when name - (add-text-properties - 0 (length str) - (list 'org-caption - (format "%s(%s)" - name - (mapconcat #'identity args ", "))) - str)) - str)) - (lob - (let ((call-line (and (string-match "results=" (car args)) - (substring (car args) (match-end 0))))) - (cond - ((eq backend 'html) - (format "\n#+HTML: <label class=\"org-src-name\">%s</label>\n" - call-line)) - ((format ": %s\n" call-line)))))))) +(defun org-babel-exp-code (info) + "Return the original code block formatted for export." + (org-fill-template + "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC\n" + `(("lang" . ,(nth 0 info)) + ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info))) + ("body" . ,(nth 1 info))))) -(defun org-babel-exp-results (info type &optional silent) +(defun org-babel-exp-results (info type &optional silent hash) "Evaluate and return the results of the current code block for export. Results are prepared in a manner suitable for export by org-mode. This function is called by `org-babel-exp-do-export'. The code block will be evaluated. Optional argument SILENT can be used to inhibit insertion of results into the buffer." - (or - (when org-export-babel-evaluate - (let ((lang (nth 0 info)) - (body (nth 1 info))) - (setf (nth 2 info) (org-babel-exp-in-export-file - (org-babel-process-params (nth 2 info)))) - ;; skip code blocks which we can't evaluate - (when (fboundp (intern (concat "org-babel-execute:" lang))) - (org-babel-eval-wipe-error-buffer) - (if (equal type 'inline) - (let ((raw (org-babel-execute-src-block - nil info '((:results . "silent")))) - (result-params (split-string - (cdr (assoc :results (nth 2 info)))))) - (unless silent - (cond ;; respect the value of the :results header argument - ((member "file" result-params) - (org-babel-result-to-file raw)) - ((or (member "raw" result-params) - (member "org" result-params)) - (format "%s" raw)) - ((member "code" result-params) - (format "src_%s{%s}" lang raw)) - (t - (if (stringp raw) - (if (= 0 (length raw)) "=(no results)=" - (format "%s" raw)) - (format "%S" raw)))))) - (prog1 nil - (setf (nth 2 info) + (when (and org-export-babel-evaluate + (not (and hash (equal hash (org-babel-current-result-hash))))) + (let ((lang (nth 0 info)) + (body (nth 1 info))) + ;; skip code blocks which we can't evaluate + (when (fboundp (intern (concat "org-babel-execute:" lang))) + (org-babel-eval-wipe-error-buffer) + (prog1 nil + (setf (nth 2 info) + (org-babel-exp-in-export-file lang + (org-babel-process-params (org-babel-merge-params (nth 2 info) - `((:results . ,(if silent "silent" "replace"))))) - (cond - ((equal type 'block) (org-babel-execute-src-block nil info)) - ((equal type 'lob) - (save-excursion - (re-search-backward org-babel-lob-one-liner-regexp nil t) - (org-babel-execute-src-block nil info))))))))) - "")) + `((:results . ,(if silent "silent" "replace"))))))) + (cond + ((or (equal type 'block) (equal type 'inline)) + (org-babel-execute-src-block nil info)) + ((equal type 'lob) + (save-excursion + (re-search-backward org-babel-lob-one-liner-regexp nil t) + (org-babel-execute-src-block nil info))))))))) (provide 'ob-exp) +;; arch-tag: 523abf4c-76d1-44ed-9f27-e3bddf34bf0f ;;; ob-exp.el ends here diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index 41b47102d65..8259cf839e5 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -1,11 +1,11 @@ ;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -157,7 +157,7 @@ This function is called by `org-babel-execute-src-block'." (gnuplot-send-buffer-to-gnuplot))) (if (member "output" (split-string result-type)) output - out-file)))) + nil)))) ;; signal that output has already been written to file (defun org-babel-prep-session:gnuplot (session params) "Prepare SESSION according to the header arguments in PARAMS." @@ -230,5 +230,6 @@ Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." (provide 'ob-gnuplot) +;; arch-tag: 50490ace-a9e1-4b29-a6e5-0db9f16c610b ;;; ob-gnuplot.el ends here diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index 43c14deb407..63e76f6f139 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -1,11 +1,11 @@ ;;; ob-haskell.el --- org-babel functions for haskell evaluation -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -51,6 +51,7 @@ (declare-function inferior-haskell-load-file "ext:inf-haskell" (&optional reload)) +(defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) (defvar org-babel-default-header-args:haskell '()) @@ -191,7 +192,7 @@ constructs (header arguments, no-web syntax etc...) are ignored." (save-excursion ;; export to latex w/org and save as .lhs (find-file tmp-org-file) (funcall 'org-export-as-latex nil) - (kill-buffer) + (kill-buffer nil) (delete-file tmp-org-file) (find-file tmp-tex-file) (goto-char (point-min)) (forward-line 2) @@ -201,7 +202,7 @@ constructs (header arguments, no-web syntax etc...) are ignored." (replace-match (save-match-data (org-remove-indentation (match-string 0))) t t)) (setq contents (buffer-string)) - (save-buffer) (kill-buffer)) + (save-buffer) (kill-buffer nil)) (delete-file tmp-tex-file) ;; save org exported latex to a .lhs file (with-temp-file lhs-file (insert contents)) @@ -212,5 +213,6 @@ constructs (header arguments, no-web syntax etc...) are ignored." (provide 'ob-haskell) +;; arch-tag: b53f75f3-ba1a-4b05-82d9-a2a0d4e70804 ;;; ob-haskell.el ends here diff --git a/lisp/org/ob-java.el b/lisp/org/ob-java.el new file mode 100644 index 00000000000..3f349fea271 --- /dev/null +++ b/lisp/org/ob-java.el @@ -0,0 +1,74 @@ +;;; ob-java.el --- org-babel functions for java evaluation + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.7 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Currently this only supports the external compilation and execution +;; of java code blocks (i.e., no session support). + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("java" . "java")) + +(defvar org-babel-java-command "java" + "Name of the java command.") + +(defvar org-babel-java-compiler "javac" + "Name of the java compiler.") + +(defun org-babel-execute:java (body params) + (let* ((classname (or (cdr (assoc :classname params)) + (error + "Can't compile a java block without a classname"))) + (packagename (file-name-directory classname)) + (src-file (concat classname ".java")) + (full-body (org-babel-expand-body:generic body params)) + (compile + (progn (with-temp-file src-file (insert full-body)) + (org-babel-eval + (concat org-babel-java-compiler " " src-file) "")))) + ;; created package-name directories if missing + (unless (or (not packagename) (file-exists-p packagename)) + (make-directory packagename 'parents)) + ((lambda (results) + (org-babel-reassemble-table + (if (member "vector" (cdr (assoc :result-params params))) + (let ((tmp-file (org-babel-temp-file "c-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file)) + (org-babel-read results)) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) + (org-babel-eval (concat org-babel-java-command " " classname) "")))) + +(provide 'ob-java) + +;; arch-tag: dd1cfb00-7f76-4ecf-922c-f7031b68b85e + +;;; ob-java.el ends here diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index 06acfb391bc..f9c1722eb65 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -1,11 +1,11 @@ ;;; ob-js.el --- org-babel functions for Javascript -;; Copyright (C) 2010-2011 Free Software Foundation +;; Copyright (C) 2010 Free Software Foundation ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, js ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;;; License: @@ -160,5 +160,6 @@ then create. Return the initialized session." (provide 'ob-js) +;; arch-tag: 84401fb3-b8d9-4bb6-9a90-cbe2d103d494 ;;; ob-js.el ends here diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el index d1422c6876f..b55913599cc 100644 --- a/lisp/org/ob-keys.el +++ b/lisp/org/ob-keys.el @@ -1,11 +1,11 @@ ;;; ob-keys.el --- key bindings for org-babel -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -73,10 +73,14 @@ functions which are assigned key bindings, and see ("t" . org-babel-tangle) ("\C-f" . org-babel-tangle-file) ("f" . org-babel-tangle-file) + ("\C-c" . org-babel-check-src-block) + ("c" . org-babel-check-src-block) ("\C-l" . org-babel-load-in-session) ("l" . org-babel-load-in-session) ("\C-i" . org-babel-lob-ingest) ("i" . org-babel-lob-ingest) + ("\C-I" . org-babel-view-src-block-info) + ("I" . org-babel-view-src-block-info) ("\C-z" . org-babel-switch-to-session) ("z" . org-babel-switch-to-session-with-code) ("\C-a" . org-babel-sha1-hash) @@ -93,5 +97,6 @@ a-list placed behind the generic `org-babel-key-prefix'.") (provide 'ob-keys) +;; arch-tag: 01e348ee-4906-46fa-839a-6b7b6f989048 ;;; ob-keys.el ends here diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el index 9bb0f318be6..2121a8e5296 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -1,11 +1,11 @@ ;;; ob-latex.el --- org-babel functions for latex "evaluation" -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -37,6 +37,7 @@ (declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra)) (declare-function org-export-latex-fix-inputenc "org-latex" ()) +(defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) (defvar org-format-latex-header) @@ -122,7 +123,7 @@ This function is called by `org-babel-execute-src-block'." ((string-match "\\.\\([^\\.]+\\)$" out-file) (error "can not create %s files, please specify a .png or .pdf file" (match-string 1 out-file)))) - out-file) + nil) ;; signal that output has already been written to file body)) (defun org-babel-latex-tex-to-pdf (file) @@ -175,5 +176,6 @@ Extracted from `org-export-as-pdf' in org-latex.el." (provide 'ob-latex) +;; arch-tag: 1f13f7e2-26de-4c24-9274-9f331d4c6ff3 ;;; ob-latex.el ends here diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el index 51f0282c5c0..425a3458685 100644 --- a/lisp/org/ob-ledger.el +++ b/lisp/org/ob-ledger.el @@ -1,11 +1,11 @@ ;;; ob-ledger.el --- org-babel functions for ledger evaluation -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Eric S Fraga ;; Keywords: literate programming, reproducible research, accounting ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -52,7 +52,7 @@ called by `org-babel-execute-src-block'." (in-file (org-babel-temp-file "ledger-")) (out-file (org-babel-temp-file "ledger-output-"))) (with-temp-file in-file (insert body)) - (message (concat "ledger" + (message "%s" (concat "ledger" " -f " (org-babel-process-file-name in-file) " " cmdline)) (with-output-to-string @@ -67,5 +67,6 @@ called by `org-babel-execute-src-block'." (provide 'ob-ledger) +;; arch-tag: 7bbb529e-95a1-4236-9d29-b0000b918c7c ;;; ob-ledger.el ends here diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el new file mode 100644 index 00000000000..23f5d511d34 --- /dev/null +++ b/lisp/org/ob-lilypond.el @@ -0,0 +1,447 @@ +;;; ob-lilypond.el --- org-babel functions for lilypond evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Martyn Jago +;; Keywords: babel language, literate programming +;; Homepage: https://github.com/mjago/ob-lilypond +;; Version: 7.7 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Installation / usage info, and examples are available at +;; https://github.com/mjago/ob-lilypond + +;;; Code: +(require 'ob) +(require 'ob-eval) +(require 'ob-tangle) +(defalias 'lilypond-mode 'LilyPond-mode) + +(declare-function show-all "outline" ()) + +(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly")) + +(defvar org-babel-default-header-args:lilypond '() + "Default header arguments for js code blocks.") + +(defconst ly-version "0.3" + "The version number of the file ob-lilypond.el.") + +(defvar ly-compile-post-tangle t + "Following the org-babel-tangle (C-c C-v t) command, +ly-compile-post-tangle determines whether ob-lilypond should +automatically attempt to compile the resultant tangled file. +If the value is nil, no automated compilation takes place. +Default value is t") + +(defvar ly-display-pdf-post-tangle t + "Following a successful LilyPond compilation +ly-display-pdf-post-tangle determines whether to automate the +drawing / redrawing of the resultant pdf. If the value is nil, +the pdf is not automatically redrawn. Default value is t") + +(defvar ly-play-midi-post-tangle t + "Following a successful LilyPond compilation +ly-play-midi-post-tangle determines whether to automate the +playing of the resultant midi file. If the value is nil, +the midi file is not automatically played. Default value is t") + +(defvar ly-OSX-ly-path + "/Applications/lilypond.app/Contents/Resources/bin/lilypond") +(defvar ly-OSX-pdf-path "open") +(defvar ly-OSX-midi-path "open") + +(defvar ly-nix-ly-path "/usr/bin/lilypond") +(defvar ly-nix-pdf-path "evince") +(defvar ly-nix-midi-path "timidity") + +(defvar ly-win32-ly-path "lilypond") +(defvar ly-win32-pdf-path "") +(defvar ly-win32-midi-path "") + +(defvar ly-gen-png nil +"Image generation (png) can be turned on by default by setting +LY-GEN-PNG to t") + +(defvar ly-gen-svg nil +"Image generation (SVG) can be turned on by default by setting +LY-GEN-SVG to t") + +(defvar ly-gen-html nil +"HTML generation can be turned on by default by setting +LY-GEN-HTML to t") + +(defvar ly-use-eps nil +"You can force the compiler to use the EPS backend by setting +LY-USE-EPS to t") + +(defvar ly-arrange-mode nil + "Arrange mode is turned on by setting LY-ARRANGE-MODE +to t. In Arrange mode the following settings are altered +from default... +:tangle yes, :noweb yes +:results silent :comments yes. +In addition lilypond block execution causes tangling of all lilypond +blocks") + +(defun org-babel-expand-body:lilypond (body params) + "Expand BODY according to PARAMS, return the expanded body." + + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (mapc + (lambda (pair) + (let ((name (symbol-name (car pair))) + (value (cdr pair))) + (setq body + (replace-regexp-in-string + (concat "\$" (regexp-quote name)) + (if (stringp value) value (format "%S" value)) + body)))) + vars) + body)) + +(defun org-babel-execute:lilypond (body params) + "This function is called by `org-babel-execute-src-block'. +Depending on whether we are in arrange mode either: +1. Attempt to execute lilypond block according to header settings + (This is the default basic mode) +2. Tangle all lilypond blocks and process the result (arrange mode)" + + (ly-set-header-args ly-arrange-mode) + (if ly-arrange-mode + (ly-tangle) + (ly-process-basic body params))) + +(defun ly-tangle () + "ob-lilypond specific tangle, attempts to invoke +=ly-execute-tangled-ly= if tangle is successful. Also passes +specific arguments to =org-babel-tangle=" + + (interactive) + (if (org-babel-tangle nil "yes" "lilypond") + (ly-execute-tangled-ly) nil)) + +(defun ly-process-basic (body params) + "Execute a lilypond block in basic mode" + + (let* ((result-params (cdr (assoc :result-params params))) + (out-file (cdr (assoc :file params))) + (cmdline (or (cdr (assoc :cmdline params)) + "")) + (in-file (org-babel-temp-file "lilypond-"))) + + (with-temp-file in-file + (insert (org-babel-expand-body:generic body params))) + + (org-babel-eval + (concat + (ly-determine-ly-path) + " -dbackend=eps " + "-dno-gs-load-fonts " + "-dinclude-eps-fonts " + "--png " + "--output=" + (file-name-sans-extension out-file) + " " + cmdline + in-file) "") + ) nil) + +(defun org-babel-prep-session:lilypond (session params) + "Return an error because LilyPond exporter does not support sessions." + + (error "Sorry, LilyPond does not currently support sessions!")) + +(defun ly-execute-tangled-ly () + "Compile result of block tangle with lilypond. +If error in compilation, attempt to mark the error in lilypond org file" + + (when ly-compile-post-tangle + (let ((ly-tangled-file (ly-switch-extension + (buffer-file-name) ".lilypond")) + (ly-temp-file (ly-switch-extension + (buffer-file-name) ".ly"))) + (if (file-exists-p ly-tangled-file) + (progn + (when (file-exists-p ly-temp-file) + (delete-file ly-temp-file)) + (rename-file ly-tangled-file + ly-temp-file)) + (error "Error: Tangle Failed!") t) + (switch-to-buffer-other-window "*lilypond*") + (erase-buffer) + (ly-compile-lilyfile ly-temp-file) + (goto-char (point-min)) + (if (not (ly-check-for-compile-error ly-temp-file)) + (progn + (other-window -1) + (ly-attempt-to-open-pdf ly-temp-file) + (ly-attempt-to-play-midi ly-temp-file)) + (error "Error in Compilation!")))) nil) + +(defun ly-compile-lilyfile (file-name &optional test) + "Compile lilypond file and check for compile errors +FILE-NAME is full path to lilypond (.ly) file" + + (message "Compiling LilyPond...") + (let ((arg-1 (ly-determine-ly-path)) ;program + (arg-2 nil) ;infile + (arg-3 "*lilypond*") ;buffer + (arg-4 t) ;display + (arg-5 (if ly-gen-png "--png" "")) ;&rest... + (arg-6 (if ly-gen-html "--html" "")) + (arg-7 (if ly-use-eps "-dbackend=eps" "")) + (arg-8 (if ly-gen-svg "-dbackend=svg" "")) + (arg-9 (concat "--output=" (file-name-sans-extension file-name))) + (arg-10 file-name)) + (if test + `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 + ,arg-6 ,arg-7 ,arg-8 ,arg-9 ,arg-10) + (call-process + arg-1 arg-2 arg-3 arg-4 arg-5 + arg-6 arg-7 arg-8 arg-9 arg-10)))) + +(defun ly-check-for-compile-error (file-name &optional test) + "Check for compile error. +This is performed by parsing the *lilypond* buffer +containing the output message from the compilation. +FILE-NAME is full path to lilypond file. +If TEST is t just return nil if no error found, and pass +nil as file-name since it is unused in this context" + (let ((is-error (search-forward "error:" nil t))) + (if (not test) + (if (not is-error) + nil + (ly-process-compile-error file-name)) + is-error))) + +(defun ly-process-compile-error (file-name) + "Process the compilation error that has occurred. +FILE-NAME is full path to lilypond file" + + (let ((line-num (ly-parse-line-num))) + (let ((error-lines (ly-parse-error-line file-name line-num))) + (ly-mark-error-line file-name error-lines) + (error "Error: Compilation Failed!")))) + +(defun ly-mark-error-line (file-name line) + "Mark the erroneous lines in the lilypond org buffer. +FILE-NAME is full path to lilypond file. +LINE is the erroneous line" + + (switch-to-buffer-other-window + (concat (file-name-nondirectory + (ly-switch-extension file-name ".org")))) + (let ((temp (point))) + (goto-char (point-min)) + (setq case-fold-search nil) + (if (search-forward line nil t) + (progn + (show-all) + (set-mark (point)) + (goto-char (- (point) (length line)))) + (goto-char temp)))) + +(defun ly-parse-line-num (&optional buffer) + "Extract error line number." + + (when buffer + (set-buffer buffer)) + (let ((start + (and (search-backward ":" nil t) + (search-backward ":" nil t) + (search-backward ":" nil t) + (search-backward ":" nil t))) + (num nil)) + (if start + (progn + (forward-char) + (let ((num (buffer-substring + (+ 1 start) + (- (search-forward ":" nil t) 1)))) + (setq num (string-to-number num)) + (if (numberp num) + num + nil))) + nil))) + +(defun ly-parse-error-line (file-name lineNo) + "Extract the erroneous line from the tangled .ly file +FILE-NAME is full path to lilypond file. +LINENO is the number of the erroneous line" + + (with-temp-buffer + (insert-file-contents (ly-switch-extension file-name ".ly") + nil nil nil t) + (if (> lineNo 0) + (progn + (goto-char (point-min)) + (forward-line (- lineNo 1)) + (buffer-substring (point) (point-at-eol))) + nil))) + +(defun ly-attempt-to-open-pdf (file-name &optional test) + "Attempt to display the generated pdf file +FILE-NAME is full path to lilypond file +If TEST is non-nil, the shell command is returned and is not run" + + (when ly-display-pdf-post-tangle + (let ((pdf-file (ly-switch-extension file-name ".pdf"))) + (if (file-exists-p pdf-file) + (let ((cmd-string + (concat (ly-determine-pdf-path) " " pdf-file))) + (if test + cmd-string + (shell-command cmd-string))) + (message "No pdf file generated so can't display!"))))) + +(defun ly-attempt-to-play-midi (file-name &optional test) + "Attempt to play the generated MIDI file +FILE-NAME is full path to lilypond file +If TEST is non-nil, the shell command is returned and is not run" + + (when ly-play-midi-post-tangle + (let ((midi-file (ly-switch-extension file-name ".midi"))) + (if (file-exists-p midi-file) + (let ((cmd-string + (concat (ly-determine-midi-path) " " midi-file))) + (if test + cmd-string + (shell-command cmd-string))) + (message "No midi file generated so can't play!"))))) + +(defun ly-determine-ly-path (&optional test) + "Return correct path to ly binary depending on OS +If TEST is non-nil, it contains a simulation of the OS for test purposes" + + (let ((sys-type + (or test system-type))) + (cond ((string= sys-type "darwin") + ly-OSX-ly-path) + ((string= sys-type "win32") + ly-win32-ly-path) + (t ly-nix-ly-path)))) + +(defun ly-determine-pdf-path (&optional test) + "Return correct path to pdf viewer depending on OS +If TEST is non-nil, it contains a simulation of the OS for test purposes" + + (let ((sys-type + (or test system-type))) + (cond ((string= sys-type "darwin") + ly-OSX-pdf-path) + ((string= sys-type "win32") + ly-win32-pdf-path) + (t ly-nix-pdf-path)))) + +(defun ly-determine-midi-path (&optional test) + "Return correct path to midi player depending on OS +If TEST is non-nil, it contains a simulation of the OS for test purposes" + + (let ((sys-type + (or test test system-type))) + (cond ((string= sys-type "darwin") + ly-OSX-midi-path) + ((string= sys-type "win32") + ly-win32-midi-path) + (t ly-nix-midi-path)))) + +(defun ly-toggle-midi-play () + "Toggle whether midi will be played following a successful compilation" + + (interactive) + (setq ly-play-midi-post-tangle + (not ly-play-midi-post-tangle)) + (message (concat "Post-Tangle MIDI play has been " + (if ly-play-midi-post-tangle + "ENABLED." "DISABLED.")))) + +(defun ly-toggle-pdf-display () + "Toggle whether pdf will be displayed following a successful compilation" + + (interactive) + (setq ly-display-pdf-post-tangle + (not ly-display-pdf-post-tangle)) + (message (concat "Post-Tangle PDF display has been " + (if ly-display-pdf-post-tangle + "ENABLED." "DISABLED.")))) + +(defun ly-toggle-png-generation () + "Toggle whether png image will be generated by compilation" + + (interactive) + (setq ly-gen-png + (not ly-gen-png)) + (message (concat "PNG image generation has been " + (if ly-gen-png "ENABLED." "DISABLED.")))) + +(defun ly-toggle-html-generation () + "Toggle whether html will be generated by compilation" + + (interactive) + (setq ly-gen-html + (not ly-gen-html)) + (message (concat "HTML generation has been " + (if ly-gen-html "ENABLED." "DISABLED.")))) + +(defun ly-toggle-arrange-mode () + "Toggle whether in Arrange mode or Basic mode" + + (interactive) + (setq ly-arrange-mode + (not ly-arrange-mode)) + (message (concat "Arrange mode has been " + (if ly-arrange-mode "ENABLED." "DISABLED.")))) + +(defun ly-version (&optional insert-at-point) + (interactive) + (let ((version (format "ob-lilypond version %s" ly-version))) + (when insert-at-point (insert version)) + (message version))) + + (defun ly-switch-extension (file-name ext) + "Utility command to swap current FILE-NAME extension with EXT" + + (concat (file-name-sans-extension + file-name) ext)) + +(defun ly-get-header-args (mode) + "Default arguments to use when evaluating a lilypond +source block. These depend upon whether we are in arrange +mode i.e. ARRANGE-MODE is t" + (cond (mode + '((:tangle . "yes") + (:noweb . "yes") + (:results . "silent") + (:comments . "yes"))) + (t + '((:results . "file") + (:exports . "results"))))) + +(defun ly-set-header-args (mode) + "Set org-babel-default-header-args:lilypond +dependent on LY-ARRANGE-MODE" + (setq org-babel-default-header-args:lilypond + (ly-get-header-args mode))) + +(provide 'ob-lilypond) + +;; arch-tag: ac449eea-2cf2-4dc5-ae33-426f57ba4894 + +;;; ob-lilypond.el ends here diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index 1a8ad38a199..97e8a97b24b 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -1,35 +1,30 @@ -;;; ob-lisp.el --- org-babel functions for Common Lisp +;;; ob-lisp.el --- org-babel functions for common lisp evaluation -;; Copyright (C) 2010-2011 Free Software Foundation +;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. -;; Author: David T. O'Toole <dto@gnu.org>, Eric Schulte -;; Keywords: literate programming, reproducible research, lisp +;; Author: Joel Boehland, Eric Schulte, David T. O'Toole <dto@gnu.org> +;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 -;;; License: +;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, +;; 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; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: -;; Now working with SBCL for both session and external evaluation. -;; -;; This certainly isn't optimally robust, but it seems to be working -;; for the basic use cases. +;;; support for evaluating common lisp code, relies on slime for all eval ;;; Requirements: @@ -38,75 +33,74 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (declare-function slime-eval "ext:slime" (sexp &optional package)) -(declare-function slime-process "ext:slime" (&optional connection)) -(declare-function slime-connected-p "ext:slime" ()) -(defvar org-babel-default-header-args:lisp '() - "Default header arguments for lisp code blocks.") +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp")) -(defcustom org-babel-lisp-cmd "sbcl --script" - "Name of command used to evaluate lisp blocks." +(defvar org-babel-default-header-args:lisp '()) +(defvar org-babel-header-arg-names:lisp '(package)) + +(defcustom org-babel-lisp-dir-fmt + "(let ((*default-pathname-defaults* #P%S)) %%s)" + "Format string used to wrap code bodies to set the current directory. +For example a value of \"(progn ;; %s\\n %%s)\" would ignore the +current directory string." :group 'org-babel :type 'string) (defun org-babel-expand-body:lisp (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) - vars "\n ") - ")\n" body ")") + (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 "(pprint %s)" body) body))) (defun org-babel-execute:lisp (body params) - "Execute a block of Lisp code with org-babel. -This function is called by `org-babel-execute-src-block'" - (require 'slime) - (message "executing Lisp source code block") - (let* ((session (org-babel-lisp-initiate-session - (cdr (assoc :session params)))) - (result-type (cdr (assoc :result-type params))) - (full-body (org-babel-expand-body:lisp body params))) - (read - (if session - ;; session evaluation - (save-window-excursion - (cadr (slime-eval `(swank:eval-and-grab-output ,full-body)))) - ;; external evaluation - (let ((script-file (org-babel-temp-file "lisp-script-"))) - (with-temp-file script-file - (insert - ;; return the value or the output - (if (string= result-type "value") - (format "(print %s)" full-body) - full-body))) - (org-babel-eval - (format "%s %s" org-babel-lisp-cmd - (org-babel-process-file-name script-file)) "")))))) - -;; This function should be used to assign any variables in params in -;; the context of the session environment. -(defun org-babel-prep-session:lisp (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (error "not yet implemented")) - -(defun org-babel-lisp-initiate-session (&optional session) - "If there is not a current inferior-process-buffer in SESSION -then create. Return the initialized session." + "Execute a block of Common Lisp code with Babel." (require 'slime) - (unless (string= session "none") - (save-window-excursion - (or (slime-connected-p) - (slime-process))))) + (org-babel-reassemble-table + ((lambda (result) + (if (member "output" (cdr (assoc :result-params params))) + (car result) + (condition-case nil + (read (org-bable-lisp-vector-to-list (cadr result))) + (error (cadr result))))) + (with-temp-buffer + (insert (org-babel-expand-body:lisp body params)) + (slime-eval `(swank:eval-and-grab-output + ,(let ((dir (if (assoc :dir params) + (cdr (assoc :dir params)) + default-directory))) + (format + (if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)") + (buffer-substring-no-properties + (point-min) (point-max))))) + (cdr (assoc :package params))))) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params))))) + +(defun org-bable-lisp-vector-to-list (results) + ;; TODO: better would be to replace #(...) with [...] + (replace-regexp-in-string "#(" "(" results)) (provide 'ob-lisp) +;; arch-tag: 18086168-009f-4947-bbb5-3532375d851d ;;; ob-lisp.el ends here diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index 96081c16236..5c4894d4510 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -1,11 +1,11 @@ ;;; ob-lob.el --- functions supporting the Library of Babel -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -22,13 +22,9 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -;;; Commentary: - -;; See the online documentation for more information -;; -;; http://orgmode.org/worg/org-contrib/babel/ - ;;; Code: +(eval-when-compile + (require 'cl)) (require 'ob) (require 'ob-table) @@ -43,11 +39,14 @@ To add files to this list use the `org-babel-lob-ingest' command." :group 'org-babel :type 'list) +(defvar org-babel-default-lob-header-args '((:exports . "results")) + "Default header arguments to use when exporting #+lob/call lines.") + ;;;###autoload (defun org-babel-lob-ingest (&optional file) "Add all named source-blocks defined in FILE to `org-babel-library-of-babel'." - (interactive "f") + (interactive "fFile: ") (let ((lob-ingest-count 0)) (org-babel-map-src-blocks file (let* ((info (org-babel-get-src-block-info 'light)) @@ -67,12 +66,25 @@ To add files to this list use the `org-babel-lob-ingest' command." If you change the value of this variable then your files may become unusable by other org-babel users, and vice versa.") -(defconst org-babel-lob-one-liner-regexp +(defconst org-babel-block-lob-one-liner-regexp (concat "^\\([ \t]*\\)#\\+\\(?:" (mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|") "\\):[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)" - "\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\([^\n]*\\)") + "\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?") + "Regexp to match non-inline calls to predefined source block functions.") + +(defconst org-babel-inline-lob-one-liner-regexp + (concat + "\\([^\n]*\\)\\(?:" + (mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|") + "\\)_\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)" + "\(\\([^\n]*\\)\)\\(\\[\\(.*?\\)\\]\\)?") + "Regexp to match inline calls to predefined source block functions.") + +(defconst org-babel-lob-one-liner-regexp + (concat "\\(" org-babel-block-lob-one-liner-regexp + "\\|" org-babel-inline-lob-one-liner-regexp "\\)") "Regexp to match calls to predefined source block functions.") ;; functions for executing lob one-liners @@ -88,20 +100,25 @@ if so then run the appropriate source block from the Library." ;;;###autoload (defun org-babel-lob-get-info () "Return a Library of Babel function call as a string." - (let ((case-fold-search t)) - (save-excursion - (beginning-of-line 1) - (if (looking-at org-babel-lob-one-liner-regexp) - (append + (flet ((nonempty (a b) + (let ((it (match-string a))) + (if (= (length it) 0) (match-string b) it)))) + (let ((case-fold-search t)) + (save-excursion + (beginning-of-line 1) + (when (looking-at org-babel-lob-one-liner-regexp) + (append (mapcar #'org-babel-clean-text-properties (list (format "%s%s(%s)%s" - (match-string 2) - (if (match-string 4) - (concat "[" (match-string 4) "]") "") - (or (match-string 6) "") (match-string 7)) - (match-string 8))) - (list (length (match-string 1)))))))) + (nonempty 3 12) + (if (not (= 0 (length (nonempty 5 13)))) + (concat "[" (nonempty 5 13) "]") "") + (or (nonempty 7 16) "") + (or (nonempty 8 19) "")) + (nonempty 9 18))) + (list (length (if (= (length (match-string 12)) 0) + (match-string 2) (match-string 11)))))))))) (defun org-babel-lob-execute (info) "Execute the lob call specified by INFO." @@ -119,5 +136,6 @@ if so then run the appropriate source block from the Library." (provide 'ob-lob) +;; arch-tag: ce0712c9-2147-4019-ba3f-42341b8b474b ;;; ob-lob.el ends here diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el index 441f9d7a73a..3ddb3065fc7 100644 --- a/lisp/org/ob-matlab.el +++ b/lisp/org/ob-matlab.el @@ -1,11 +1,11 @@ ;;; ob-matlab.el --- org-babel support for matlab evaluation -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -43,5 +43,6 @@ (provide 'ob-matlab) +;; arch-tag: 6b234299-c1f7-4eb1-ace8-7b93344065ac ;;; ob-matlab.el ends here diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el new file mode 100644 index 00000000000..7534065f1f7 --- /dev/null +++ b/lisp/org/ob-maxima.el @@ -0,0 +1,80 @@ +;;; ob-maxima.el --- org-babel functions for maxima evaluation + +;; Copyright (c) 2009, 2010, 2011 Eric S Fraga, Eric Schulte + +;; Author: Eric S Fraga, Eric Schulte +;; Keywords: literate programming, reproducible research, maxima +;; Homepage: http://orgmode.org +;; Version: 7.7 + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Org-Babel support for evaluating maxima entries. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in maxima +;; +;; 2) we are generally only going to return output from maxima +;; +;; 3) we are adding the "cmdline" header argument +;; +;; 4) there are no variables + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:maxima '()) + +(defun org-babel-maxima-expand (body params) + "Expand a block of Maxima code according to its header arguments." + body) + +(defun org-babel-execute:maxima (body params) + "Execute a block of Maxima entries with org-babel. This function is +called by `org-babel-execute-src-block'." + (message "executing Maxima source code block") + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "maxima-")) + (cmd (format "maxima --very-quiet -r 'batchload(%S)$' %s" + in-file cmdline))) + (with-temp-file in-file (insert body)) + (message cmd) + ((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' " + (mapconcat + #'identity + (delq nil + (mapcar (lambda (line) + (unless (or (string-match "batch" line) + (string-match "^rat: replaced .*$" line) + (= 0 (length line))) + line)) + (split-string raw "[\r\n]"))) "\n")) + (org-babel-eval cmd "")))) + +(defun org-babel-prep-session:maxima (session params) + (error "Maxima does not support sessions")) + +(provide 'ob-maxima) + +;; arch-tag: d86c97ac-7eab-4349-8d8b-302dd09779a8 + +;;; ob-maxima.el ends here diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el index 3b55f2e27b3..f96ba9a600b 100644 --- a/lisp/org/ob-mscgen.el +++ b/lisp/org/ob-mscgen.el @@ -1,11 +1,11 @@ ;;; ob-msc.el --- org-babel functions for mscgen evaluation -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Juan Pechiar ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -73,7 +73,7 @@ mscgen supported formats." (error " ERROR: no output file specified. Add \":file name.png\" to the src header")) (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) - out-file)) + nil)) ;; signal that output has already been written to file (defun org-babel-prep-session:mscgen (session params) "Raise an error because Mscgen doesn't support sessions." @@ -81,5 +81,6 @@ ERROR: no output file specified. Add \":file name.png\" to the src header")) (provide 'ob-mscgen) +;; arch-tag: 74695b1e-715f-4b5a-a3a9-d78ee39ba5c8 ;;; ob-msc.el ends here diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el index bf34b984c00..c4b40c46cb8 100644 --- a/lisp/org/ob-ocaml.el +++ b/lisp/org/ob-ocaml.el @@ -1,11 +1,11 @@ ;;; ob-ocaml.el --- org-babel functions for ocaml evaluation -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -44,6 +44,7 @@ (declare-function tuareg-run-caml "ext:tuareg" ()) (declare-function tuareg-interactive-send-input "ext:tuareg" ()) +(defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml")) (defvar org-babel-default-header-args:ocaml '()) @@ -125,32 +126,20 @@ OUTPUT is string output from an ocaml process." "Convert RESULTS into an elisp table or string. If the results look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." - (org-babel-read - (if (and (stringp results) (string-match "^\\[.+\\]$" results)) - (org-babel-read - (replace-regexp-in-string - "\\[" "(" (replace-regexp-in-string - "\\]" ")" (replace-regexp-in-string - "; " " " (replace-regexp-in-string - "'" "\"" results))))) - results))) + (org-babel-script-escape (replace-regexp-in-string ";" "," results))) (defun org-babel-ocaml-read-array (results) "Convert RESULTS into an elisp table or string. If the results look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." - (org-babel-read - (if (and (stringp results) (string-match "^\\[.+\\]$" results)) - (org-babel-read - (concat - "'" (replace-regexp-in-string - "\\[|" "(" (replace-regexp-in-string - "|\\]" ")" (replace-regexp-in-string - "; " " " (replace-regexp-in-string - "'" "\"" results)))))) - results))) + (org-babel-script-escape + (replace-regexp-in-string + "\\[|" "[" (replace-regexp-in-string + "|\\]" "]" (replace-regexp-in-string + "; " "," results))))) (provide 'ob-ocaml) +;; arch-tag: 2e815f4d-365e-4d69-b1df-dd17fdd7b7b7 ;;; ob-ocaml.el ends here diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index ae6c1513dee..ac434b4abb6 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -1,11 +1,11 @@ ;;; ob-octave.el --- org-babel functions for octave and matlab evaluation -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -88,13 +88,12 @@ end") body params (org-babel-variable-assignments:octave params))) (result (org-babel-octave-evaluate session full-body result-type matlabp))) - (or out-file - (org-babel-reassemble-table - result - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + (org-babel-reassemble-table + result + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) (defun org-babel-prep-session:matlab (session params) "Prepare SESSION according to PARAMS." @@ -104,7 +103,7 @@ end") "Return list of octave statements assigning the block's variables" (mapcar (lambda (pair) - (format "%s=%s" + (format "%s=%s;" (car pair) (org-babel-octave-var-to-octave (cdr pair)))) (mapcar #'cdr (org-babel-get-header params :var)))) @@ -259,5 +258,6 @@ This removes initial blank and comment lines and then calls (provide 'ob-octave) +;; arch-tag: d8e5f68b-ba13-440a-a495-b653e989e704 ;;; ob-octave.el ends here diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el index 99c04d8e313..74071363747 100644 --- a/lisp/org/ob-org.el +++ b/lisp/org/ob-org.el @@ -1,11 +1,11 @@ ;;; ob-org.el --- org-babel functions for org code block evaluation -;; Copyright (C) 2010-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -40,13 +40,22 @@ "#+TITLE: default empty header\n" "Default header inserted during export of org blocks.") +(defun org-babel-expand-body:org (body params) + (dolist (var (mapcar #'cdr (org-babel-get-header params :var))) + (setq body (replace-regexp-in-string + (regexp-quote (format "$%s" (car var))) (cdr var) body + nil 'literal))) + body) + (defun org-babel-execute:org (body params) "Execute a block of Org code with. This function is called by `org-babel-execute-src-block'." (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (body (replace-regexp-in-string "^," "" body))) + (body (org-babel-expand-body:org + (replace-regexp-in-string "^," "" body) params))) (cond - ((member "latex" result-params) (org-export-string body "latex")) + ((member "latex" result-params) (org-export-string + (concat "#+Title: \n" body) "latex")) ((member "html" result-params) (org-export-string body "html")) ((member "ascii" result-params) (org-export-string body "ascii")) (t body)))) @@ -57,5 +66,6 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-org) +;; arch-tag: 130af5fe-cc56-46bd-9508-fa0ebd94cb1f ;;; ob-org.el ends here diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el index 6309b900111..ec93c729e7b 100644 --- a/lisp/org/ob-perl.el +++ b/lisp/org/ob-perl.el @@ -1,11 +1,11 @@ ;;; ob-perl.el --- org-babel functions for perl evaluation -;; Copyright (C) 2009-2011 Free Software Foundation +;; Copyright (C) 2009, 2010 Free Software Foundation ;; Author: Dan Davison, Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -31,6 +31,7 @@ (require 'ob-eval) (eval-when-compile (require 'cl)) +(defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl")) (defvar org-babel-default-header-args:perl '()) @@ -112,5 +113,6 @@ return the value of the last statement in BODY, as elisp." (provide 'ob-perl) +;; arch-tag: 88ef9396-d857-4dc3-8946-5a72bdfa2337 ;;; ob-perl.el ends here diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el index f455bc9bb4c..b226a5342ff 100644 --- a/lisp/org/ob-plantuml.el +++ b/lisp/org/ob-plantuml.el @@ -1,11 +1,11 @@ ;;; ob-plantuml.el --- org-babel functions for plantuml evaluation -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Zhang Weize ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -62,6 +62,8 @@ This function is called by `org-babel-execute-src-block'." (expand-file-name org-plantuml-jar-path)) (if (string= (file-name-extension out-file) "svg") " -tsvg" "") + (if (string= (file-name-extension out-file) "eps") + " -teps" "") " -p " cmdline " < " (org-babel-process-file-name in-file) " > " @@ -70,7 +72,7 @@ This function is called by `org-babel-execute-src-block'." (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) (message "%s" cmd) (org-babel-eval cmd "") - out-file)) + nil)) ;; signal that output has already been written to file (defun org-babel-prep-session:plantuml (session params) "Return an error because plantuml does not support sessions." @@ -78,5 +80,6 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-plantuml) +;; arch-tag: 451f50c5-e779-407e-ad64-70e0e8f161d1 ;;; ob-plantuml.el ends here diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index b53513a212c..0fe0b4fefd8 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -1,11 +1,11 @@ ;;; ob-python.el --- org-babel functions for python evaluation -;; Copyright (C) 2009-2011 Free Software Foundation +;; Copyright (C) 2009, 2010 Free Software Foundation ;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -35,8 +35,10 @@ (declare-function org-remove-indentation "org" ) (declare-function py-shell "ext:python-mode" (&optional argprompt)) +(declare-function py-toggle-shells "ext:python-mode" (arg)) (declare-function run-python "ext:python" (&optional cmd noshow new)) +(defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) (defvar org-babel-default-header-args:python '()) @@ -45,7 +47,8 @@ "Name of command for executing python code.") (defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python) - "Preferred python mode for use in running python interactively.") + "Preferred python mode for use in running python interactively. +This will typically be either 'python or 'python-mode.") (defvar org-src-preserve-indentation) @@ -65,13 +68,12 @@ This function is called by `org-babel-execute-src-block'." params (org-babel-variable-assignments:python params))) (result (org-babel-python-evaluate session full-body result-type result-params preamble))) - (or (cdr (assoc :file params)) - (org-babel-reassemble-table - result - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params))))))) + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params)))))) (defun org-babel-prep-session:python (session params) "Prepare SESSION according to the header arguments in PARAMS. @@ -129,6 +131,7 @@ Emacs-lisp table, otherwise return the results as a string." "Return the buffer associated with SESSION." (cdr (assoc session org-babel-python-buffers))) +(defvar py-default-interpreter) (defun org-babel-python-initiate-session-by-key (&optional session) "Initiate a python session. If there is not a current inferior-process-buffer in SESSION @@ -143,9 +146,13 @@ then create. Return the initialized session." (run-python)) ((and (eq 'python-mode org-babel-python-mode) (fboundp 'py-shell)) ; python-mode.el + ;; Make sure that py-which-bufname is initialized, as otherwise + ;; it will be overwritten the first time a Python buffer is + ;; created. + (py-toggle-shells py-default-interpreter) ;; `py-shell' creates a buffer whose name is the value of ;; `py-which-bufname' with '*'s at the beginning and end - (let* ((bufname (if python-buffer + (let* ((bufname (if (and python-buffer (buffer-live-p python-buffer)) (replace-regexp-in-string ;; zap surrounding * "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) (concat "Python-" (symbol-name session)))) @@ -196,29 +203,33 @@ open('%s', 'w').write( pprint.pformat(main()) )") If RESULT-TYPE equals 'output then return standard output as a string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (case result-type - (output (org-babel-eval org-babel-python-command - (concat (if preamble (concat preamble "\n") "") body))) - (value (let ((tmp-file (org-babel-temp-file "python-"))) - (org-babel-eval org-babel-python-command - (concat - (if preamble (concat preamble "\n") "") - (format - (if (member "pp" result-params) - org-babel-python-pp-wrapper-method - org-babel-python-wrapper-method) - (mapconcat - (lambda (line) (format "\t%s" line)) - (split-string - (org-remove-indentation - (org-babel-trim body)) - "[\r\n]") "\n") - (org-babel-process-file-name tmp-file 'noquote)))) - ((lambda (raw) - (if (or (member "code" result-params) - (member "pp" result-params)) - raw - (org-babel-python-table-or-string raw))) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params) + (and (member "output" result-params) + (not (member "table" result-params)))) + raw + (org-babel-python-table-or-string (org-babel-trim raw)))) + (case result-type + (output (org-babel-eval org-babel-python-command + (concat (if preamble (concat preamble "\n") "") + body))) + (value (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-eval + org-babel-python-command + (concat + (if preamble (concat preamble "\n") "") + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-babel-trim body)) + "[\r\n]") "\n") + (org-babel-process-file-name tmp-file 'noquote)))) (org-babel-eval-read-file tmp-file)))))) (defun org-babel-python-evaluate-session @@ -227,10 +238,11 @@ last statement in BODY, as elisp." If RESULT-TYPE equals 'output then return standard output as a string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - (flet ((dump-last-value + (flet ((send-wait () (comint-send-input nil t) (sleep-for 0 5)) + (dump-last-value (tmp-file pp) (mapc - (lambda (statement) (insert statement) (comint-send-input)) + (lambda (statement) (insert statement) (send-wait)) (if pp (list "import pprint" @@ -239,34 +251,39 @@ last statement in BODY, as elisp." (list (format "open('%s', 'w').write(str(_))" (org-babel-process-file-name tmp-file 'noquote)))))) (input-body (body) - (mapc (lambda (statement) (insert statement) (comint-send-input)) - (split-string (org-babel-trim body) "[\r\n]+")) - (comint-send-input) (comint-send-input))) - (case result-type - (output - (mapconcat - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (session org-babel-python-eoe-indicator t body) - (let ((comint-process-echoes nil)) - (input-body body) - (insert org-babel-python-eoe-indicator) - (comint-send-input))) 2) "\n")) - (value - ((lambda (results) - (if (or (member "code" result-params) (member "pp" result-params)) - results - (org-babel-python-table-or-string results))) - (let ((tmp-file (org-babel-temp-file "python-"))) + (mapc (lambda (line) (insert line) (send-wait)) + (split-string body "[\r\n]")) + (send-wait))) + ((lambda (results) + (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results) + (if (or (member "code" result-params) + (member "pp" result-params) + (and (member "output" result-params) + (not (member "table" result-params)))) + results + (org-babel-python-table-or-string results)))) + (case result-type + (output + (mapconcat + #'org-babel-trim + (butlast (org-babel-comint-with-output (session org-babel-python-eoe-indicator t body) + (input-body body) + (send-wait) (send-wait) + (insert org-babel-python-eoe-indicator) + (send-wait)) + 2) "\n")) + (value + (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator nil body) (let ((comint-process-echoes nil)) (input-body body) (dump-last-value tmp-file (member "pp" result-params)) - (comint-send-input) (comint-send-input) + (send-wait) (send-wait) (insert org-babel-python-eoe-indicator) - (comint-send-input))) + (send-wait))) (org-babel-eval-read-file tmp-file))))))) (defun org-babel-python-read-string (string) @@ -277,5 +294,6 @@ last statement in BODY, as elisp." (provide 'ob-python) +;; arch-tag: f19b6c3d-dfcb-4a1a-9ce0-45ade1ebc212 ;;; ob-python.el ends here diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 96819df8ea1..d6ad39ed073 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -1,11 +1,11 @@ ;;; ob-ref.el --- org-babel functions for referencing external data -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -51,13 +51,17 @@ ;;; 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" ()) +(declare-function org-at-item-p "org-list" ()) +(declare-function org-narrow-to-subtree "org" ()) +(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) +(declare-function org-show-context "org" (&optional key)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) (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]*") @@ -77,18 +81,46 @@ the variable." (cons (intern var) (let ((out (org-babel-read ref))) (if (equal out ref) - (if (string-match "^\".+\"$" ref) + (if (string-match "^\".*\"$" ref) (read ref) (org-babel-ref-resolve ref)) out)))))) +(defun org-babel-ref-goto-headline-id (id) + (goto-char (point-min)) + (let ((rx (regexp-quote id))) + (or (re-search-forward + (concat "^[ \t]*:CUSTOM_ID:[ \t]+" rx "[ \t]*$") nil t) + (let* ((file (org-id-find-id-file id)) + (m (when file (org-id-find-id-in-file id file 'marker)))) + (when (and file m) + (message "file:%S" file) + (org-pop-to-buffer-same-window (marker-buffer m)) + (goto-char m) + (move-marker m nil) + (org-show-context) + t))))) + +(defun org-babel-ref-headline-body () + (save-restriction + (org-narrow-to-subtree) + (buffer-substring + (save-excursion (goto-char (point-min)) + (forward-line 1) + (when (looking-at "[ \t]*:PROPERTIES:") + (re-search-forward ":END:" nil) + (forward-char)) + (point)) + (point-max)))) + (defvar org-babel-library-of-babel) (defun org-babel-ref-resolve (ref) "Resolve the reference REF and return its value." + (save-window-excursion (save-excursion (let ((case-fold-search t) type args new-refere new-header-args new-referent result - lob-info split-file split-ref index index-row index-col) + lob-info split-file split-ref index index-row index-col id) ;; if ref is indexed grab the indices -- beware nested indices (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) (let ((str (substring ref 0 (match-beginning 0)))) @@ -106,8 +138,8 @@ the variable." (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 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)) @@ -116,48 +148,52 @@ the variable." (save-restriction (widen) (goto-char (point-min)) - (if (let ((result_regexp (concat "^[ \t]*#\\+\\(TBLNAME\\|RESNAME" - "\\|RESULTS\\):[ \t]*" - (regexp-quote ref) "[ \t]*$")) - (regexp (concat org-babel-src-name-regexp - (regexp-quote ref) "\\(\(.*\)\\)?" "[ \t]*$"))) + (if (let* ((rx (regexp-quote ref)) + (res-rx (concat org-babel-result-regexp rx "[ \t]*$")) + (src-rx (concat org-babel-src-name-regexp + rx "\\(\(.*\)\\)?" "[ \t]*$"))) ;; goto ref in the current buffer (or (and (not args) - (or (re-search-forward result_regexp nil t) - (re-search-backward result_regexp nil t))) - (re-search-forward regexp nil t) - (re-search-backward regexp nil t) + (or (re-search-forward res-rx nil t) + (re-search-backward res-rx nil t))) + (re-search-forward src-rx nil t) + (re-search-backward src-rx nil t) + ;; check for local or global headlines by id + (setq id (org-babel-ref-goto-headline-id ref)) ;; check the Library of Babel (setq lob-info (cdr (assoc (intern ref) org-babel-library-of-babel))))) - (unless lob-info (goto-char (match-beginning 0))) + (unless (or lob-info id) (goto-char (match-beginning 0))) ;; ;; TODO: allow searching for names in other buffers ;; (setq id-loc (org-id-find ref 'marker) ;; buffer (marker-buffer id-loc) ;; loc (marker-position id-loc)) ;; (move-marker id-loc nil) (error "reference '%s' not found in this buffer" ref)) - (if lob-info - (setq type 'lob) - (while (not (setq type (org-babel-ref-at-ref-p))) - (forward-line 1) - (beginning-of-line) - (if (or (= (point) (point-min)) (= (point) (point-max))) - (error "reference not found")))) + (cond + (lob-info (setq type 'lob)) + (id (setq type 'id)) + (t (while (not (setq type (org-babel-ref-at-ref-p))) + (forward-line 1) + (beginning-of-line) + (if (or (= (point) (point-min)) (= (point) (point-max))) + (error "reference not found"))))) (let ((params (append args '((:results . "silent"))))) (setq result (case type (results-line (org-babel-read-result)) - (table (org-babel-read-table)) - (list (org-babel-read-list)) - (file (org-babel-read-link)) + (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))))) + (lob (org-babel-execute-src-block + nil lob-info params)) + (id (org-babel-ref-headline-body))))) (if (symbolp result) (format "%S" result) (if (and index (listp result)) (org-babel-ref-index-list index result) - result)))))) + result))))))) (defun org-babel-ref-index-list (index lis) "Return the subset of LIS indexed by INDEX. @@ -181,7 +217,10 @@ to \"0:-1\"." (open (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls))) (open (mapcar - (lambda (sub-lis) (org-babel-ref-index-list remainder sub-lis)) + (lambda (sub-lis) + (if (listp sub-lis) + (org-babel-ref-index-list remainder sub-lis) + sub-lis)) (if (or (= 0 (length portion)) (string-match ind-re portion)) (mapcar (lambda (n) (nth n lis)) @@ -205,7 +244,7 @@ to \"0:-1\"." (cond ((string= holder ",") (when (= depth 0) - (setq return (reverse (cons (substring buffer 0 -1) return))) + (setq return (cons (substring buffer 0 -1) return)) (setq buffer ""))) ((or (string= holder "(") (string= holder "[")) (setq depth (+ depth 1))) ((or (string= holder ")") (string= holder "]")) (setq depth (- depth 1))))) @@ -217,12 +256,13 @@ 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) + ((org-at-item-p) 'list) ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block) ((looking-at org-bracket-link-regexp) 'file) ((looking-at org-babel-result-regexp) 'results-line))) (provide 'ob-ref) +;; arch-tag: ace4a4f4-ea38-4dac-8fe6-6f52fcc43b6d ;;; ob-ref.el ends here diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index ae98137735c..f0ed1a16676 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-2011 Free Software Foundation +;; Copyright (C) 2009, 2010 Free Software Foundation ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -44,7 +44,9 @@ (eval-when-compile (require 'cl)) (declare-function run-ruby "ext:inf-ruby" (&optional command name)) +(declare-function xmp "ext:rcodetools" (&optional option)) +(defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb")) (defvar org-babel-default-header-args:ruby '()) @@ -61,15 +63,20 @@ This function is called by `org-babel-execute-src-block'." (result-type (cdr (assoc :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:ruby params))) - (result (org-babel-ruby-evaluate - session full-body result-type result-params))) - (or (cdr (assoc :file params)) - (org-babel-reassemble-table - result - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params))))))) + (result (if (member "xmp" result-params) + (with-temp-buffer + (require 'rcodetools) + (insert full-body) + (xmp (cdr (assoc :xmp-option params))) + (buffer-string)) + (org-babel-ruby-evaluate + session full-body result-type result-params)))) + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params)))))) (defun org-babel-prep-session:ruby (session params) "Prepare SESSION according to the header arguments specified in PARAMS." @@ -234,5 +241,6 @@ return the value of the last statement in BODY, as elisp." (provide 'ob-ruby) +;; arch-tag: 3e9726db-4520-49e2-b263-e8f571ac88f5 ;;; ob-ruby.el ends here diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el index 3348dd4d1d6..c51a4433426 100644 --- a/lisp/org/ob-sass.el +++ b/lisp/org/ob-sass.el @@ -1,11 +1,11 @@ ;;; ob-sass.el --- org-babel functions for the sass css generation language -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -40,6 +40,7 @@ ;;; Code: (require 'ob) +(require 'ob-eval) (defvar org-babel-default-header-args:sass '()) @@ -55,8 +56,11 @@ This function is called by `org-babel-execute-src-block'." " " (org-babel-process-file-name in-file) " " (org-babel-process-file-name out-file)))) (with-temp-file in-file - (insert (org-babel-expand-body:generic body params))) (shell-command cmd) - (or file (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) + (insert (org-babel-expand-body:generic body params))) + (org-babel-eval cmd "") + (if file + nil ;; signal that output has already been written to file + (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) (defun org-babel-prep-session:sass (session params) "Raise an error because sass does not support sessions." @@ -64,5 +68,6 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-sass) +;; arch-tag: 2954b169-eef4-45ce-a8e5-3e619f0f07ac ;;; ob-sass.el ends here diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el index 5dda693b9a7..a772151aee4 100644 --- a/lisp/org/ob-scheme.el +++ b/lisp/org/ob-scheme.el @@ -1,11 +1,11 @@ ;;; ob-scheme.el --- org-babel functions for Scheme -;; Copyright (C) 2010-2011 Free Software Foundation +;; Copyright (C) 2010 Free Software Foundation ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, scheme ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;;; License: @@ -134,5 +134,6 @@ then create. Return the initialized session." (provide 'ob-scheme) +;; arch-tag: 6b2fe76f-4b25-4e87-ad1c-225b2f282a71 ;;; ob-scheme.el ends here diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index 59e23c4caad..a9a3c5c794a 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-2011 Free Software Foundation +;; Copyright (C) 2009, 2010 Free Software Foundation ;; Author: Benjamin Andresen ;; Keywords: literate programming, interactive shell ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -142,5 +142,6 @@ The terminal should shortly flicker." (provide 'ob-screen) +;; arch-tag: 908e5afe-89a0-4f27-b982-23f1f2e3bac9 ;;; ob-screen.el ends here diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el index 6ca52b1f361..9349a842a60 100644 --- a/lisp/org/ob-sh.el +++ b/lisp/org/ob-sh.el @@ -1,11 +1,11 @@ ;;; ob-sh.el --- org-babel functions for shell evaluation -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -28,6 +28,7 @@ ;;; Code: (require 'ob) +(require 'ob-ref) (require 'ob-comint) (require 'ob-eval) (require 'shell) @@ -45,16 +46,25 @@ "Command used to invoke a shell. This will be passed to `shell-command-on-region'") +(defcustom org-babel-sh-var-quote-fmt + "$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)" + "Format string used to escape variables when passed to shell scripts." + :group 'org-babel + :type 'string) + (defun org-babel-execute:sh (body params) "Execute a block of Shell commands with Babel. This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-sh-initiate-session (cdr (assoc :session params)))) - (result-params (cdr (assoc :result-params params))) + (result-params (cdr (assoc :result-params params))) + (stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string + (org-babel-ref-resolve stdin)))) + (cdr (assoc :stdin params)))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:sh params)))) (org-babel-reassemble-table - (org-babel-sh-evaluate session full-body result-params) + (org-babel-sh-evaluate session full-body result-params stdin) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name @@ -95,20 +105,17 @@ This function is called by `org-babel-execute-src-block'." "Convert an elisp value to a shell variable. Convert an elisp var into a string of shell commands specifying a var of the same value." - (if (listp var) - (flet ((deep-string (el) - (if (listp el) - (mapcar #'deep-string el) - (org-babel-sh-var-to-sh el sep)))) - (format "$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)" - (orgtbl-to-generic - (deep-string (if (listp (car var)) var (list var))) - (list :sep (or sep "\t"))))) - (if (stringp var) - (if (string-match "[\n\r]" var) - (format "$(cat <<BABEL_STRING\n%s\nBABEL_STRING\n)" var) - (format "%s" var)) - (format "%S" var)))) + (format org-babel-sh-var-quote-fmt (org-babel-sh-var-to-string var sep))) + +(defun org-babel-sh-var-to-string (var &optional sep) + "Convert an elisp value to a string." + (flet ((echo-var (v) (if (stringp v) v (format "%S" v)))) + (cond + ((and (listp var) (listp (car var))) + (orgtbl-to-generic var (list :sep (or sep "\t") :fmt #'echo-var))) + ((listp var) + (mapconcat #'echo-var var "\n")) + (t (echo-var var))))) (defun org-babel-sh-table-or-results (results) "Convert RESULTS to an appropriate elisp value. @@ -128,7 +135,7 @@ Emacs-lisp table, otherwise return the results as a string." (defvar org-babel-sh-eoe-output "org_babel_sh_eoe" "String to indicate that evaluation has completed.") -(defun org-babel-sh-evaluate (session body &optional result-params) +(defun org-babel-sh-evaluate (session body &optional result-params stdin) "Pass BODY to the Shell process in BUFFER. If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then @@ -136,13 +143,25 @@ return the value of the last statement in BODY." ((lambda (results) (when results (if (or (member "scalar" result-params) + (member "verbatim" result-params) (member "output" result-params)) results (let ((tmp-file (org-babel-temp-file "sh-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file))))) - (if (not session) - (org-babel-eval org-babel-sh-command (org-babel-trim body)) + (cond + (stdin ; external shell script w/STDIN + (let ((script-file (org-babel-temp-file "sh-script-")) + (stdin-file (org-babel-temp-file "sh-stdin-"))) + (with-temp-file script-file (insert body)) + (with-temp-file stdin-file (insert stdin)) + (with-temp-buffer + (call-process-shell-command + (format "%s %s" org-babel-sh-command script-file) + stdin-file + (current-buffer)) + (buffer-string)))) + (session ; session evaluation (mapconcat #'org-babel-sh-strip-weird-long-prompt (mapcar @@ -152,11 +171,19 @@ return the value of the last statement in BODY." (session org-babel-sh-eoe-output t body) (mapc (lambda (line) - (insert line) (comint-send-input nil t) (sleep-for 0.25)) + (insert line) + (comint-send-input nil t) + (while (save-excursion + (goto-char comint-last-input-end) + (not (re-search-forward + comint-prompt-regexp nil t))) + (accept-process-output (get-buffer-process (current-buffer))))) (append (split-string (org-babel-trim body) "\n") (list org-babel-sh-eoe-indicator)))) - 2)) "\n")))) + 2)) "\n")) + ('otherwise ; external shell script + (org-babel-eval org-babel-sh-command (org-babel-trim body)))))) (defun org-babel-sh-strip-weird-long-prompt (string) "Remove prompt cruft from a string of shell output." @@ -166,5 +193,6 @@ return the value of the last statement in BODY." (provide 'ob-sh) +;; arch-tag: 416dd531-c230-4b0a-a5bf-8d948f990f2d ;;; ob-sh.el ends here diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 49859d24a17..8fc7d3b4f84 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -1,11 +1,11 @@ ;;; ob-sql.el --- org-babel functions for sql evaluation -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -65,28 +65,47 @@ This function is called by `org-babel-execute-src-block'." (in-file (org-babel-temp-file "sql-in-")) (out-file (or (cdr (assoc :out-file params)) (org-babel-temp-file "sql-out-"))) + (header-delim "") (command (case (intern engine) - (msosql (format "osql %s -s \"\t\" -i %s -o %s" + ('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 < %s > %s" (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - (mysql (format "mysql %s -e \"source %s\" > %s" - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - (postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + ('postgresql (format + "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) (t (error "no support for the %s sql engine" engine))))) (with-temp-file in-file (insert (org-babel-expand-body:sql body params))) (message command) (shell-command command) (with-temp-buffer + ;; need to figure out what the delimiter is for the header row + (with-temp-buffer + (insert-file-contents out-file) + (goto-char (point-min)) + (when (re-search-forward "^\\(-+\\)[^-]" nil t) + (setq header-delim (match-string-no-properties 1))) + (goto-char (point-max)) + (forward-char -1) + (while (looking-at "\n") + (delete-char 1) + (goto-char (point-max)) + (forward-char -1)) + (write-file out-file)) (org-table-import out-file '(16)) (org-babel-reassemble-table - (org-table-to-lisp) + (mapcar (lambda (x) + (if (string= (car x) header-delim) + 'hline + x)) + (org-table-to-lisp)) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name (cdr (assoc :rowname-names params)) @@ -121,5 +140,6 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-sql) +;; arch-tag: a43ff944-6de1-4566-a83c-626814e3dad2 ;;; ob-sql.el ends here diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el index 408ca4e64c4..3162fcca81f 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-2011 Free Software Foundation +;; Copyright (C) 2010 Free Software Foundation ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -89,6 +89,7 @@ This function is called by `org-babel-execute-src-block'." ;; body of the code block (org-babel-expand-body:sqlite body params))) (if (or (member "scalar" result-params) + (member "verbatim" result-params) (member "html" result-params) (member "code" result-params) (equal (point-min) (point-max))) @@ -144,5 +145,6 @@ Prepare SESSION according to the header arguments specified in PARAMS." (provide 'ob-sqlite) +;; arch-tag: 5c03d7f2-0f72-48b8-bbd1-35aafea248ac ;;; ob-sqlite.el ends here diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el index e44bb86ca04..91e238f254b 100644 --- a/lisp/org/ob-table.el +++ b/lisp/org/ob-table.el @@ -1,11 +1,11 @@ ;;; ob-table.el --- support for calling org-babel functions from tables -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -97,7 +97,8 @@ example above." variables))) (unless (stringp source-block) (setq source-block (symbol-name source-block))) - (org-babel-table-truncate-at-newline ;; org-table cells can't be multi-line + ((lambda (result) + (org-babel-trim (if (stringp result) result (format "%S" result)))) (if (and source-block (> (length source-block) 0)) (let ((params (eval `(org-babel-parse-header-arguments @@ -120,5 +121,6 @@ example above." (provide 'ob-table) +;; arch-tag: 4234cc7c-4fc8-4e92-abb0-2892de1a493b ;;; ob-table.el ends here diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index 67f12eabc01..d4fb60618be 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -1,11 +1,11 @@ ;;; ob-tangle.el --- extract source code from org-mode files -;; Copyright (C) 2009-2011 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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -37,6 +37,7 @@ (declare-function org-back-to-heading "org" (invisible-ok)) (declare-function org-fill-template "org" (template alist)) (declare-function org-babel-update-block-body "org" (new-body)) +(declare-function make-directory "files" (dir &optional parents)) ;;;###autoload (defcustom org-babel-tangle-lang-exts @@ -62,10 +63,10 @@ then the name of the language is used." :group 'org-babel :type 'hook) -(defcustom org-babel-tangle-pad-newline t - "Switch indicating whether to pad tangled code with newlines." +(defcustom org-babel-tangle-body-hook nil + "Hook run over the contents of each code block body." :group 'org-babel - :type 'boolean) + :type 'hook) (defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]" "Format of inserted comments in tangled code files. @@ -153,7 +154,7 @@ used to limit the exported source code blocks by language." (save-window-excursion (find-file file) (setq to-be-removed (current-buffer)) - (org-babel-tangle target-file lang)) + (org-babel-tangle nil target-file lang)) (unless visited-p (kill-buffer to-be-removed)))) @@ -162,15 +163,24 @@ used to limit the exported source code blocks by language." (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) ;;;###autoload -(defun org-babel-tangle (&optional target-file lang) +(defun org-babel-tangle (&optional only-this-block target-file lang) "Write code blocks to source-specific files. Extract the bodies of all source code blocks from the current file into their own source-specific files. Optional argument TARGET-FILE can be used to specify a default export file for all source blocks. Optional argument LANG can be used to limit the exported source code blocks by language." - (interactive) + (interactive "P") (run-hooks 'org-babel-pre-tangle-hook) + ;; possibly restrict the buffer to the current code block + (save-restriction + (when only-this-block + (unless (org-babel-where-is-src-block-head) + (error "Point is not currently inside of a code block")) + (unless target-file + (setq target-file + (read-from-minibuffer "Tangle to: " (buffer-file-name)))) + (narrow-to-region (match-beginning 0) (match-end 0))) (save-excursion (let ((block-counter 0) (org-babel-default-header-args @@ -210,13 +220,17 @@ exported source code blocks by language." (if (and ext (string= "yes" tangle)) (concat base-name "." ext) base-name)))) (when file-name + ;; possibly create the parent directories for file + (when ((lambda (m) (and m (not (string= m "no")))) + (get-spec :mkdirp)) + (make-directory (file-name-directory file-name) 'parents)) ;; delete any old versions of file (when (and (file-exists-p file-name) (not (member file-name path-collector))) (delete-file file-name)) ;; drop source-block to file (with-temp-buffer - (when (fboundp lang-f) (funcall lang-f)) + (when (fboundp lang-f) (ignore-errors (funcall lang-f))) (when (and she-bang (not (member file-name she-banged))) (insert (concat she-bang "\n")) (setq she-banged (cons file-name she-banged))) @@ -238,7 +252,8 @@ exported source code blocks by language." (org-babel-tangle-collect-blocks lang)) (message "tangled %d code block%s from %s" block-counter (if (= block-counter 1) "" "s") - (file-name-nondirectory (buffer-file-name (current-buffer)))) + (file-name-nondirectory + (buffer-file-name (or (buffer-base-buffer) (current-buffer))))) ;; run `org-babel-post-tangle-hook' in all tangled files (when org-babel-post-tangle-hook (mapc @@ -246,7 +261,7 @@ exported source code blocks by language." (org-babel-with-temp-filebuffer file (run-hooks 'org-babel-post-tangle-hook))) path-collector)) - path-collector))) + path-collector)))) (defun org-babel-tangle-clean () "Remove comments inserted by `org-babel-tangle'. @@ -263,6 +278,7 @@ references." (save-excursion (end-of-line 1) (forward-char 1) (point))))) (defvar org-stored-links) +(defvar org-bracket-link-regexp) (defun org-babel-tangle-collect-blocks (&optional language) "Collect source blocks in the current Org-mode file. Return an association list of source-code block specifications of @@ -290,9 +306,11 @@ code blocks by language." (unless (and language (not (string= language src-lang))) (let* ((info (org-babel-get-src-block-info)) (params (nth 2 info)) - (link (progn (call-interactively 'org-store-link) - (org-babel-clean-text-properties - (car (pop org-stored-links))))) + (link ((lambda (link) + (and (string-match org-bracket-link-regexp link) + (match-string 1 link))) + (org-babel-clean-text-properties + (org-store-link nil)))) (source-name (intern (or (nth 4 info) (format "%s:%d" @@ -302,22 +320,27 @@ code blocks by language." (assignments-cmd (intern (concat "org-babel-variable-assignments:" src-lang))) (body - ((lambda (body) - (if (assoc :no-expand params) - body - (if (fboundp expand-cmd) - (funcall expand-cmd body params) - (org-babel-expand-body:generic - body params - (and (fboundp assignments-cmd) - (funcall assignments-cmd params)))))) - (if (and (cdr (assoc :noweb params)) - (let ((nowebs (split-string - (cdr (assoc :noweb params))))) - (or (member "yes" nowebs) - (member "tangle" nowebs)))) - (org-babel-expand-noweb-references info) - (nth 1 info)))) + ((lambda (body) ;; run the tangle-body-hook + (with-temp-buffer + (insert body) + (run-hooks 'org-babel-tangle-body-hook) + (buffer-string))) + ((lambda (body) ;; expand the body in language specific manner + (if (assoc :no-expand params) + body + (if (fboundp expand-cmd) + (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params + (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) + (if (and (cdr (assoc :noweb params)) ;; expand noweb refs + (let ((nowebs (split-string + (cdr (assoc :noweb params))))) + (or (member "yes" nowebs) + (member "tangle" nowebs)))) + (org-babel-expand-noweb-references info) + (nth 1 info))))) (comment (when (or (string= "both" (cdr (assoc :comments params))) (string= "org" (cdr (assoc :comments params)))) @@ -363,8 +386,9 @@ form (body (nth 5 spec)) (comment (nth 6 spec)) (comments (cdr (assoc :comments (nth 4 spec)))) + (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec)))))) (link-p (or (string= comments "both") (string= comments "link") - (string= comments "yes"))) + (string= comments "yes") (string= comments "noweb"))) (link-data (mapcar (lambda (el) (cons (symbol-name el) ((lambda (le) @@ -375,14 +399,14 @@ form (let ((text (org-babel-trim text))) (when (and comments (not (string= comments "no")) (> (length text) 0)) - (when org-babel-tangle-pad-newline (insert "\n")) + (when padline (insert "\n")) (comment-region (point) (progn (insert text) (point))) (end-of-line nil) (insert "\n"))))) (when comment (insert-comment comment)) (when link-p (insert-comment (org-fill-template org-babel-tangle-comment-format-beg link-data))) - (when org-babel-tangle-pad-newline (insert "\n")) + (when padline (insert "\n")) (insert (format "%s\n" @@ -393,7 +417,24 @@ form (insert-comment (org-fill-template org-babel-tangle-comment-format-end link-data)))))) -;; detangling functions +(defun org-babel-tangle-comment-links ( &optional info) + "Return a list of begin and end link comments for the code block at point." + (let* ((start-line (org-babel-where-is-src-block-head)) + (file (buffer-file-name)) + (link (org-link-escape (progn (call-interactively 'org-store-link) + (org-babel-clean-text-properties + (car (pop org-stored-links)))))) + (source-name (nth 4 (or info (org-babel-get-src-block-info 'light)))) + (link-data (mapcar (lambda (el) + (cons (symbol-name el) + ((lambda (le) + (if (stringp le) le (format "%S" le))) + (eval el)))) + '(start-line file link source-name)))) + (list (org-fill-template org-babel-tangle-comment-format-beg link-data) + (org-fill-template org-babel-tangle-comment-format-end link-data)))) + +;; de-tangling functions (defvar org-bracket-link-analytic-regexp) (defun org-babel-detangle (&optional source-code-file) "Propagate changes in source file back original to Org-mode file. @@ -420,20 +461,24 @@ which enable the original code blocks to be found." "Jump from a tangled code file to the related Org-mode file." (interactive) (let ((mid (point)) - target-buffer target-char - start end link path block-name body) + start end done + target-buffer target-char link path block-name body) (save-window-excursion (save-excursion - (unless (and (re-search-backward org-bracket-link-analytic-regexp nil t) - (setq start (point-at-eol)) - (setq link (match-string 0)) - (setq path (match-string 3)) - (setq block-name (match-string 5)) - (re-search-forward - (concat " " (regexp-quote block-name) " ends here") nil t) - (setq end (point-at-bol)) - (< start mid) (< mid end)) - (error "not in tangled code")) + (while (and (re-search-backward org-bracket-link-analytic-regexp nil t) + (not ; ever wider searches until matching block comments + (and (setq start (point-at-eol)) + (setq link (match-string 0)) + (setq path (match-string 3)) + (setq block-name (match-string 5)) + (save-excursion + (save-match-data + (re-search-forward + (concat " " (regexp-quote block-name) + " ends here") nil t) + (setq end (point-at-bol)))))))) + (unless (and start (< start mid) (< mid end)) + (error "not in tangled code")) (setq body (org-babel-trim (buffer-substring start end)))) (when (string-match "::" path) (setq path (substring path 0 (match-beginning 0)))) @@ -449,5 +494,6 @@ which enable the original code blocks to be found." (provide 'ob-tangle) +;; arch-tag: 413ced93-48f5-4216-86e4-3fc5df8c8f24 ;;; ob-tangle.el ends here diff --git a/lisp/org/ob.el b/lisp/org/ob.el index 33f960f145e..0de0aa661c5 100644 --- a/lisp/org/ob.el +++ b/lisp/org/ob.el @@ -1,11 +1,11 @@ ;;; ob.el --- working with code blocks in org-mode -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -22,20 +22,15 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -;;; Commentary: - -;; See the online documentation for more information -;; -;; http://orgmode.org/worg/org-contrib/babel/ - ;;; Code: (eval-when-compile - (require 'org-list) (require 'cl)) (require 'ob-eval) (require 'org-macs) (defvar org-babel-call-process-region-original) +(defvar org-src-lang-modes) +(defvar org-babel-library-of-babel) (declare-function show-all "outline" ()) (declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag)) @@ -68,16 +63,21 @@ (declare-function org-table-end "org-table" (&optional table-type)) (declare-function orgtbl-to-generic "org-table" (table params)) (declare-function orgtbl-to-orgtbl "org-table" (table params)) +(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) (declare-function org-babel-lob-get-info "ob-lob" nil) (declare-function org-babel-ref-split-args "ob-ref" (arg-string)) (declare-function org-babel-ref-parse "ob-ref" (assignment)) (declare-function org-babel-ref-resolve "ob-ref" (ref)) +(declare-function org-babel-ref-goto-headline-id "ob-ref" (id)) +(declare-function org-babel-ref-headline-body "ob-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-at-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" ()) +(declare-function org-list-struct "org-list" ()) +(declare-function org-list-prevs-alist "org-list" (struct)) +(declare-function org-list-get-list-end "org-list" (item struct prevs)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -130,20 +130,20 @@ remove code block execution from the C-c C-c keybinding." (defvar org-babel-src-block-regexp (concat - ;; (1) indentation (2) lang + ;; (1) indentation (2) lang "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*" ;; (3) switches "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)" ;; (4) header arguments "\\([^\n]*\\)\n" ;; (5) body - "\\([^\000]+?\n\\)[ \t]*#\\+end_src") + "\\([^\000]*?\\)[ \t]*#\\+end_src") "Regexp used to identify code blocks.") (defvar org-babel-inline-src-block-regexp (concat ;; (1) replacement target (2) lang - "[ \f\t\n\r\v]\\(src_\\([^ \f\t\n\r\v]+\\)" + "[^-[:alnum:]]\\(src_\\([^ \f\t\n\r\v]+\\)" ;; (3,4) (unused, headers) "\\(\\|\\[\\(.*?\\)\\]\\)" ;; (5) body @@ -180,8 +180,8 @@ Returns a list (looking-at org-babel-multi-line-header-regexp)) (setf (nth 2 info) (org-babel-merge-params - (org-babel-parse-header-arguments (match-string 1)) - (nth 2 info)))) + (nth 2 info) + (org-babel-parse-header-arguments (match-string 1))))) (when (looking-at org-babel-src-name-w-name-regexp) (setq name (org-babel-clean-text-properties (match-string 4))) (when (match-string 6) @@ -210,11 +210,11 @@ Note disabling confirmation may result in accidental evaluation of potentially harmful code." (let* ((eval (or (cdr (assoc :eval (nth 2 info))) (when (assoc :noeval (nth 2 info)) "no"))) - (query (or (equal eval "query") - (if (functionp org-confirm-babel-evaluate) - (funcall org-confirm-babel-evaluate - (nth 0 info) (nth 1 info)) - org-confirm-babel-evaluate)))) + (query (cond ((equal eval "query") t) + ((functionp org-confirm-babel-evaluate) + (funcall org-confirm-babel-evaluate + (nth 0 info) (nth 1 info))) + (t org-confirm-babel-evaluate)))) (if (or (equal eval "never") (equal eval "no") (and query (not (yes-or-no-p @@ -251,6 +251,34 @@ then run `org-babel-execute-src-block'." (org-babel-execute-src-block current-prefix-arg info) t) nil))) ;;;###autoload +(defun org-babel-view-src-block-info () + "Display information on the current source block. +This includes header arguments, language and name, and is largely +a window into the `org-babel-get-src-block-info' function." + (interactive) + (let ((info (org-babel-get-src-block-info 'light))) + (flet ((full (it) (> (length it) 0)) + (printf (fmt &rest args) (princ (apply #'format fmt args)))) + (when info + (with-help-window (help-buffer) + (let ((name (nth 4 info)) + (lang (nth 0 info)) + (switches (nth 3 info)) + (header-args (nth 2 info))) + (when name (printf "Name: %s\n" name)) + (when lang (printf "Lang: %s\n" lang)) + (when (full switches) (printf "Switches: %s\n" switches)) + (printf "Header Arguments:\n") + (dolist (pair (sort header-args + (lambda (a b) (string< (symbol-name (car a)) + (symbol-name (car b)))))) + (when (full (cdr pair)) + (printf "\t%S%s\t%s\n" + (car pair) + (if (> (length (format "%S" (car pair))) 7) "" "\t") + (cdr pair)))))))))) + +;;;###autoload (defun org-babel-expand-src-block-maybe () "Conditionally expand a source block. Detect if this is context for a org-babel src-block and if so @@ -287,26 +315,28 @@ then run `org-babel-pop-to-session'." (defconst org-babel-header-arg-names '(cache cmdline colnames dir exports file noweb results - session tangle var eval noeval comments) + session tangle var eval noeval comments no-expand shebang + padline noweb-ref) "Common header arguments used by org-babel. Note that individual languages may define their own language specific header arguments as well.") (defvar org-babel-default-header-args '((:session . "none") (:results . "replace") (:exports . "code") - (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")) + (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no") + (:padnewline . "yes")) "Default arguments to use when evaluating a source block.") (defvar org-babel-default-inline-header-args - '((:session . "none") (:results . "silent") (:exports . "results")) + '((:session . "none") (:results . "replace") (:exports . "results")) "Default arguments to use when evaluating an inline source block.") -(defvar org-babel-current-buffer-properties nil - "Local cache for buffer properties.") -(make-variable-buffer-local 'org-babel-current-buffer-properties) +(defvar org-babel-data-names '("TBLNAME" "RESNAME" "RESULTS" "DATA")) (defvar org-babel-result-regexp - "^[ \t]*#\\+res\\(ults\\|name\\)\\(\\[\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*" + (concat "^[ \t]*#\\+" + (regexp-opt org-babel-data-names t) + "\\(\\[\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*") "Regular expression used to match result lines. If the results are associated with a hash key then the hash will be saved in the second match data.") @@ -371,7 +401,7 @@ block." (string= "yes" (cdr (assoc :cache params))))) (result-params (cdr (assoc :result-params params))) (new-hash (when cache? (org-babel-sha1-hash info))) - (old-hash (when cache? (org-babel-result-hash info))) + (old-hash (when cache? (org-babel-current-result-hash))) (body (setf (nth 1 info) (let ((noweb (cdr (assoc :noweb params)))) (if (and noweb @@ -379,7 +409,6 @@ block." (string= "tangle" noweb))) (org-babel-expand-noweb-references info) (nth 1 info))))) - (cmd (intern (concat "org-babel-execute:" lang))) (dir (cdr (assoc :dir params))) (default-directory (or (and dir (file-name-as-directory dir)) default-directory)) @@ -388,12 +417,18 @@ block." org-babel-call-process-region-original (symbol-function 'call-process-region))) (indent (car (last info))) - result) + result cmd) (unwind-protect (flet ((call-process-region (&rest args) (apply 'org-babel-tramp-handle-call-process-region args))) - (unless (fboundp cmd) - (error "No org-babel-execute function for %s!" lang)) + (flet ((lang-check (f) + (let ((f (intern (concat "org-babel-execute:" f)))) + (when (fboundp f) f)))) + (setq cmd + (or (lang-check lang) + (lang-check (symbol-name + (cdr (assoc lang org-src-lang-modes)))) + (error "No org-babel-execute function for %s!" lang)))) (if (and (not arg) new-hash (equal new-hash old-hash)) (save-excursion ;; return cached result (goto-char (org-babel-where-is-src-block-result nil info)) @@ -406,16 +441,20 @@ block." (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) (setq result ((lambda (result) - (cond - ((member "file" result-params) - (cdr (assoc :file params))) - ((and (eq (cdr (assoc :result-type params)) 'value) - (or (member "vector" result-params) - (member "table" result-params)) - (not (listp result))) - (list (list result))) - (t result))) + (if (and (eq (cdr (assoc :result-type params)) 'value) + (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result)) result)) (funcall cmd body params))) + ;; if non-empty result and :file then write to :file + (when (cdr (assoc :file params)) + (when result + (with-temp-file (cdr (assoc :file params)) + (insert + (org-babel-format-result + result (cdr (assoc :sep (nth 2 info))))))) + (setq result (cdr (assoc :file params)))) (org-babel-insert-result result result-params info new-hash indent lang) (run-hooks 'org-babel-after-execute-hook) @@ -447,14 +486,51 @@ arguments and pop open the results in a preview buffer." (string= "yes" (cdr (assoc :noweb params)))) (org-babel-expand-noweb-references info) (nth 1 info)))) (expand-cmd (intern (concat "org-babel-expand-body:" lang))) - (assignments-cmd (intern (concat "org-babel-variable-assignments:" lang))) + (assignments-cmd (intern (concat "org-babel-variable-assignments:" + lang))) (expanded (if (fboundp expand-cmd) (funcall expand-cmd body params) (org-babel-expand-body:generic - body params (and (fboundp assignments-cmd) (funcall assignments-cmd params)))))) + body params (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) (org-edit-src-code nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")))) +(defun org-babel-edit-distance (s1 s2) + "Return the edit (levenshtein) distance between strings S1 S2." + (let* ((l1 (length s1)) + (l2 (length s2)) + (dist (map 'vector (lambda (_) (make-vector (1+ l2) nil)) + (number-sequence 1 (1+ l1))))) + (flet ((in (i j) (aref (aref dist i) j)) + (mmin (&rest lst) (apply #'min (remove nil lst)))) + (setf (aref (aref dist 0) 0) 0) + (dolist (i (number-sequence 1 l1)) + (dolist (j (number-sequence 1 l2)) + (setf (aref (aref dist i) j) + (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1) + (mmin (in (1- i) j) (in i (1- j)) (in (1- i) (1- j))))))) + (in l1 l2)))) + +;;;###autoload +(defun org-babel-check-src-block () + "Check for misspelled header arguments in the current code block." + (interactive) + ;; TODO: report malformed code block + ;; TODO: report incompatible combinations of header arguments + (let ((too-close 2)) ;; <- control closeness to report potential match + (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1)) + (and (org-babel-where-is-src-block-head) + (org-babel-parse-header-arguments + (org-babel-clean-text-properties + (match-string 4)))))) + (dolist (name (mapcar #'symbol-name org-babel-header-arg-names)) + (when (and (not (string= header name)) + (<= (org-babel-edit-distance header name) too-close)) + (error "supplied header \"%S\" is suspiciously close to \"%S\"" + header name)))) + (message "No suspicious header arguments found."))) + ;;;###autoload (defun org-babel-load-in-session (&optional arg info) "Load the body of the current source-code block. @@ -543,7 +619,7 @@ with a prefix argument then this is passed on to Return t if a code block was found at point, nil otherwise." `(let ((org-src-window-setup 'switch-invisibly)) (when (and (org-babel-where-is-src-block-head) - (org-edit-src-code nil nil nil 'quietly)) + (org-edit-src-code nil nil nil)) (unwind-protect (progn ,@body) (if (org-bound-and-true-p org-edit-src-from-org-mode) (org-edit-src-exit))) @@ -571,29 +647,25 @@ source code block, otherwise return nil. With optional prefix argument RE-RUN the source-code block is evaluated even if results already exist." (interactive "P") - (when (org-babel-get-src-block-info) - (save-excursion - ;; go to the results, if there aren't any then run the block - (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result)) - (progn (org-babel-execute-src-block) - (org-babel-where-is-src-block-result)))) - (end-of-line 1) - (while (looking-at "[\n\r\t\f ]") (forward-char 1)) - ;; open the results - (if (looking-at org-bracket-link-regexp) - ;; file results - (org-open-at-point) - (let ((results (org-babel-read-result))) - (flet ((echo-res (result) - (if (stringp result) result (format "%S" result)))) - (pop-to-buffer (get-buffer-create "org-babel-results")) - (delete-region (point-min) (point-max)) - (if (listp results) - ;; table result - (insert (orgtbl-to-generic results '(:sep "\t" :fmt echo-res))) - ;; scalar result - (insert (echo-res results)))))) - t))) + (let ((info (org-babel-get-src-block-info))) + (when info + (save-excursion + ;; go to the results, if there aren't any then run the block + (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result)) + (progn (org-babel-execute-src-block) + (org-babel-where-is-src-block-result)))) + (end-of-line 1) + (while (looking-at "[\n\r\t\f ]") (forward-char 1)) + ;; open the results + (if (looking-at org-bracket-link-regexp) + ;; file results + (org-open-at-point) + (let ((r (org-babel-format-result + (org-babel-read-result) (cdr (assoc :sep (nth 2 info)))))) + (pop-to-buffer (get-buffer-create "*Org-Babel Results*")) + (delete-region (point-min) (point-max)) + (insert r))) + t)))) ;;;###autoload (defmacro org-babel-map-src-blocks (file &rest body) @@ -650,13 +722,38 @@ end-body --------- point at the end of the body" (goto-char point)))) ;;;###autoload +(defmacro org-babel-map-inline-src-blocks (file &rest body) + "Evaluate BODY forms on each inline source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer." + (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-inline-src-block-regexp nil t) + (goto-char (match-beginning 1)) + (save-match-data ,@body) + (goto-char (match-end 0)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) + +;;;###autoload (defun org-babel-execute-buffer (&optional arg) "Execute source code blocks in a buffer. Call `org-babel-execute-src-block' on every source block in the current buffer." (interactive "P") + (org-babel-eval-wipe-error-buffer) (org-save-outline-visibility t (org-babel-map-src-blocks nil + (org-babel-execute-src-block arg)) + (org-babel-map-inline-src-blocks nil (org-babel-execute-src-block arg)))) ;;;###autoload @@ -680,26 +777,42 @@ the current subtree." (setf (nth 2 info) (sort (copy-sequence (nth 2 info)) (lambda (a b) (string< (car a) (car b))))) - (let ((hash (sha1 - (format "%s-%s" + (labels ((rm (lst) + (dolist (p '("replace" "silent" "append" "prepend")) + (setq lst (remove p lst))) + lst) + (norm (arg) + (let ((v (if (and (listp (cdr arg)) (null (cddr arg))) + (copy-seq (cdr arg)) + (cdr arg)))) + (when (and v (not (and (sequencep v) + (not (consp v)) + (= (length v) 0)))) + (cond + ((and (listp v) ; lists are sorted + (member (car arg) '(:result-params))) + (sort (rm v) #'string<)) + ((and (stringp v) ; strings are sorted + (member (car arg) '(:results :exports))) + (mapconcat #'identity (sort (rm (split-string v)) + #'string<) " ")) + (t v)))))) + ((lambda (hash) + (when (org-called-interactively-p 'interactive) (message hash)) hash) + (let ((it (format "%s-%s" (mapconcat #'identity - (delq nil - (mapcar - (lambda (arg) - (let ((v (cdr arg))) - (when (and v (not (and (sequencep v) - (not (consp v)) - (= (length v) 0)))) - (format "%S" v)))) - (nth 2 info))) ":") - (nth 1 info))))) - (when (interactive-p) (message hash)) - hash))) - -(defun org-babel-result-hash (&optional info) + (delq nil (mapcar (lambda (arg) + (let ((normalized (norm arg))) + (when normalized + (format "%S" normalized)))) + (nth 2 info))) ":") + (nth 1 info)))) + (sha1 it)))))) + +(defun org-babel-current-result-hash () "Return the in-buffer hash associated with INFO." - (org-babel-where-is-src-block-result nil info) + (org-babel-where-is-src-block-result) (org-babel-clean-text-properties (match-string 3))) (defun org-babel-hide-hash () @@ -834,10 +947,8 @@ may be specified in the properties of the current outline entry." (mapcar (lambda (header-arg) (and (setq val - (or (condition-case nil - (org-entry-get (point) header-arg t) - (error nil)) - (cdr (assoc header-arg org-file-properties)))) + (or (org-entry-get (point) header-arg t) + (org-entry-get (point) (concat ":" header-arg) t))) (cons (intern (concat ":" header-arg)) (org-babel-read val)))) (mapcar @@ -851,18 +962,21 @@ may be specified in the properties of the current outline entry." (defun org-babel-params-from-buffer () "Retrieve per-buffer parameters. Return an association list of any source block params which -may be specified at the top of the current buffer." - (or org-babel-current-buffer-properties - (setq org-babel-current-buffer-properties - (save-match-data - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (when (re-search-forward - (org-make-options-regexp (list "BABEL")) nil t) - (org-babel-parse-header-arguments - (org-match-string-no-properties 2))))))))) +may be specified in the current buffer." + (let (local-properties) + (save-match-data + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward + (org-make-options-regexp (list "BABEL" "PROPERTIES")) nil t) + (setq local-properties + (org-babel-merge-params + local-properties + (org-babel-parse-header-arguments + (org-match-string-no-properties 2))))) + local-properties))))) (defvar org-src-preserve-indentation) (defun org-babel-parse-src-block-match () @@ -871,7 +985,12 @@ may be specified at the top of the current buffer." (lang (org-babel-clean-text-properties (match-string 2))) (lang-headers (intern (concat "org-babel-default-header-args:" lang))) (switches (match-string 3)) - (body (org-babel-clean-text-properties (match-string 5))) + (body (org-babel-clean-text-properties + (let* ((body (match-string 5)) + (sub-length (- (length body) 1))) + (if (string= "\n" (substring body sub-length)) + (substring body 0 sub-length) + body)))) (preserve-indentation (or org-src-preserve-indentation (string-match "-i\\>" switches)))) (list lang @@ -944,14 +1063,19 @@ may be specified at the top of the current buffer." (cdr (assoc :hlines params)) (cdr (assoc :colnames params)) (cdr (assoc :rownames params)))) + (raw-result (or (cdr (assoc :results params)) "")) (result-params (append - (split-string (or (cdr (assoc :results params)) "")) + (split-string (if (stringp raw-result) + raw-result + (eval raw-result))) (cdr (assoc :result-params params))))) (append (mapcar (lambda (var) (cons :var var)) (car vars-and-names)) (list - (cons :colname-names (cadr vars-and-names)) - (cons :rowname-names (caddr vars-and-names)) + (cons :colname-names (or (cdr (assoc :colname-names params)) + (cadr vars-and-names))) + (cons :rowname-names (or (cdr (assoc :rowname-names params)) + (caddr vars-and-names))) (cons :result-params result-params) (cons :result-type (cond ((member "output" result-params) 'output) ((member "value" result-params) 'value) @@ -1067,10 +1191,14 @@ block. Specifically at the beginning of the #+BEGIN_SRC line. If the point is not on a source block then return nil." (let ((initial (point)) top bottom) (or - (save-excursion ;; on a source name line + (save-excursion ;; on a source name line or a #+header line (beginning-of-line 1) - (and (looking-at org-babel-src-name-regexp) (forward-line 1) - (looking-at org-babel-src-block-regexp) + (and (or (looking-at org-babel-src-name-regexp) + (looking-at org-babel-multi-line-header-regexp)) + (progn + (while (and (forward-line 1) + (looking-at org-babel-multi-line-header-regexp))) + (looking-at org-babel-src-block-regexp)) (point))) (save-excursion ;; on a #+begin_src line (beginning-of-line 1) @@ -1125,8 +1253,7 @@ org-babel-named-src-block-regexp." (when file (find-file file)) (goto-char (point-min)) (let (names) (while (re-search-forward org-babel-src-name-w-name-regexp nil t) - (setq names (cons (org-babel-clean-text-properties (match-string 3)) - names))) + (setq names (cons (match-string 4) names))) names))) ;;;###autoload @@ -1159,8 +1286,7 @@ buffer or nil if no such result exists." (when file (find-file file)) (goto-char (point-min)) (let (names) (while (re-search-forward org-babel-result-w-name-regexp nil t) - (setq names (cons (org-babel-clean-text-properties (match-string 4)) - names))) + (setq names (cons (match-string 4) names))) names))) ;;;###autoload @@ -1242,6 +1368,7 @@ region is not active then the point is demarcated." (goto-char start) (move-end-of-line 1))))) (defvar org-babel-lob-one-liner-regexp) +(defvar org-babel-inline-lob-one-liner-regexp) (defun org-babel-where-is-src-block-result (&optional insert info hash indent) "Find where the current source block results begin. Return the point at the beginning of the result of the current @@ -1249,8 +1376,13 @@ source block. Specifically at the beginning of the results line. If no result exists for this block then create a results line following the source block." (save-excursion - (let* ((on-lob-line (progn (beginning-of-line 1) - (looking-at org-babel-lob-one-liner-regexp))) + (let* ((on-lob-line (save-excursion + (beginning-of-line 1) + (looking-at org-babel-lob-one-liner-regexp))) + (inlinep (save-excursion + (re-search-backward "[ \f\t\n\r\v]" nil t) + (when (looking-at org-babel-inline-src-block-regexp) + (match-end 0)))) (name (if on-lob-line (nth 0 (org-babel-lob-get-info)) (nth 4 (or info (org-babel-get-src-block-info))))) @@ -1260,6 +1392,7 @@ following the source block." (setq found ;; was there a result (before we potentially insert one) (or + inlinep (and ;; named results: ;; - return t if it is found, else return nil @@ -1320,7 +1453,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)) + ((org-at-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]*: ") @@ -1343,12 +1476,13 @@ following the source block." "Read the table at `point' into emacs-lisp." (mapcar (lambda (row) (if (and (symbolp row) (equal row 'hline)) row - (mapcar #'org-babel-read row))) + (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) 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)))) + (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) + (mapcar #'cadr (cdr (org-list-parse-list))))) (defvar org-link-types-re) (defun org-babel-read-link () @@ -1367,6 +1501,20 @@ If the path of the link is a file path it is expanded using (expand-file-name (match-string 2 raw)))) (t raw)))) +(defun org-babel-format-result (result &optional sep) + "Format RESULT for writing to file." + (flet ((echo-res (result) + (if (stringp result) result (format "%S" result)))) + (if (listp result) + ;; table result + (orgtbl-to-generic + result + (list + :sep (or sep "\t") + :fmt 'echo-res)) + ;; scalar result + (echo-res result)))) + (defun org-babel-insert-result (result &optional result-params info hash indent lang) "Insert RESULT into the current buffer. @@ -1419,19 +1567,30 @@ code ---- the results are extracted in the syntax of the source (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result) - (when (and (stringp result) ;; ensure results end in a newline - (> (length result) 0) - (not (or (string-equal (substring result -1) "\n") - (string-equal (substring result -1) "\r")))) - (setq result (concat result "\n"))) (save-excursion - (let ((existing-result (org-babel-where-is-src-block-result - t info hash indent)) - (results-switches - (cdr (assoc :results_switches (nth 2 info)))) - beg end) + (let* ((inlinep + (save-excursion + (or (= (point) (point-at-bol)) + (re-search-backward "[ \f\t\n\r\v]" nil t)) + (when (or (looking-at org-babel-inline-src-block-regexp) + (looking-at org-babel-inline-lob-one-liner-regexp)) + (goto-char (match-end 0)) + (insert (if (listp result) "\n" " ")) + (point)))) + (existing-result (unless inlinep + (org-babel-where-is-src-block-result + t info hash indent))) + (results-switches + (cdr (assoc :results_switches (nth 2 info)))) + beg end) + (when (and (stringp result) ; ensure results end in a newline + (not inlinep) + (> (length result) 0) + (not (or (string-equal (substring result -1) "\n") + (string-equal (substring result -1) "\r")))) + (setq result (concat result "\n"))) (if (not existing-result) - (setq beg (point)) + (setq beg (or inlinep (point))) (goto-char existing-result) (save-excursion (re-search-forward "#" nil t) @@ -1454,9 +1613,13 @@ code ---- the results are extracted in the syntax of the source ((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"))))) + (org-list-to-generic + (cons 'unordered + (mapcar + (lambda (el) (list nil (if (stringp el) el (format "%S" el)))) + (if (listp result) result (list result)))) + '(:splicep nil :istart "- " :iend "\n"))) + "\n")) ;; assume the result is a table if it's not a string ((not (stringp result)) (goto-char beg) @@ -1474,30 +1637,30 @@ code ---- the results are extracted in the syntax of the source (setq end (point-marker)) ;; possibly wrap result (flet ((wrap (start finish) - (goto-char beg) (insert start) - (goto-char end) (insert finish) + (goto-char beg) (insert (concat start "\n")) + (goto-char end) (insert (concat finish "\n")) (setq end (point-marker)))) (cond ((member "html" result-params) - (wrap "#+BEGIN_HTML\n" "#+END_HTML")) + (wrap "#+BEGIN_HTML" "#+END_HTML")) ((member "latex" result-params) - (wrap "#+BEGIN_LaTeX\n" "#+END_LaTeX")) + (wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) ((member "code" result-params) - (wrap (format "#+BEGIN_SRC %s%s\n" (or lang "none") results-switches) + (wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) "#+END_SRC")) ((member "org" result-params) - (wrap "#+BEGIN_ORG\n" "#+END_ORG")) + (wrap "#+BEGIN_ORG" "#+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")) + (wrap "#+BEGIN_RESULT" "#+END_RESULT")) ((and (stringp result) (not (member "file" result-params))) (org-babel-examplize-region beg end results-switches) (setq end (point))))) ;; possibly indent the results to match the #+results line - (when (and indent (> indent 0) + (when (and (not inlinep) (numberp indent) indent (> indent 0) ;; in this case `table-align' does the work for us (not (and (listp result) (member "append" result-params)))) @@ -1522,13 +1685,16 @@ code ---- the results are extracted in the syntax of the source (save-excursion (cond ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) - ((org-in-item-p) (- (org-list-bottom-point) 1)) + ((org-at-item-p) (let* ((struct (org-list-struct)) + (prvs (org-list-prevs-alist struct))) + (org-list-get-list-end (point-at-bol) struct prvs))) (t (let ((case-fold-search t) (blocks-re (regexp-opt - (list "latex" "html" "example" "src" "result")))) + (list "latex" "html" "example" "src" "result" "org")))) (if (looking-at (concat "[ \t]*#\\+begin_" blocks-re)) - (re-search-forward (concat "[ \t]*#\\+end_" blocks-re) nil t) + (progn (re-search-forward (concat "[ \t]*#\\+end_" blocks-re) nil t) + (forward-char 1)) (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") (forward-line 1)))) (point))))) @@ -1537,55 +1703,67 @@ code ---- the results are extracted in the syntax of the source "Convert RESULT into an `org-mode' link. If the `default-directory' is different from the containing file's directory then expand relative links." - (format - "[[file:%s]]" - (if (and default-directory - buffer-file-name - (not (string= (expand-file-name default-directory) - (expand-file-name - (file-name-directory buffer-file-name))))) - (expand-file-name result default-directory) - result))) + (flet ((cond-exp (file) + (if (and default-directory + buffer-file-name + (not (string= (expand-file-name default-directory) + (expand-file-name + (file-name-directory buffer-file-name))))) + (expand-file-name file default-directory) + file))) + (if (stringp result) + (format "[[file:%s]]" (cond-exp result)) + (when (and (listp result) (= 2 (length result)) + (stringp (car result)) (stringp (cadr result))) + (format "[[file:%s][%s]]" (car result) (cadr result)))))) (defun org-babel-examplize-region (beg end &optional results-switches) - "Comment out region using the ': ' org example quote." + "Comment out region using the inline '==' or ': ' org example quote." (interactive "*r") - (let ((size (count-lines beg end))) - (save-excursion - (cond ((= size 0)) ; do nothing for an empty result - ((< size org-babel-min-lines-for-block-output) - (goto-char beg) - (dotimes (n size) - (beginning-of-line 1) (insert ": ") (forward-line 1))) - (t - (goto-char beg) - (insert (if results-switches - (format "#+begin_example%s\n" results-switches) - "#+begin_example\n")) - (if (markerp end) (goto-char end) (forward-char (- end beg))) - (insert "#+end_example\n")))))) + (flet ((chars-between (b e) (string-match "[\\S]" (buffer-substring b e)))) + (if (or (chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) + (chars-between end (save-excursion (goto-char end) (point-at-eol)))) + (save-excursion + (goto-char beg) + (insert (format "=%s=" (prog1 (buffer-substring beg end) + (delete-region beg end))))) + (let ((size (count-lines beg end))) + (save-excursion + (cond ((= size 0)) ; do nothing for an empty result + ((< size org-babel-min-lines-for-block-output) + (goto-char beg) + (dotimes (n size) + (beginning-of-line 1) (insert ": ") (forward-line 1))) + (t + (goto-char beg) + (insert (if results-switches + (format "#+begin_example%s\n" results-switches) + "#+begin_example\n")) + (if (markerp end) (goto-char end) (forward-char (- end beg))) + (insert "#+end_example\n")))))))) (defun org-babel-update-block-body (new-body) "Update the body of the current code block to NEW-BODY." (if (not (org-babel-where-is-src-block-head)) (error "not in source block") (save-match-data - (replace-match (concat (org-babel-trim new-body) "\n") nil nil nil 5)) + (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5)) (indent-rigidly (match-beginning 5) (match-end 5) 2))) (defun org-babel-merge-params (&rest plists) "Combine all parameter association lists in PLISTS. -Later elements of PLISTS override the values of previous element. +Later elements of PLISTS override the values of previous elements. This takes into account some special considerations for certain parameters when merging lists." (let ((results-exclusive-groups - '(("file" "list" "vector" "table" "scalar" "raw" "org" + '(("file" "list" "vector" "table" "scalar" "verbatim" "raw" "org" "html" "latex" "code" "pp" "wrap") ("replace" "silent" "append" "prepend") ("output" "value"))) (exports-exclusive-groups '(("code" "results" "both" "none"))) - params results exports tangle noweb cache vars shebang comments) + (variable-index 0) + params results exports tangle noweb cache vars shebang comments padline) (flet ((e-merge (exclusive-groups &rest result-params) ;; maintain exclusivity of mutually exclusive parameters (let (output) @@ -1616,18 +1794,29 @@ parameters when merging lists." (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" (cdr pair)) (intern (match-string 1 (cdr pair))))))) - (when name - (setq vars - (cons (cons name pair) - (if (member name (mapcar #'car vars)) - (delq nil - (mapcar - (lambda (p) (unless (equal (car p) name) p)) - vars)) - vars)))))) + (if name + (setq vars + (append + (if (member name (mapcar #'car vars)) + (delq nil + (mapcar + (lambda (p) + (unless (equal (car p) name) p)) + vars)) + vars) + (list (cons name pair)))) + ;; if no name is given, then assign to variables in order + (prog1 (setf (cddr (nth variable-index vars)) + (concat (symbol-name + (car (nth variable-index vars))) + "=" (cdr pair))) + (incf variable-index))))) (:results (setq results (e-merge results-exclusive-groups - results (split-string (cdr pair))))) + results + (split-string + (let ((r (cdr pair))) + (if (stringp r) r (eval r))))))) (:file (when (cdr pair) (setq results (e-merge results-exclusive-groups @@ -1649,6 +1838,9 @@ parameters when merging lists." (:cache (setq cache (e-merge '(("yes" "no")) cache (split-string (or (cdr pair) ""))))) + (:padline + (setq padline (e-merge '(("yes" "no")) padline + (split-string (or (cdr pair) ""))))) (:shebang ;; take the latest -- always overwrite (setq shebang (or (list (cdr pair)) shebang))) (:comments @@ -1658,18 +1850,15 @@ parameters when merging lists." (setq params (cons pair (assq-delete-all (car pair) params)))))) plist)) plists)) + (setq vars (reverse vars)) (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) - (cons (cons :comments (mapconcat 'identity comments " ")) - (cons (cons :shebang (mapconcat 'identity shebang " ")) - (cons (cons :cache (mapconcat 'identity cache " ")) - (cons (cons :noweb (mapconcat 'identity noweb " ")) - (cons (cons :tangle (mapconcat 'identity tangle " ")) - (cons (cons :exports - (mapconcat 'identity exports " ")) - (cons - (cons :results - (mapconcat 'identity results " ")) - params))))))))) + (mapc + (lambda (hd) + (let ((key (intern (concat ":" (symbol-name hd)))) + (val (eval hd))) + (setf params (cons (cons key (mapconcat 'identity val " ")) params)))) + '(results exports tangle noweb padline cache shebang comments)) + params)) (defun org-babel-expand-noweb-references (&optional info parent-buffer) "Expand Noweb references in the body of the current source code block. @@ -1705,9 +1894,22 @@ block but are passed literally to the \"example-block\"." (info (or info (org-babel-get-src-block-info))) (lang (nth 0 info)) (body (nth 1 info)) - (new-body "") index source-name evaluate prefix) - (flet ((nb-add (text) - (setq new-body (concat new-body text)))) + (comment (string= "noweb" (cdr (assoc :comments (nth 2 info))))) + (new-body "") index source-name evaluate prefix blocks-in-buffer) + (flet ((nb-add (text) (setq new-body (concat new-body text))) + (c-wrap (text) + (with-temp-buffer + (funcall (intern (concat lang "-mode"))) + (comment-region (point) (progn (insert text) (point))) + (org-babel-trim (buffer-string)))) + (blocks () ;; return the info lists of all blocks in this buffer + (let (infos) + (save-restriction + (widen) + (org-babel-map-src-blocks nil + (setq infos (cons (org-babel-get-src-block-info 'light) + infos)))) + (reverse infos)))) (with-temp-buffer (insert body) (goto-char (point-min)) (setq index (point)) @@ -1724,33 +1926,46 @@ block but are passed literally to the \"example-block\"." (nb-add (buffer-substring index (point))) (goto-char (match-end 0)) (setq index (point)) - (nb-add (with-current-buffer parent-buffer - (mapconcat ;; interpose PREFIX between every line - #'identity - (split-string - (if evaluate - (let ((raw (org-babel-ref-resolve source-name))) - (if (stringp raw) raw (format "%S" raw))) - (save-restriction - (widen) - (let ((point (org-babel-find-named-block - source-name))) - (if point - (save-excursion - (goto-char point) - (org-babel-trim - (org-babel-expand-noweb-references - (org-babel-get-src-block-info)))) - ;; optionally raise an error if named - ;; source-block doesn't exist - (if (member lang org-babel-noweb-error-langs) - (error "%s" - (concat - "<<" source-name ">> " - "could not be resolved (see " - "`org-babel-noweb-error-langs')")) - ""))))) - "[\n\r]") (concat "\n" prefix))))) + (nb-add + (with-current-buffer parent-buffer + (mapconcat ;; interpose PREFIX between every line + #'identity + (split-string + (if evaluate + (let ((raw (org-babel-ref-resolve source-name))) + (if (stringp raw) raw (format "%S" raw))) + (or + ;; retrieve from the library of babel + (nth 2 (assoc (intern source-name) + org-babel-library-of-babel)) + ;; return the contents of headlines literally + (save-excursion + (when (org-babel-ref-goto-headline-id source-name) + (org-babel-ref-headline-body))) + ;; find the expansion of reference in this buffer + (mapconcat + (lambda (i) + (when (string= source-name + (or (cdr (assoc :noweb-ref (nth 2 i))) + (nth 4 i))) + (let ((body (org-babel-expand-noweb-references i))) + (if comment + ((lambda (cs) + (concat (c-wrap (car cs)) "\n" + body "\n" (c-wrap (cadr cs)))) + (org-babel-tangle-comment-links i)) + body)))) + (or blocks-in-buffer + (setq blocks-in-buffer (blocks))) + "") + ;; possibly raise an error if named block doesn't exist + (if (member lang org-babel-noweb-error-langs) + (error "%s" (concat + "<<" source-name ">> " + "could not be resolved (see " + "`org-babel-noweb-error-langs')")) + ""))) + "[\n\r]") (concat "\n" prefix))))) (nb-add (buffer-substring index (point-max))))) new-body)) @@ -1761,13 +1976,22 @@ block but are passed literally to the \"example-block\"." (defun org-babel-strip-protective-commas (body) "Strip protective commas from bodies of source blocks." - (replace-regexp-in-string "^,#" "#" body)) + (when body + (replace-regexp-in-string "^,#" "#" body))) -(defun org-babel-script-escape (str) +(defun org-babel-script-escape (str &optional force) "Safely convert tables into elisp lists." (let (in-single in-double out) - (org-babel-read - (if (and (stringp str) (string-match "^\\[.+\\]$" str)) + ((lambda (escaped) (condition-case nil (org-babel-read escaped) (error escaped))) + (if (or force + (and (stringp str) + (> (length str) 2) + (or (and (string-equal "[" (substring str 0 1)) + (string-equal "]" (substring str -1))) + (and (string-equal "{" (substring str 0 1)) + (string-equal "}" (substring str -1))) + (and (string-equal "(" (substring str 0 1)) + (string-equal ")" (substring str -1)))))) (org-babel-read (concat "'" @@ -1783,7 +2007,14 @@ block but are passed literally to the \"example-block\"." (93 (if (or in-double in-single) ; ] (cons 93 out) (cons 41 out))) - (44 (if (or in-double in-single) (cons 44 out) out)) ; , + (123 (if (or in-double in-single) ; { + (cons 123 out) + (cons 40 out))) + (125 (if (or in-double in-single) ; } + (cons 125 out) + (cons 41 out))) + (44 (if (or in-double in-single) ; , + (cons 44 out) (cons 32 out))) (39 (if in-double ; ' (cons 39 out) (setq in-single (not in-single)) (cons 34 out))) @@ -1795,20 +2026,21 @@ block but are passed literally to the \"example-block\"." (apply #'string (reverse out))))) str)))) -(defun org-babel-read (cell) +(defun org-babel-read (cell &optional inhibit-lisp-eval) "Convert the string value of CELL to a number if appropriate. Otherwise if cell looks like lisp (meaning it starts with a -\"(\" or a \"'\") then read it as lisp, otherwise return it -unmodified as a string. - -This is taken almost directly from `org-read-prop'." +\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, otherwise +return it unmodified as a string. Optional argument NO-LISP-EVAL +inhibits lisp evaluation for situations in which is it not +appropriate." (if (and (stringp cell) (not (equal cell ""))) (or (org-babel-number-p cell) - (if (or (equal "(" (substring cell 0 1)) - (equal "'" (substring cell 0 1)) - (equal "`" (substring cell 0 1))) + (if (and (not inhibit-lisp-eval) + (member (substring cell 0 1) '("(" "'" "`" "["))) (eval (read cell)) - (progn (set-text-properties 0 (length cell) nil cell) cell))) + (if (string= (substring cell 0 1) "\"") + (read cell) + (progn (set-text-properties 0 (length cell) nil cell) cell)))) cell)) (defun org-babel-number-p (string) @@ -1932,7 +2164,8 @@ of `org-babel-temporary-directory'." prefix temporary-file-directory) nil suffix)) (let ((temporary-file-directory - (or (and (file-exists-p org-babel-temporary-directory) + (or (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory) org-babel-temporary-directory) temporary-file-directory))) (make-temp-file prefix nil suffix)))) @@ -1957,11 +2190,14 @@ of `org-babel-temporary-directory'." (delete-directory org-babel-temporary-directory)) (error (message "Failed to remove temporary Org-babel directory %s" - org-babel-temporary-directory))))) + (if (boundp 'org-babel-temporary-directory) + org-babel-temporary-directory + "[directory not defined]")))))) (add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) (provide 'ob) +;; arch-tag: 01a7ebee-06c5-4ee4-a709-e660d28c0af1 ;;; ob.el ends here diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 8aeb4c4e5b2..9502c2f2b6b 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -1,11 +1,12 @@ ;;; org-agenda.el --- Dynamic task and appointment lists for Org -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -60,6 +61,9 @@ (declare-function org-is-habit-p "org-habit" (&optional pom)) (declare-function org-habit-parse-todo "org-habit" (&optional pom)) (declare-function org-habit-get-priority "org-habit" (habit &optional moment)) +(declare-function org-pop-to-buffer-same-window "org-compat" + (&optional buffer-or-name norecord label)) + (defvar calendar-mode-map) (defvar org-clock-current-task) ; defined in org-clock.el (defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el @@ -88,16 +92,20 @@ only needed when the text to be killed contains more than N non-white lines." (defcustom org-agenda-compact-blocks nil "Non-nil means make the block agenda more compact. -This is done by leaving out unnecessary lines." +This is done globally by leaving out lines like the agenda span +name and week number or the separator lines." :group 'org-agenda :type 'boolean) (defcustom org-agenda-block-separator ?= "The separator between blocks in the agenda. If this is a string, it will be used as the separator, with a newline added. -If it is a character, it will be repeated to fill the window width." +If it is a character, it will be repeated to fill the window width. +If nil the separator is disabled. In `org-agenda-custom-commands' this +addresses the separator between the current and the previous block." :group 'org-agenda :type '(choice + (const :tag "Disabled" nil) (character) (string))) @@ -515,6 +523,23 @@ this one will be used." "Options concerning skipping parts of agenda files." :tag "Org Agenda Skip" :group 'org-agenda) + +(defcustom org-agenda-skip-function-global nil + "Function to be called at each match during agenda construction. +If this function returns nil, the current match should not be skipped. +If the function decided to skip an agenda match, is must return the +buffer position from which the search should be continued. +This may also be a Lisp form, which will be evaluated. + +This variable will be applied to every agenda match, including +tags/property searches and TODO lists. So try to make the test function +do its checking as efficiently as possible. To implement a skipping +condition just for specific agenda commands, use the variable +`org-agenda-skip-function' which can be set in the options section +of custom agenda commands." + :group 'org-agenda-skip + :type 'sexp) + (defgroup org-agenda-daily/weekly nil "Options concerning the daily/weekly agenda." :tag "Org Agenda Daily/Weekly" @@ -581,6 +606,14 @@ 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. +This variable can also have an integer as a value. If positive (N), +todos with a timestamp N or more days in the future will be ignored. If +negative (-N), todos with a timestamp N or more days in the past will be +ignored. If 0, todos with a timestamp either today or in the future will +be ignored. For example, a value of -1 will exclude todos with a +timestamp in the past (yesterday or earlier), while a value of 7 will +exclude todos with a timestamp a week or more in the future. + 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." @@ -590,7 +623,8 @@ to make his option also apply to the tags-todo list." (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))) + (const :tag "Show timestamp todos" nil) + (integer :tag "Ignore if N or more days in past(-) or future(+)."))) (defcustom org-agenda-todo-ignore-scheduled nil "Non-nil means, ignore some scheduled TODO items when making TODO list. @@ -609,6 +643,9 @@ all Don't show any scheduled entries in the global todo list. t Same as `all', for backward compatibility. +This variable can also have an integer as a value. See +`org-agenda-todo-ignore-timestamp' for more details. + 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." @@ -619,7 +656,8 @@ to make his option also apply to the tags-todo list." (const :tag "Ignore past- or present-scheduled todos" past) (const :tag "Ignore all scheduled todos" all) (const :tag "Ignore all scheduled todos (compatibility)" t) - (const :tag "Show scheduled todos" nil))) + (const :tag "Show scheduled todos" nil) + (integer :tag "Ignore if N or more days in past(-) or future(+)."))) (defcustom org-agenda-todo-ignore-deadlines nil "Non-nil means ignore some deadlined TODO items when making TODO list. @@ -646,6 +684,9 @@ all Ignore all TODO entries that do have a deadline. t Same as `near', for backward compatibility. +This variable can also have an integer as a value. See +`org-agenda-todo-ignore-timestamp' for more details. + 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." @@ -656,7 +697,8 @@ to make his option also apply to the tags-todo list." (const :tag "Ignore near deadlines (compatibility)" t) (const :tag "Ignore far deadlines" far) (const :tag "Ignore all TODOs with a deadlines" all) - (const :tag "Show all TODOs, even if they have a deadline" nil))) + (const :tag "Show all TODOs, even if they have a deadline" nil) + (integer :tag "Ignore if N or more days in past(-) or future(+)."))) (defcustom org-agenda-tags-todo-honor-ignore-options nil "Non-nil means honor todo-list ...ignore options also in tags-todo search. @@ -782,11 +824,11 @@ N days, just insert a special line indicating the size of the gap." :group 'org-agenda) (defcustom org-agenda-menu-show-matcher t - "Non-nil menas show the match string in the agenda dispatcher menu. + "Non-nil means show the match string in the agenda dispatcher menu. When nil, the matcher string is not shown, but is put into the help-echo property so than moving the mouse over the command shows it. Setting it to nil is good if matcher strings are very long and/or if -you wnat to use two-column display (see `org-agenda-menu-two-column')." +you want to use two-column display (see `org-agenda-menu-two-column')." :group 'org-agenda :type 'boolean) @@ -882,7 +924,7 @@ It only matters if `org-agenda-window-setup' is `reorganize-frame'." :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) (defcustom org-agenda-restore-windows-after-quit nil - "Non-nil means restore window configuration open exiting agenda. + "Non-nil means restore window configuration upon exiting agenda. Before the window configuration is changed for displaying the agenda, the current status is recorded. When the agenda is exited with `q' or `x' and this option is set, the old state is restored. If @@ -1031,10 +1073,15 @@ This option is deprecated, it is better to define a block agenda instead." (defcustom org-agenda-repeating-timestamp-show-all t "Non-nil means show all occurrences of a repeating stamp in the agenda. -When nil, only one occurrence is shown, either today or the -nearest into the future." +When set to a list of strings, only show occurrences of repeating +stamps for these TODO keywords. When nil, only one occurrence is +shown, either today or the nearest into the future." :group 'org-agenda-daily/weekly - :type 'boolean) + :type '(choice + (const :tag "Show repeating stamps" t) + (repeat :tag "Show repeating stamps for these TODO keywords" + (string :tag "TODO Keyword")) + (const :tag "Don't show repeating stamps" nil))) (defcustom org-scheduled-past-days 10000 "No. of days to continue listing scheduled items that are not marked DONE. @@ -1056,6 +1103,49 @@ the agenda to display all available LOG items temporarily." :group 'org-agenda-daily/weekly :type '(set :greedy t (const closed) (const clock) (const state))) +(defcustom org-agenda-clock-consistency-checks + '(:max-duration "10:00" :min-duration 0 :max-gap "0:05" + :gap-ok-around ("4:00") + :default-face ((:background "DarkRed") (:foreground "white")) + :overlap-face nil :gap-face nil :no-end-time-face nil + :long-face nil :short-face nil) + "This is a property list, with the following keys: + +:max-duration Mark clocking chunks that are longer than this time. + This is a time string like \"HH:MM\", or the number + of minutes as an integer. + +:min-duration Mark clocking chunks that are shorter that this. + This is a time string like \"HH:MM\", or the number + of minutes as an integer. + +:max-gap Mark gaps between clocking chunks that are longer than + this duration. A number of minutes, or a string + like \"HH:MM\". + +:gap-ok-around List of times during the day which are usually not working + times. When a gap is detected, but the gap contains any + of these times, the gap is *not* reported. For example, + if this is (\"4:00\" \"13:00\") then gaps that contain + 4:00 in the morning (i.e. the night) and 13:00 + (i.e. a typical lunch time) do not cause a warning. + You should have at least one time during the night in this + list, or otherwise the first task each morning will trigger + a warning because it follows a long gap. + +Furthermore, the following properties can be used to define faces for +issue display. + +:default-face the default face, if the specific face is undefined +:overlap-face face for overlapping clocks +:gap-face face for gaps between clocks +:no-end-time-face face for incomplete clocks +:long-face face for clock intervals that are too long +:short-face face for clock intervals that are too short" + :group 'org-agenda-daily/weekly + :group 'org-clock + :type 'plist) + (defcustom org-agenda-log-mode-add-notes t "Non-nil means add first line of notes to log entries in agenda views. If a log item like a state change or a clock entry is associated with @@ -1182,6 +1272,17 @@ a grid line." (string :tag "Grid String") (repeat :tag "Grid Times" (integer :tag "Time")))) +(defcustom org-agenda-show-current-time-in-grid t + "Non-nil means show the current time in the time grid." + :group 'org-agenda-time-grid + :type 'boolean) + +(defcustom org-agenda-current-time-string + "now - - - - - - - - - - - - - - - - - - - - - - - - -" + "The string for the current time marker in the agenda." + :group 'org-agenda-time-grid + :type 'string) + (defgroup org-agenda-sorting nil "Options concerning sorting in the Org-mode Agenda." :tag "Org Agenda Sorting" @@ -1290,32 +1391,31 @@ When nil, such items are sorted as 0 minutes effort." (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 -are format strings. +An alist with five entries, each for the different agenda types. The +keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'. +The values are format strings. + 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 - format HH:MM + %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, see `org-agenda-category-icon-alist' + %T the last tag of the item (ignore inherited tags, which come first) + %t the HH:MM time-of-day specification if one applies to the entry %s Scheduling/Deadline information, a short string + %(expression) Eval EXPRESSION and replace the control string + by the result All specifiers work basically like the standard `%s' of printf, but may -contain two additional characters: A question mark just after the `%' and -a whitespace/punctuation character just before the final letter. +contain two additional characters: a question mark just after the `%' +and a whitespace/punctuation character just before the final letter. If the first character after `%' is a question mark, the entire field -will only be included if the corresponding value applies to the -current entry. This is useful for fields which should have fixed -width when present, but zero width when absent. For example, -\"%?-12t\" will result in a 12 character time field if a time of the -day is specified, but will completely disappear in entries which do -not contain a time. +will only be included if the corresponding value applies to the current +entry. This is useful for fields which should have fixed width when +present, but zero width when absent. For example, \"%?-12t\" will +result in a 12 character time field if a time of the day is specified, +but will completely disappear in entries which do not contain a time. If there is punctuation or whitespace character just before the final format letter, this character will be appended to the field value if @@ -1323,19 +1423,16 @@ the value is not empty. For example, the format \"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If the category were be empty, no additional colon would be inserted. -The default value of this option is \" %-12:c%?-12t% s\", meaning: +The default value for the agenda sublist is \" %-12:c%?-12t% s\", +which means: + - Indent the line with two space characters -- Give the category in a 12 chars wide field, padded with whitespace on +- Give the category a 12 chars wide field, padded with whitespace on the right (because of `-'). Append a colon if there is a category (because of `:'). - If there is a time-of-day, put it into a 12 chars wide field. If no time, don't put in an empty field, just skip it (because of '?'). -- Finally, put the scheduling information and append a whitespace. - -As another example, if you don't want the time-of-day of entries in -the prefix, you could use: - - (setq org-agenda-prefix-format \" %-11:c% s\") +- Finally, put the scheduling information. See also the variables `org-agenda-remove-times-when-in-prefix' and `org-agenda-remove-tags'. @@ -1525,7 +1622,7 @@ 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: +The other fields can be omited safely if not needed: TYPE indicates the image type. DATA-P is a boolean indicating whether the FILE-OR-DATA string is image data. @@ -1562,16 +1659,6 @@ category, you can use: :group 'org-agenda-column-view :type 'boolean) -(defcustom org-agenda-columns-remove-prefix-from-item t - "Non-nil means remove the prefix from a headline for agenda column view. -The special ITEM field in the columns format contains the current line, with -all information shown in other columns (like the TODO state or a tag). -When this variable is non-nil, also the agenda prefix will be removed from -the content of the ITEM field, to make sure as much as possible of the -headline can be shown in the limited width of the field." - :group 'org-agenda - :type 'boolean) - (defcustom org-agenda-columns-compute-summary-properties t "Non-nil means recompute all summary properties before column view. When column view in the agenda is listing properties that have a summary @@ -1605,6 +1692,19 @@ the lower-case version of all tags." :group 'org-agenda :type 'function) +(defcustom org-agenda-bulk-custom-functions nil + "Alist of characters and custom functions for bulk actions. +For example, this value makes those two functions available: + + '((?R set-category) + (?C bulk-cut)) + +With selected entries in an agenda buffer, `B R' will call +the custom function `set-category' on the selected entries. +Note that functions in this alist don't need to be quoted." + :type 'alist + :group 'org-agenda) + (eval-when-compile (require 'cl)) (require 'org) @@ -1709,8 +1809,10 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) (org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile) (org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark) +(org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp) (org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark) (org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-remove-all-marks) +(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda) (org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action) (org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload) (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default) @@ -1913,9 +2015,10 @@ The following commands are available: ["Delete subtree" org-agenda-kill t]) ("Bulk action" ["Mark entry" org-agenda-bulk-mark t] + ["Mark matching regexp" org-agenda-bulk-mark-regexp t] ["Unmark entry" org-agenda-bulk-unmark t] - ["Act on all marked" org-agenda-bulk-action t] ["Unmark all entries" org-agenda-bulk-remove-all-marks :active t :keys "C-u s"]) + ["Act on all marked" org-agenda-bulk-action t] "--" ("Tags and Properties" ["Show all Tags" org-agenda-show-tags t] @@ -1988,7 +2091,6 @@ The following commands are available: (defvar org-agenda-pending-undo-list nil "In a series of undo commands, this is the list of remaining undo items.") - (defun org-agenda-undo () "Undo a remote editing step in the agenda. This undoes changes both in the agenda buffer and in the remote buffer @@ -2104,6 +2206,8 @@ Pressing `<' twice means to restrict to the current subtree or region (move-marker org-agenda-restrict-end nil)) ;; Delete old local properties (put 'org-agenda-redo-command 'org-lprops nil) + ;; Delete previously set last-arguments + (put 'org-agenda-redo-command 'last-args nil) ;; Remember where this call originated (setq org-agenda-last-dispatch-buffer (current-buffer)) (unless keys @@ -2156,7 +2260,7 @@ Pressing `<' twice means to restrict to the current subtree or region ((eq type 'todo-tree) (org-check-for-org-mode) (org-let lprops - '(org-occur (concat "^" outline-regexp "[ \t]*" + '(org-occur (concat "^" org-outline-regexp "[ \t]*" (regexp-quote match) "\\>")))) ((eq type 'occur-tree) (org-check-for-org-mode) @@ -2166,7 +2270,7 @@ Pressing `<' twice means to restrict to the current subtree or region ((fboundp type) (org-let lprops '(funcall type match))) (t (error "Invalid custom agenda command type %s" type)))) - (org-run-agenda-series (nth 1 entry) (cddr entry)))) + (org-agenda-run-series (nth 1 entry) (cddr entry)))) ((equal keys "C") (setq org-agenda-custom-commands org-agenda-custom-commands-orig) (customize-variable 'org-agenda-custom-commands)) @@ -2204,6 +2308,17 @@ Pressing `<' twice means to restrict to the current subtree or region ((equal keys "!") (customize-variable 'org-stuck-projects)) (t (error "Invalid agenda key")))))) +(defun org-agenda-append-agenda () + "Append another agenda view to the current one. +This function allows interactive building of block agendas. +Agenda views are separated by `org-agenda-block-separator'." + (interactive) + (unless (string= (buffer-name) org-agenda-buffer-name) + (error "Can only append from within agenda buffer")) + (let ((org-agenda-multi t)) + (org-agenda) + (widen))) + (defun org-agenda-normalize-custom-commands (cmds) (delq nil (mapcar @@ -2402,10 +2517,17 @@ s Search for keywords C Configure custom agenda commands ((equal c ?q) (error "Abort")) (t (error "Invalid key %c" c)))))))) -(defun org-run-agenda-series (name series) +(defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter +(defvar org-agenda-last-arguments nil + "The arguments of the previous call to `org-agenda'.") +(defun org-agenda-run-series (name series) (org-let (nth 1 series) '(org-prepare-agenda name)) (let* ((org-agenda-multi t) - (redo (list 'org-run-agenda-series name (list 'quote series))) + (redo (list 'org-agenda-run-series name (list 'quote series))) + (org-agenda-overriding-arguments + (or org-agenda-overriding-arguments + (unless (null (delq nil (get 'org-agenda-redo-command 'last-args))) + (get 'org-agenda-redo-command 'last-args)))) (cmds (car series)) (gprops (nth 1 series)) match ;; The byte compiler incorrectly complains about this. Keep it! @@ -2440,6 +2562,7 @@ s Search for keywords C Configure custom agenda commands (t (error "Invalid type in command series")))) (widen) (setq org-agenda-redo-command redo) + (put 'org-agenda-redo-command 'last-args org-agenda-last-arguments) (goto-char (point-min))) (org-fit-agenda-window) (org-let (nth 1 series) '(org-finalize-agenda))) @@ -2921,7 +3044,8 @@ the global options and expect it to be applied to the entire view.") (progn (setq buffer-read-only nil) (goto-char (point-max)) - (unless (or (bobp) org-agenda-compact-blocks) + (unless (or (bobp) org-agenda-compact-blocks + (not org-agenda-block-separator)) (insert "\n" (if (stringp org-agenda-block-separator) org-agenda-block-separator @@ -2944,7 +3068,7 @@ the global options and expect it to be applied to the entire view.") (awin (select-window awin)) ((not (setq org-pre-agenda-window-conf (current-window-configuration)))) ((equal org-agenda-window-setup 'current-window) - (switch-to-buffer abuf)) + (org-pop-to-buffer-same-window abuf)) ((equal org-agenda-window-setup 'other-window) (org-switch-to-buffer-other-window abuf)) ((equal org-agenda-window-setup 'other-frame) @@ -2955,7 +3079,7 @@ the global options and expect it to be applied to the entire view.") ;; additional test in case agenda is invoked from within agenda ;; buffer via elisp link (unless (equal (current-buffer) abuf) - (switch-to-buffer abuf))) + (org-pop-to-buffer-same-window abuf))) (setq buffer-read-only nil) (let ((inhibit-read-only t)) (erase-buffer)) (org-agenda-mode) @@ -3098,15 +3222,17 @@ Otherwise, the function must return a position from where the search should be continued. This may also be a Lisp form, it will be evaluated. Never set this variable using `setq' or so, because then it will apply -to all future agenda commands. Instead, bind it with `let' to scope -it dynamically into the agenda-constructing command. A good way to set -it is through options in `org-agenda-custom-commands'.") +to all future agenda commands. If you do want a global skipping condition, +use the option `org-agenda-skip-function-global' instead. +The correct usage for `org-agenda-skip-function' is to bind it with +`let' to scope it dynamically into the agenda-constructing command. +A good way to set it is through options in `org-agenda-custom-commands'.") (defun org-agenda-skip () "Throw to `:skip' in places that should be skipped. Also moves point to the end of the skipped region, so that search can continue from there." - (let ((p (point-at-bol)) to fp) + (let ((p (point-at-bol)) to) (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) (get-text-property p :org-archived) (org-end-of-subtree t) @@ -3116,16 +3242,26 @@ continue from there." (org-end-of-subtree t) (throw :skip t)) (if (equal (char-after p) ?#) (throw :skip t)) - (when (and (or (setq fp (functionp org-agenda-skip-function)) - (consp org-agenda-skip-function)) - (setq to (save-excursion - (save-match-data - (if fp - (funcall org-agenda-skip-function) - (eval org-agenda-skip-function)))))) + (when (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global) + (org-agenda-skip-eval org-agenda-skip-function))) (goto-char to) (throw :skip t)))) +(defun org-agenda-skip-eval (form) + "If FORM is a function or a list, call (or eval) is and return result. +`save-excursion' and `save-match-data' are wrapped around the call, so point +and match data are returned to the previous state no matter what these +functions do." + (let (fp) + (and form + (or (setq fp (functionp form)) + (consp form)) + (save-excursion + (save-match-data + (if fp + (funcall form) + (eval form))))))) + (defvar org-agenda-markers nil "List of all currently active markers created by `org-agenda'.") (defvar org-agenda-last-marker-time (org-float-time) @@ -3333,11 +3469,9 @@ When EMPTY is non-nil, also include days without any entries." ;;; Agenda Daily/Weekly -(defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter (defvar org-agenda-start-day nil ; dynamically scoped parameter -"Custom commands can set this variable in the options section.") -(defvar org-agenda-last-arguments nil - "The arguments of the previous call to `org-agenda'.") +"Start day for the agenda view. +Custom commands can set this variable in the options section.") (defvar org-starting-day 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 @@ -3382,11 +3516,6 @@ the daily/weekly agenda, see `org-agenda-skip-function'.") 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. -With one \\[universal-argument] prefix argument INCLUDE-ALL, -all unfinished TODO items will also be shown, before the agenda. -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 SPAN to change the number of days. SPAN defaults to `org-agenda-span'. @@ -3407,7 +3536,8 @@ given in `org-agenda-start-on-weekday'." (setq org-agenda-last-arguments (list include-all start-day span)) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) - (let* ((span (org-agenda-ndays-to-span (or span org-agenda-ndays org-agenda-span))) + (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)) @@ -3440,24 +3570,6 @@ given in `org-agenda-start-on-weekday'." (org-set-local 'org-starting-day (car day-numbers)) (org-set-local 'org-include-all-loc include-all) (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 - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (setq date (calendar-gregorian-from-absolute today) - rtn (org-agenda-get-day-entries - file date :todo)) - (setq rtnall (append rtnall rtn)))) - (when rtnall - (insert "All currently open TODO items:\n") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure - 'short-heading "All TODO items")) - (org-agenda-mark-header-line (point-min)) - (insert (org-finalize-agenda-entries rtnall) "\n"))) (unless org-agenda-compact-blocks (let* ((d1 (car day-numbers)) (d2 (org-last day-numbers)) @@ -3496,7 +3608,7 @@ given in `org-agenda-start-on-weekday'." (setq org-agenda-entry-types (delq :deadline org-agenda-entry-types))) (cond - ((eq org-agenda-show-log 'only) + ((memq org-agenda-show-log '(only clockcheck)) (setq rtn (org-agenda-get-day-entries file date :closed))) (org-agenda-show-log @@ -3539,7 +3651,7 @@ given in `org-agenda-start-on-weekday'." (when (and org-agenda-clockreport-mode clocktable-start) (let ((org-agenda-files (org-agenda-files nil 'ifmode)) ;; the above line is to ensure the restricted range! - (p org-agenda-clockreport-parameter-plist) + (p (copy-sequence org-agenda-clockreport-parameter-plist)) tbl) (setq p (org-plist-delete p :block)) (setq p (plist-put p :tstart clocktable-start)) @@ -3553,7 +3665,6 @@ given in `org-agenda-start-on-weekday'." "" x)) filter "")))) - (message "%s" (plist-get p :tags)) (sit-for 2) (setq tbl (apply 'org-get-clocktable p)) (insert tbl))) (goto-char (point-min)) @@ -3568,6 +3679,8 @@ given in `org-agenda-start-on-weekday'." (recenter 1)))) (goto-char (or start-pos 1)) (add-text-properties (point-min) (point-max) '(org-agenda-type agenda)) + (if (eq org-agenda-show-log 'clockcheck) + (org-agenda-show-clocking-issues)) (org-finalize-agenda) (setq buffer-read-only t) (message ""))) @@ -3757,7 +3870,7 @@ in `org-agenda-text-search-extra-files'." regexps+)) (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) (if (not regexps+) - (setq regexp (concat "^" org-outline-regexp)) + (setq regexp org-outline-regexp-bol) (setq regexp (pop regexps+)) (if hdl-only (setq regexp (concat "^" org-outline-regexp ".*?" regexp)))) @@ -4013,7 +4126,7 @@ This is basically a temporary global variable that can be set and then used by user-defined selections using `org-agenda-skip-function'.") (defvar org-agenda-overriding-header nil - "When this is set during todo and tags searches, will replace header. + "When set during agenda, todo and tags searches it replaces the header. This variable should not be set directly, but custom commands can bind it in the options section.") @@ -4195,9 +4308,11 @@ of what a project is and how to check if it stuck, customize the variable "\\)\\>")) (tags (nth 2 org-stuck-projects)) (tags-re (if (member "*" tags) - (org-re "^\\*+ .*:[[:alnum:]_@#%]+:[ \t]*$") + (org-re (concat org-outline-regexp-bol + ".*:[[:alnum:]_@#%]+:[ \t]*$")) (if tags - (concat "^\\*+ .*:\\(" + (concat org-outline-regexp-bol + ".*:\\(" (mapconcat 'identity tags "\\|") (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$"))))) (gen-re (nth 3 org-stuck-projects)) @@ -4222,7 +4337,7 @@ of what a project is and how to check if it stuck, customize the variable (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. (defvar list-diary-entries-hook) - +(defvar diary-time-regexp) (defun org-get-entries-from-diary (date) "Get the (Emacs Calendar) diary entries for DATE." (require 'diary-lib) @@ -4253,7 +4368,14 @@ of what a project is and how to check if it stuck, customize the variable ;; Add prefix to each line and extend the text properties (if (zerop (buffer-size)) (setq entries nil) - (setq entries (buffer-substring (point-min) (- (point-max) 1))))) + (setq entries (buffer-substring (point-min) (- (point-max) 1))) + (setq entries + (with-temp-buffer + (insert entries) (goto-char (point-min)) + (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t) + (unless (save-match-data (string-match diary-time-regexp (match-string 1))) + (replace-match (concat "; " (match-string 1))))) + (buffer-string))))) (set-buffer-modified-p nil) (kill-buffer diary-fancy-buffer))) (when entries @@ -4419,7 +4541,8 @@ the documentation of `org-diary'." (while (setq arg (pop args)) (cond ((and (eq arg :todo) - (equal date (calendar-current-date))) + (equal date (calendar-gregorian-from-absolute + (org-today)))) (setq rtn (org-agenda-get-todos)) (setq results (append results rtn))) ((eq arg :timestamp) @@ -4469,13 +4592,12 @@ the documentation of `org-diary'." (catch :skip (save-match-data (beginning-of-line) + (org-agenda-skip) (setq beg (point) end (save-excursion (outline-next-heading) (point))) (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end) (goto-char (1+ beg)) (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) (throw :skip nil))) - (goto-char beg) - (org-agenda-skip) (goto-char (match-beginning 1)) (setq marker (org-agenda-new-marker (match-beginning 0)) category (org-get-category) @@ -4494,6 +4616,16 @@ the documentation of `org-diary'." (org-end-of-subtree 'invisible)))) (nreverse ee))) +(defun org-agenda-todo-custom-ignore-p (time n) + "Check whether timestamp is farther away then n number of days. +This function is invoked if `org-agenda-todo-ignore-deadlines', +`org-agenda-todo-ignore-scheduled' or +`org-agenda-todo-ignore-timestamp' is set to an integer." + (let ((days (org-days-to-time time))) + (if (>= n 0) + (>= days n) + (<= days n)))) + ;;;###autoload (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item (&optional end) @@ -4513,6 +4645,9 @@ the documentation of `org-diary'." (> (org-days-to-time (match-string 1)) 0)) ((eq org-agenda-todo-ignore-scheduled 'past) (<= (org-days-to-time (match-string 1)) 0)) + ((numberp org-agenda-todo-ignore-scheduled) + (org-agenda-todo-custom-ignore-p + (match-string 1) org-agenda-todo-ignore-scheduled)) (t))) (and org-agenda-todo-ignore-deadlines (re-search-forward org-deadline-time-regexp end t) @@ -4524,6 +4659,9 @@ 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)) + ((numberp org-agenda-todo-ignore-deadlines) + (org-agenda-todo-custom-ignore-p + (match-string 1) org-agenda-todo-ignore-deadlines)) (t (org-deadline-close (match-string 1))))) (and org-agenda-todo-ignore-timestamp (let ((buffer (current-buffer)) @@ -4546,6 +4684,9 @@ the documentation of `org-diary'." (> (org-days-to-time (match-string 1)) 0)) ((eq org-agenda-todo-ignore-timestamp 'past) (<= (org-days-to-time (match-string 1)) 0)) + ((numberp org-agenda-todo-ignore-timestamp) + (org-agenda-todo-custom-ignore-p + (match-string 1) org-agenda-todo-ignore-timestamp)) (t)))))))))) (defconst org-agenda-no-heading-message @@ -4583,18 +4724,21 @@ the documentation of `org-diary'." "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) marker hdmarker deadlinep scheduledp clockp closedp inactivep donep tmp priority category ee txt timestr tags b0 b3 e3 head - todo-state end-of-match) + todo-state end-of-match show-all) (goto-char (point-min)) (while (setq end-of-match (re-search-forward regexp nil t)) (setq b0 (match-beginning 0) - b3 (match-beginning 3) e3 (match-end 3)) + b3 (match-beginning 3) e3 (match-end 3) + todo-state (save-match-data (ignore-errors (org-get-todo-state))) + show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all))) (catch :skip (and (org-at-date-range-p) (throw :skip nil)) (org-agenda-skip) (if (and (match-end 1) (not (= d1 (org-time-string-to-absolute - (match-string 1) d1 nil - org-agenda-repeating-timestamp-show-all)))) + (match-string 1) d1 nil show-all)))) (throw :skip nil)) (if (and e3 (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date))) @@ -4611,7 +4755,6 @@ the documentation of `org-diary'." clockp (and org-agenda-include-inactive-timestamps (or (string-match org-clock-string tmp) (string-match "]-+\\'" tmp))) - todo-state (ignore-errors (org-get-todo-state)) donep (member todo-state org-done-keywords)) (if (or scheduledp deadlinep closedp clockp (and donep org-agenda-skip-timestamp-if-done)) @@ -4622,16 +4765,16 @@ the documentation of `org-diary'." (setq marker (org-agenda-new-marker b0) category (org-get-category b0)) (save-excursion - (if (not (re-search-backward "^\\*+ " nil t)) + (if (not (re-search-backward org-outline-regexp-bol nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) (setq hdmarker (org-agenda-new-marker) tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq head (match-string 1)) + (setq head (or (match-string 1) "")) (setq txt (org-format-agenda-item (if inactivep org-agenda-inactive-leader nil) - head category tags timestr nil + head category tags timestr remove-re))) (setq priority (org-get-priority txt)) (org-add-props txt props @@ -4649,8 +4792,7 @@ the documentation of `org-diary'." (defun org-agenda-get-sexps () "Return the sexp information for agenda display." (require 'diary-lib) - (let* ((props (list 'face nil - 'mouse-face 'highlight + (let* ((props (list 'mouse-face 'highlight 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) @@ -4691,19 +4833,41 @@ the documentation of `org-diary'." (push txt ee))))) (nreverse ee))) -(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) +;; Calendar sanity: define some functions that are independent of +;; `calendar-date-style'. +;; Normally I would like to use ISO format when calling the diary functions, +;; but to make sure we still have Emacs 22 compatibility we bind +;; also `european-calendar-style' and use european format +(defun org-anniversary (year month day &optional mark) + "Like `diary-anniversary', but with fixed (ISO) order of arguments." + (org-no-warnings + (let ((calendar-date-style 'european) (european-calendar-style t)) + (diary-anniversary day month year mark)))) +(defun org-cyclic (N year month day &optional mark) + "Like `diary-cyclic', but with fixed (ISO) order of arguments." + (org-no-warnings + (let ((calendar-date-style 'european) (european-calendar-style t)) + (diary-cyclic N day month year mark)))) +(defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark) + "Like `diary-block', but with fixed (ISO) order of arguments." + (org-no-warnings + (let ((calendar-date-style 'european) (european-calendar-style t)) + (diary-block D1 M1 Y1 D2 M2 Y2 mark)))) +(defun org-date (year month day &optional mark) + "Like `diary-date', but with fixed (ISO) order of arguments." + (org-no-warnings + (let ((calendar-date-style 'european) (european-calendar-style t)) + (diary-date day month year mark)))) +(defalias 'org-float 'diary-float) + +;; Define the` org-class' function +(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks) "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. -The order of the first 2 times 3 arguments depends on the variable -`calendar-date-style' or, if that is not defined, on `european-calendar-style'. -So for American calendars, give this as MONTH DAY YEAR, for European as -DAY MONTH YEAR, and for ISO as YEAR MONTH DAY. DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS is any number of ISO weeks in the block period for which the item should be skipped." - (let* ((date1 (calendar-absolute-from-gregorian - (org-order-calendar-date-args m1 d1 y1))) - (date2 (calendar-absolute-from-gregorian - (org-order-calendar-date-args m2 d2 y2))) + (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1))) + (date2 (calendar-absolute-from-gregorian (list m2 d2 y2))) (d (calendar-absolute-from-gregorian date))) (and (<= date1 d) @@ -4715,6 +4879,25 @@ be skipped." (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) entry))) +(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) + "Like `org-class', but honor `calendar-date-style'. +The order of the first 2 times 3 arguments depends on the variable +`calendar-date-style' or, if that is not defined, on `european-calendar-style'. +So for American calendars, give this as MONTH DAY YEAR, for European as +DAY MONTH YEAR, and for ISO as YEAR MONTH DAY. +DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS +is any number of ISO weeks in the block period for which the item should +be skipped. + +This function is here only for backward compatibility and it is deprecated, +please use `org-class' instead." + (let* ((date1 (org-order-calendar-date-args m1 d1 y1)) + (date2 (org-order-calendar-date-args m2 d2 y2))) + (org-class + (nth 2 date1) (car date1) (nth 1 date1) + (nth 2 date2) (car date2) (nth 1 date2) + dayname skip-weeks))) + (defalias 'org-get-closed 'org-agenda-get-progress) (defun org-agenda-get-progress () "Return the logged TODO entries for agenda display." @@ -4727,7 +4910,9 @@ be skipped." (abbreviate-file-name buffer-file-name)))) (items (if (consp org-agenda-show-log) org-agenda-show-log - org-agenda-log-mode-items)) + (if (eq org-agenda-show-log 'clockcheck) + '(clock) + org-agenda-log-mode-items))) (parts (delq nil (list @@ -4772,16 +4957,16 @@ be skipped." (setq clocked (match-string 2 rest))) (setq clocked "-"))) (save-excursion - (setq extra nil) - (cond - ((not org-agenda-log-mode-add-notes)) - (statep - (and (looking-at ".*\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") - (setq extra (match-string 1)))) - (clockp - (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") - (setq extra (match-string 1))))) - (if (not (re-search-backward "^\\*+ " nil t)) + (setq extra + (cond + ((not org-agenda-log-mode-add-notes) nil) + (statep + (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") + (match-string 1))) + (clockp + (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") + (match-string 1))))) + (if (not (re-search-backward org-outline-regexp-bol nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) (setq hdmarker (org-agenda-new-marker) @@ -4809,6 +4994,125 @@ be skipped." (goto-char (point-at-eol)))) (nreverse ee))) +(defun org-agenda-show-clocking-issues () + "Add overlays, showing issues with clocking. +See also the user option `org-agenda-clock-consistency-checks'." + (interactive) + (let* ((pl org-agenda-clock-consistency-checks) + (re (concat "^[ \t]*" + org-clock-string + "[ \t]+" + "\\(\\[.*?\\]\\)" ; group 1 is first stamp + "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second + (tlstart 0.) + (tlend 0.) + (maxtime (org-hh:mm-string-to-minutes + (or (plist-get pl :max-duration) "24:00"))) + (mintime (org-hh:mm-string-to-minutes + (or (plist-get pl :min-duration) 0))) + (maxgap (org-hh:mm-string-to-minutes + ;; default 30:00 means never complain + (or (plist-get pl :max-gap) "30:00"))) + (gapok (mapcar 'org-hh:mm-string-to-minutes + (plist-get pl :gap-ok-around))) + (def-face (or (plist-get pl :default-face) + '((:background "DarkRed") (:foreground "white")))) + issue face m te ts dt ov) + (goto-char (point-min)) + (while (re-search-forward " Clocked: +(-\\|\\([0-9]+:[0-9]+\\))" nil t) + (setq issue nil face def-face) + (catch 'next + (setq m (org-get-at-bol 'org-marker) + te nil ts nil) + (unless (and m (markerp m)) + (setq issue "No valid clock line") (throw 'next t)) + (org-with-point-at m + (save-excursion + (goto-char (point-at-bol)) + (unless (looking-at re) + (error "No valid Clock line") + (throw 'next t)) + (unless (match-end 3) + (setq issue "No end time" + face (or (plist-get pl :no-end-time-face) face)) + (throw 'next t)) + (setq ts (match-string 1) + te (match-string 3) + ts (org-float-time + (apply 'encode-time (org-parse-time-string ts))) + te (org-float-time + (apply 'encode-time (org-parse-time-string te))) + dt (- te ts)))) + (cond + ((> dt (* 60 maxtime)) + ;; a very long clocking chunk + (setq issue (format "Clocking interval is very long: %s" + (org-minutes-to-hh:mm-string + (floor (/ (float dt) 60.)))) + face (or (plist-get pl :long-face) face))) + ((< dt (* 60 mintime)) + ;; a very short clocking chunk + (setq issue (format "Clocking interval is very short: %s" + (org-minutes-to-hh:mm-string + (floor (/ (float dt) 60.)))) + face (or (plist-get pl :short-face) face))) + ((and (> tlend 0) (< ts tlend)) + ;; Two clock entries are overlapping + (setq issue (format "Clocking overlap: %d minutes" + (/ (- tlend ts) 60)) + face (or (plist-get pl :overlap-face) face))) + ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap)))) + ;; There is a gap, lets see if we need to report it + (unless (org-agenda-check-clock-gap tlend ts gapok) + (setq issue (format "Clocking gap: %d minutes" + (/ (- ts tlend) 60)) + face (or (plist-get pl :gap-face) face)))) + (t nil))) + (setq tlend (or te tlend) tlstart (or ts tlstart)) + (when issue + ;; OK, there was some issue, add an overlay to show the issue + (setq ov (make-overlay (point-at-bol) (point-at-eol))) + (overlay-put ov 'before-string + (concat + (org-add-props + (format "%-43s" (concat " " issue)) + nil + 'face face) + "\n")) + (overlay-put ov 'evaporate t))))) + +(defun org-agenda-check-clock-gap (t1 t2 ok-list) + "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values." + (catch 'exit + (unless ok-list + ;; there are no OK times for gaps... + (throw 'exit nil)) + (if (> (- (/ t2 36000) (/ t1 36000)) 24) + ;; This is more than 24 hours, so it is OK. + ;; because we have at least one OK time, that must be in the + ;; 24 hour interval. + (throw 'exit t)) + ;; We have a shorter gap. + ;; Now we have to get the minute of the day when these times are + (let* ((t1dec (decode-time (seconds-to-time t1))) + (t2dec (decode-time (seconds-to-time t2))) + ;; compute the minute on the day + (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec)))) + (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec))))) + (when (< min2 min1) + ;; if min2 is smaller than min1, this means it is on the next day. + ;; Wrap it to after midnight. + (setq min2 (+ min2 1440))) + ;; Now check if any of the OK times is in the gap + (mapc (lambda (x) + ;; Wrap the time to after midnight if necessary + (if (< x min1) (setq x (+ x 1440))) + ;; Check if in interval + (and (<= min1 x) (>= min2 x) (throw 'exit t))) + ok-list) + ;; Nope, this gap is not OK + nil))) + (defun org-agenda-get-deadlines () "Return the deadline information for agenda display." (let* ((props (list 'mouse-face 'highlight @@ -4823,7 +5127,7 @@ be skipped." (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar d2 diff dfrac wdays pos pos1 category tags suppress-prewarning - ee txt head face s todo-state upcomingp donep timestr) + ee txt head face s todo-state show-all upcomingp donep timestr) (goto-char (point-min)) (while (re-search-forward regexp nil t) (setq suppress-prewarning nil) @@ -4841,9 +5145,12 @@ be skipped." (setq s (match-string 1) txt nil pos (1- (match-beginning 1)) + todo-state (save-match-data (org-get-todo-state)) + show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all)) d2 (org-time-string-to-absolute - (match-string 1) d1 'past - org-agenda-repeating-timestamp-show-all) + (match-string 1) d1 'past show-all) diff (- d2 d1) wdays (if suppress-prewarning (let ((org-deadline-warning-days suppress-prewarning)) @@ -4858,7 +5165,7 @@ be skipped." (and todayp (not org-agenda-only-exact-dates))) (= diff 0))) (save-excursion - (setq todo-state (org-get-todo-state)) + ;; (setq todo-state (org-get-todo-state)) (setq donep (member todo-state org-done-keywords)) (if (and donep (or org-agenda-skip-deadline-if-done @@ -4935,7 +5242,7 @@ FRACTION is what fraction of the head-warning time has passed." (cons (marker-position mm) a))) deadline-results)) d2 diff pos pos1 category tags donep - ee txt head pastschedp todo-state face timestr s habitp) + ee txt head pastschedp todo-state face timestr s habitp show-all) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -4943,9 +5250,12 @@ FRACTION is what fraction of the head-warning time has passed." (setq s (match-string 1) txt nil pos (1- (match-beginning 1)) + todo-state (save-match-data (org-get-todo-state)) + show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all)) d2 (org-time-string-to-absolute - (match-string 1) d1 'past - org-agenda-repeating-timestamp-show-all) + (match-string 1) d1 'past show-all) diff (- d2 d1)) (setq pastschedp (and todayp (< diff 0))) ;; When to show a scheduled item in the calendar: @@ -4955,14 +5265,15 @@ FRACTION is what fraction of the head-warning time has passed." (and todayp (not org-agenda-only-exact-dates))) (= diff 0)) (save-excursion - (setq todo-state (org-get-todo-state)) (setq donep (member todo-state org-done-keywords)) - (setq habitp (and (functionp 'org-is-habit-p) - (org-is-habit-p))) (if (and donep - (or habitp org-agenda-skip-scheduled-if-done - (not (= diff 0)))) + (or org-agenda-skip-scheduled-if-done + (not (= diff 0)) + (and (functionp 'org-is-habit-p) + (org-is-habit-p)))) (setq txt nil) + (setq habitp (and (functionp 'org-is-habit-p) + (org-is-habit-p))) (setq category (org-get-category)) (if (not (re-search-backward "^\\*+[ \t]+" nil t)) (setq txt org-agenda-no-heading-message) @@ -4994,7 +5305,7 @@ FRACTION is what fraction of the head-warning time has passed." (- 1 diff))) head category tags (if (not (= diff 0)) nil timestr) - nil nil habitp)))) + nil habitp)))) (when txt (setq face (cond @@ -5031,55 +5342,61 @@ FRACTION is what fraction of the head-warning time has passed." (abbreviate-file-name buffer-file-name)))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) - marker hdmarker ee txt d1 d2 s1 s2 timestr category todo-state tags pos + marker hdmarker ee txt d1 d2 s1 s2 category todo-state tags pos head donep) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip (org-agenda-skip) (setq pos (point)) - (setq timestr (match-string 0) - s1 (match-string 1) - s2 (match-string 2) - d1 (time-to-days (org-time-string-to-time s1)) - d2 (time-to-days (org-time-string-to-time s2))) - (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) - ;; Only allow days between the limits, because the normal - ;; date stamps will catch the limits. - (save-excursion - (setq todo-state (org-get-todo-state)) - (setq donep (member todo-state org-done-keywords)) - (if (and donep org-agenda-skip-timestamp-if-done) - (throw :skip t)) - (setq marker (org-agenda-new-marker (point))) - (setq category (org-get-category)) - (if (not (re-search-backward "^\\*+ " nil t)) - (setq txt org-agenda-no-heading-message) - (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker (point))) - (setq tags (org-get-tags-at)) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq head (match-string 1)) - (let ((remove-re - (if org-agenda-remove-timeranges-from-blocks - (concat - "<" (regexp-quote s1) ".*?>" - "--" - "<" (regexp-quote s2) ".*?>") - nil))) - (setq txt (org-format-agenda-item - (format - (nth (if (= d1 d2) 0 1) - org-agenda-timerange-leaders) - (1+ (- d0 d1)) (1+ (- d2 d1))) - head category tags - timestr nil remove-re)))) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker - 'type "block" 'date date - 'todo-state todo-state - 'priority (org-get-priority txt) 'org-category category) - (push txt ee))) + (let ((start-time (match-string 1)) + (end-time (match-string 2))) + (setq s1 (match-string 1) + s2 (match-string 2) + d1 (time-to-days (org-time-string-to-time s1)) + d2 (time-to-days (org-time-string-to-time s2))) + (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) + ;; Only allow days between the limits, because the normal + ;; date stamps will catch the limits. + (save-excursion + (setq todo-state (org-get-todo-state)) + (setq donep (member todo-state org-done-keywords)) + (if (and donep org-agenda-skip-timestamp-if-done) + (throw :skip t)) + (setq marker (org-agenda-new-marker (point))) + (setq category (org-get-category)) + (if (not (re-search-backward org-outline-regexp-bol nil t)) + (setq txt org-agenda-no-heading-message) + (goto-char (match-beginning 0)) + (setq hdmarker (org-agenda-new-marker (point))) + (setq tags (org-get-tags-at)) + (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (setq head (match-string 1)) + (let ((remove-re + (if org-agenda-remove-timeranges-from-blocks + (concat + "<" (regexp-quote s1) ".*?>" + "--" + "<" (regexp-quote s2) ".*?>") + nil))) + (setq txt (org-format-agenda-item + (format + (nth (if (= d1 d2) 0 1) + org-agenda-timerange-leaders) + (1+ (- d0 d1)) (1+ (- d2 d1))) + head category tags + (cond ((= d1 d0) + (concat "<" start-time ">")) + ((= d2 d0) + (concat "<" end-time ">")) + (t nil)) + remove-re)))) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker + 'type "block" 'date date + 'todo-state todo-state + 'priority (org-get-priority txt) 'org-category category) + (push txt ee)))) (goto-char pos))) ;; Sort the entries by expiration date. (nreverse ee))) @@ -5109,7 +5426,7 @@ The flag is set if the currently compiled format contains a `%e'.") (return (apply 'create-image (cdr entry))))))) (defun org-format-agenda-item (extra txt &optional category tags dotime - noprefix remove-re habitp) + remove-re habitp) "Format TXT to be inserted into the agenda buffer. In particular, it adds the prefix and corresponding text properties. EXTRA must be a string and replaces the `%s' specifier in the prefix format. @@ -5118,9 +5435,7 @@ category taken from local variable or file name. It will replace the `%c' specifier in the format. DOTIME, when non-nil, indicates that a time-of-day should be extracted from TXT for sorting of this entry, and for the `%t' specifier in the format. When DOTIME is a string, this string is -searched for a time before TXT is. NOPREFIX is a flag and indicates that -only the correctly processes TXT should be returned - this is used by -`org-agenda-change-all-lines'. TAGS can be the tags of the headline. +searched for a time before TXT is. TAGS can be the tags of the headline. Any match of REMOVE-RE will be removed from TXT." (save-match-data ;; Diary entries sometimes have extra whitespace at the beginning @@ -5150,7 +5465,7 @@ Any match of REMOVE-RE will be removed from TXT." (if (stringp dotime) dotime "") (and org-agenda-search-headline-for-time txt)))) (time-of-day (and dotime (org-get-time-of-day ts))) - stamp plain s0 s1 s2 t1 t2 rtn srp l + stamp plain s0 s1 s2 rtn srp l duration thecategory) (and (org-mode-p) buffer-file-name (add-to-list 'org-agenda-contributing-files buffer-file-name)) @@ -5177,26 +5492,17 @@ Any match of REMOVE-RE will be removed from TXT." ;; Normalize the time(s) to 24 hour (if s1 (setq s1 (org-get-time-of-day s1 'string t))) (if s2 (setq s2 (org-get-time-of-day s2 'string t))) + + ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set + (when (and s1 (not s2) org-agenda-default-appointment-duration) + (setq s2 + (org-minutes-to-hh:mm-string + (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration)))) + ;; Compute the duration - (when s1 - (setq t1 (+ (* 60 (string-to-number (substring s1 0 2))) - (string-to-number (substring s1 3))) - t2 (cond - (s2 (+ (* 60 (string-to-number (substring s2 0 2))) - (string-to-number (substring s2 3)))) - (org-agenda-default-appointment-duration - (+ t1 org-agenda-default-appointment-duration)) - (t nil))) - (setq duration (if t2 (- t2 t1))))) - - (when (and s1 (not s2) org-agenda-default-appointment-duration - (string-match "\\([0-9]+\\):\\([0-9]+\\)" s1)) - (let ((m (+ (string-to-number (match-string 2 s1)) - (* 60 (string-to-number (match-string 1 s1))) - org-agenda-default-appointment-duration)) - h) - (setq h (/ m 60) m (- m (* h 60))) - (setq s2 (format "%02d:%02d" h m)))) + (when s2 + (setq duration (- (org-hh:mm-string-to-minutes s2) + (org-hh:mm-string-to-minutes s1))))) (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) @@ -5217,45 +5523,48 @@ Any match of REMOVE-RE will be removed from TXT." (get-text-property 0 'org-marker txt))) (error nil))) (when effort - (setq neffort (org-hh:mm-string-to-minutes effort) - effort (setq effort (concat "[" effort "]" ))))) + (setq neffort (org-duration-string-to-minutes effort) + effort (setq effort (concat "[" effort "]"))))) + ;; prevent erroring out with %e format when there is no effort + (or effort (setq effort "")) (when remove-re (while (string-match remove-re txt) (setq txt (replace-match "" t t txt)))) - ;; Create the final string - (if noprefix - (setq rtn txt) - ;; Prepare the variables needed in the eval of the compiled format - (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) - thecategory (copy-sequence category)) - (if (string-match org-bracket-link-regexp category) - (progn - (setq l (if (match-end 3) - (- (match-end 3) (match-beginning 3)) - (- (match-end 1) (match-beginning 1)))) - (when (< l (or org-prefix-category-length 0)) - (setq category (copy-sequence category)) - (org-add-props category nil - 'extra-space (make-string - (- org-prefix-category-length l 1) ?\ )))) - (if (and org-prefix-category-max-length - (>= (length category) org-prefix-category-max-length)) - (setq category (substring category 0 (1- org-prefix-category-max-length))))) - ;; Evaluate the compiled format - (setq rtn (concat (eval org-prefix-format-compiled) txt))) + ;; Set org-heading property on `txt' to mark the start of the + ;; heading. + (add-text-properties 0 (length txt) '(org-heading t) txt) + + ;; Prepare the variables needed in the eval of the compiled format + (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) + thecategory (copy-sequence category)) + (if (string-match org-bracket-link-regexp category) + (progn + (setq l (if (match-end 3) + (- (match-end 3) (match-beginning 3)) + (- (match-end 1) (match-beginning 1)))) + (when (< l (or org-prefix-category-length 0)) + (setq category (copy-sequence category)) + (org-add-props category nil + 'extra-space (make-string + (- org-prefix-category-length l 1) ?\ )))) + (if (and org-prefix-category-max-length + (>= (length category) org-prefix-category-max-length)) + (setq category (substring category 0 (1- org-prefix-category-max-length))))) + ;; Evaluate the compiled format + (setq rtn (concat (eval org-prefix-format-compiled) txt)) ;; And finally add the text properties (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) @@ -5264,7 +5573,6 @@ Any match of REMOVE-RE will be removed from TXT." 'tags (mapcar 'org-downcase-keep-props tags) 'org-highest-priority org-highest-priority 'org-lowest-priority org-lowest-priority - 'prefix-length (- (length rtn) (length txt)) 'time-of-day time-of-day 'duration duration 'effort effort @@ -5272,6 +5580,7 @@ Any match of REMOVE-RE will be removed from TXT." 'txt txt 'time time 'extra extra + 'format org-prefix-format-compiled 'dotime dotime)))) (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) @@ -5342,6 +5651,16 @@ The modified list may contain inherited tags, and tags matched by new) (put-text-property 2 (length (car new)) 'face 'org-time-grid (car new)))) + (when (and todayp org-agenda-show-current-time-in-grid) + (push (org-format-agenda-item + nil + org-agenda-current-time-string + "" nil + (format-time-string "%H:%M ")) + new) + (put-text-property + 2 (length (car new)) 'face 'org-agenda-current-time (car new))) + (if (member 'time-up org-agenda-sorting-strategy-selected) (append new list) (append list new))))) @@ -5360,11 +5679,12 @@ 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.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctsei]\\)" + (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctsei]\\|(.+)\\)" s start) - (setq var (cdr (assoc (match-string 4 s) - '(("c" . category) ("t" . time) ("s" . extra) - ("i" . category-icon) ("T" . tag) ("e" . effort)))) + (setq var (or (cdr (assoc (match-string 4 s) + '(("c" . category) ("t" . time) ("s" . extra) + ("i" . category-icon) ("T" . tag) ("e" . effort)))) + 'eval) c (or (match-string 3 s) "") opt (match-beginning 1) start (1+ (match-beginning 0))) @@ -5380,12 +5700,14 @@ The resulting form is returned and stored in the variable (save-match-data (if (string-match "\\.[0-9]+" x) (string-to-number (substring (match-string 0 x) 1))))))) - (if opt - (setq varform - `(if (equal "" ,var) - "" - (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) - (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var)))))) + (if (eq var 'eval) + (setq varform `(format ,f (org-eval ,(read (match-string 4 s))))) + (if opt + (setq varform + `(if (equal "" ,var) + "" + (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) + (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) (setq s (replace-match "%s" t nil s)) (push varform vars)) (setq vars (nreverse vars)) @@ -5460,12 +5782,12 @@ could bind the variable in the options section of a custom command.") (defun org-agenda-highlight-todo (x) (let ((org-done-keywords org-done-keywords-for-agenda) (case-fold-search nil) - re pl) + re) (if (eq x 'line) (save-excursion (beginning-of-line 1) (setq re (org-get-at-bol 'org-todo-regexp)) - (goto-char (+ (point) (or (org-get-at-bol 'prefix-length) 0))) + (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point))) (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) (add-text-properties (match-beginning 0) (match-end 1) (list 'face (org-get-todo-face 1))) @@ -5473,21 +5795,21 @@ could bind the variable in the options section of a custom command.") (delete-region (match-beginning 1) (1- (match-end 0))) (goto-char (match-beginning 1)) (insert (format org-agenda-todo-keyword-format s))))) - (setq re (concat (get-text-property 0 'org-todo-regexp x)) - pl (get-text-property 0 'prefix-length x)) - (when (and re - (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") - x (or pl 0)) pl)) - (add-text-properties - (or (match-end 1) (match-end 0)) (match-end 0) - (list 'face (org-get-todo-face (match-string 2 x))) + (let ((pl (text-property-any 0 (length x) 'org-heading t x))) + (setq re (get-text-property 0 'org-todo-regexp x)) + (when (and re + (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") + x (or pl 0)) pl)) + (add-text-properties + (or (match-end 1) (match-end 0)) (match-end 0) + (list 'face (org-get-todo-face (match-string 2 x))) x) - (when (match-end 1) - (setq x (concat (substring x 0 (match-end 1)) - (format org-agenda-todo-keyword-format - (match-string 2 x)) + (when (match-end 1) + (setq x (concat (substring x 0 (match-end 1)) + (format org-agenda-todo-keyword-format + (match-string 2 x)) (org-add-props " " (text-properties-at 0 x)) - (substring x (match-end 3)))))) + (substring x (match-end 3))))))) x))) (defsubst org-cmp-priority (a b) @@ -5540,8 +5862,8 @@ could bind the variable in the options section of a custom command.") (defsubst org-cmp-alpha (a b) "Compare the headlines, alphabetically." - (let* ((pla (get-text-property 0 'prefix-length a)) - (plb (get-text-property 0 'prefix-length b)) + (let* ((pla (text-property-any 0 (length a) 'org-heading t a)) + (plb (text-property-any 0 (length b) 'org-heading t b)) (ta (and pla (substring a pla))) (tb (and plb (substring b plb)))) (when pla @@ -5778,7 +6100,7 @@ When this is the global TODO list, a prefix argument will be interpreted." (message "Rebuilding agenda buffer...done") (put 'org-agenda-filter :preset-filter preset) (and (or filter preset) (org-agenda-filter-apply filter)) - (and cols (interactive-p) (org-agenda-columns)) + (and cols (org-called-interactively-p 'any) (org-agenda-columns)) (org-goto-line line) (recenter window-line))) @@ -5803,12 +6125,13 @@ to switch to narrowing." (efforts (org-split-string (or (cdr (assoc (concat org-effort-property "_ALL") org-global-properties)) - "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00" ""))) + "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00" + ""))) (effort-op org-agenda-filter-effort-default-operator) (effort-prompt "") (inhibit-read-only t) (current org-agenda-filter) - a n tag) + maybe-refresh a n tag) (unless char (message "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: " @@ -5854,11 +6177,13 @@ to switch to narrowing." (if modifier (push modifier org-agenda-filter)))) (if (not (null org-agenda-filter)) - (org-agenda-filter-apply org-agenda-filter)))) + (org-agenda-filter-apply org-agenda-filter))) + (setq maybe-refresh t)) ((equal char ?/) (org-agenda-filter-by-tag-show-all) (when (get 'org-agenda-filter :preset-filter) - (org-agenda-filter-apply org-agenda-filter))) + (org-agenda-filter-apply org-agenda-filter)) + (setq maybe-refresh t)) ((or (equal char ?\ ) (setq a (rassoc char alist)) (and (>= char ?0) (<= char ?9) @@ -5874,8 +6199,12 @@ to switch to narrowing." (setq org-agenda-filter (cons (concat (if strip "-" "+") tag) (if narrow current nil))) - (org-agenda-filter-apply org-agenda-filter)) - (t (error "Invalid tag selection character %c" char))))) + (org-agenda-filter-apply org-agenda-filter) + (setq maybe-refresh t)) + (t (error "Invalid tag selection character %c" char))) + (when (or maybe-refresh + (eq org-agenda-clockreport-mode 'with-filter)) + (org-agenda-redo)))) (defun org-agenda-get-represented-tags () "Get a list of all tags currently represented in the agenda." @@ -5919,7 +6248,7 @@ E looks like \"+<2:25\"." ((equal op ??) op) (t '=))) (list 'org-agenda-compare-effort (list 'quote op) - (org-hh:mm-string-to-minutes e)))) + (org-duration-string-to-minutes e)))) (defun org-agenda-compare-effort (op value) "Compare the effort of the current line with VALUE, using OP. @@ -6038,7 +6367,7 @@ Negative selection means regexp must not match for selection of an entry." (tdpos (goto-char tdpos)) ((eq org-agenda-type 'agenda) (let* ((sd (org-agenda-compute-starting-span - (org-today) (or org-agenda-ndays org-agenda-span))) + (org-today) (or org-agenda-current-span org-agenda-ndays org-agenda-span))) (org-agenda-overriding-arguments org-agenda-last-arguments)) (setf (nth 1 org-agenda-overriding-arguments) sd) (org-agenda-redo) @@ -6091,17 +6420,20 @@ With prefix ARG, go backward that many times the current span." (defun org-agenda-view-mode-dispatch () "Call one of the view mode commands." (interactive) - (message "View: [d]ay [w]eek [m]onth [y]ear [q]uit/abort - time[G]rid [[]inactive [f]ollow [l]og [L]og-all [E]ntryText - [a]rch-trees [A]rch-files clock[R]eport include[D]iary") + (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort + time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck + [a]rch-trees [A]rch-files clock[R]eport include[D]iary + [E]ntryText") (let ((a (read-char-exclusive))) (case a + (?\ (call-interactively 'org-agenda-reset-view)) (?d (call-interactively 'org-agenda-day-view)) (?w (call-interactively 'org-agenda-week-view)) (?m (call-interactively 'org-agenda-month-view)) (?y (call-interactively 'org-agenda-year-view)) (?l (call-interactively 'org-agenda-log-mode)) (?L (org-agenda-log-mode '(4))) + (?c (org-agenda-log-mode 'clockcheck)) ((?F ?f) (call-interactively 'org-agenda-follow-mode)) (?a (call-interactively 'org-agenda-archives-mode)) (?A (org-agenda-archives-mode 'files)) @@ -6117,6 +6449,10 @@ With prefix ARG, go backward that many times the current span." (?q (message "Abort")) (otherwise (error "Invalid key" ))))) +(defun org-agenda-reset-view () + "Switch to default view for agenda." + (interactive) + (org-agenda-change-time-span (or org-agenda-ndays org-agenda-span))) (defun org-agenda-day-view (&optional day-of-year) "Switch to daily view for agenda. With argument DAY-OF-YEAR, switch to that day of the year." @@ -6160,7 +6496,8 @@ SPAN may be `day', `week', `month', `year'." org-starting-day)) (sd (org-agenda-compute-starting-span sd span n)) (org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) sd span t))) + (or org-agenda-overriding-arguments + (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) @@ -6300,10 +6637,13 @@ With a double `C-u' prefix arg, show *only* log items, nothing else." (interactive "P") (org-agenda-check-type t 'agenda 'timeline) (setq org-agenda-show-log - (if (equal special '(16)) - 'only - (if special '(closed clock state) - (not org-agenda-show-log)))) + (cond + ((equal special '(16)) 'only) + ((eq special 'clockcheck) + (if (eq org-agenda-show-log 'clockcheck) + nil 'clockcheck)) + (special '(closed clock state)) + (t (not org-agenda-show-log)))) (org-agenda-set-mode-name) (org-agenda-redo) (message "Log mode is %s" @@ -6372,8 +6712,11 @@ When called with a prefix argument, include all archive files as well." (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" "")) + (cond + ((consp org-agenda-show-log) " LogAll") + ((eq org-agenda-show-log 'clockcheck) " ClkCk") + (org-agenda-show-log " Log") + (t "")) (if (or org-agenda-filter (get 'org-agenda-filter :preset-filter)) (concat " {" (mapconcat @@ -6452,7 +6795,9 @@ and by additional input from the age of a schedules or deadline entry." (org-show-context 'agenda) (save-excursion (and (outline-next-heading) - (org-flag-heading nil)))) ; show the next heading + (org-flag-heading nil)))) ; show the next heading + (when (outline-invisible-p) + (show-entry)) ; display invisible text (recenter (/ (window-height) 2)) (run-hooks 'org-agenda-after-show-hook) (and highlight (org-highlight (point-at-bol) (point-at-eol))))) @@ -6574,7 +6919,7 @@ If this information is not given, the function uses the tree at point." (pos (marker-position marker)) (rfloc (or rfloc (org-refile-get-location - (if goto "Goto: " "Refile to: ") buffer + (if goto "Goto" "Refile to") buffer org-refile-allow-creating-parent-nodes)))) (with-current-buffer buffer (save-excursion @@ -6594,9 +6939,7 @@ at the text of the entry itself." (org-get-at-bol 'org-marker))) (buffer (and marker (marker-buffer marker))) (prefix (buffer-substring - (point-at-bol) - (+ (point-at-bol) - (or (org-get-at-bol 'prefix-length) 0))))) + (point-at-bol) (point-at-eol)))) (cond (buffer (with-current-buffer buffer @@ -6630,7 +6973,7 @@ at the text of the entry itself." (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker))) - (switch-to-buffer buffer) + (org-pop-to-buffer-same-window buffer) (and delete-other-windows (delete-other-windows)) (widen) (goto-char pos) @@ -6638,7 +6981,9 @@ at the text of the entry itself." (org-show-context 'agenda) (save-excursion (and (outline-next-heading) - (org-flag-heading nil))))))) ; show the next heading + (org-flag-heading nil))) ; show the next heading + (when (outline-invisible-p) + (show-entry)))))) ; display invisible text (defun org-agenda-goto-mouse (ev) "Go to the Org-mode file which contains the item at the mouse click." @@ -6706,7 +7051,7 @@ if it was hidden in the outline." (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'folded)) (message "Remote: FOLDED")) - ((and (interactive-p) (= more 1)) + ((and (org-called-interactively-p 'any) (= more 1)) (message "Remote: show with default settings")) ((= more 2) (show-entry) @@ -6910,15 +7255,22 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." dotime (org-get-at-bol 'dotime) cat (org-get-at-bol 'org-category) tags thetags - new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix) - pl (org-get-at-bol 'prefix-length) + new + (let ((org-prefix-format-compiled + (or (get-text-property (point) 'format) + org-prefix-format-compiled))) + (with-current-buffer (marker-buffer hdmarker) + (save-excursion + (save-restriction + (widen) + (org-format-agenda-item (org-get-at-bol 'extra) + newhead cat tags dotime))))) + pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) undone-face (org-get-at-bol 'undone-face) done-face (org-get-at-bol 'done-face)) - (goto-char (+ (point) pl)) - ;; (org-move-to-column pl) FIXME: does the above line work correctly? + (beginning-of-line 1) (cond ((equal new "") - (beginning-of-line 1) (and (looking-at ".*\n?") (replace-match ""))) ((looking-at ".*") (replace-match new t t) @@ -7008,9 +7360,8 @@ the same tree node, and the headline of the tree node in the Org-mode file." "Set tags for the current headline." (interactive) (org-agenda-check-no-diary) - (if (and (org-region-active-p) (interactive-p)) + (if (and (org-region-active-p) (org-called-interactively-p 'any)) (call-interactively 'org-change-tag-in-region) - (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) (org-agenda-error))) (buffer (marker-buffer hdmarker)) @@ -7039,7 +7390,6 @@ the same tree node, and the headline of the tree node in the Org-mode file." "Set a property for the current headline." (interactive) (org-agenda-check-no-diary) - (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) (org-agenda-error))) (buffer (marker-buffer hdmarker)) @@ -7062,7 +7412,6 @@ the same tree node, and the headline of the tree node in the Org-mode file." "Set the effort property for the current headline." (interactive) (org-agenda-check-no-diary) - (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) (org-agenda-error))) (buffer (marker-buffer hdmarker)) @@ -7077,16 +7426,17 @@ the same tree node, and the headline of the tree node in the Org-mode file." (org-show-context 'agenda)) (save-excursion (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading + (org-flag-heading nil))) ; show the next heading (goto-char pos) (call-interactively 'org-set-effort) - (end-of-line 1))))) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker)))) (defun org-agenda-toggle-archive-tag () "Toggle the archive tag for the current entry." (interactive) (org-agenda-check-no-diary) - (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) (org-agenda-error))) (buffer (marker-buffer hdmarker)) @@ -7140,7 +7490,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (org-agenda-date-earlier (prefix-numeric-value arg))))) (defun org-agenda-date-later (arg &optional what) - "Change the date of this item to one day later." + "Change the date of this item to ARG day(s) later." (interactive "p") (org-agenda-check-type t 'agenda 'timeline) (org-agenda-check-no-diary) @@ -7159,7 +7509,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (message "Time stamp changed to %s" org-last-changed-timestamp))) (defun org-agenda-date-earlier (arg &optional what) - "Change the date of this item to one day earlier." + "Change the date of this item to ARG day(s) earlier." (interactive "p") (org-agenda-date-later (- arg) what)) @@ -7233,9 +7583,9 @@ be used to request time specification in the time stamp." (org-agenda-show-new-time marker org-last-changed-timestamp)) (message "Time stamp changed to %s" org-last-changed-timestamp))) -(defun org-agenda-schedule (arg) +(defun org-agenda-schedule (arg &optional time) "Schedule the item at point. -Arg is passed through to `org-schedule'." +ARG is passed through to `org-schedule'." (interactive "P") (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) (org-agenda-check-no-diary) @@ -7251,13 +7601,13 @@ Arg is passed through to `org-schedule'." (with-current-buffer buffer (widen) (goto-char pos) - (setq ts (org-schedule arg))) + (setq ts (org-schedule arg time))) (org-agenda-show-new-time marker ts "S")) (message "Item scheduled for %s" ts))) -(defun org-agenda-deadline (arg) +(defun org-agenda-deadline (arg &optional time) "Schedule the item at point. -Arg is passed through to `org-deadline'." +ARG is passed through to `org-deadline'." (interactive "P") (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) (org-agenda-check-no-diary) @@ -7271,7 +7621,7 @@ Arg is passed through to `org-deadline'." (with-current-buffer buffer (widen) (goto-char pos) - (setq ts (org-deadline arg))) + (setq ts (org-deadline arg time))) (org-agenda-show-new-time marker ts "D")) (message "Deadline for this item set to %s" ts))) @@ -7489,17 +7839,8 @@ the resulting entry will not be shown. When TEXT is empty, switch to (org-back-over-empty-lines) (backward-char 1) (insert "\n") - (require 'diary-lib) - (let ((calendar-date-display-form - (if (if (boundp 'calendar-date-style) - (eq calendar-date-style 'european) - (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1 - (org-bound-and-true-p european-calendar-style))) ; Emacs 22 - '(day " " month " " year) - '(month " " day " " year)))) - - (insert (format "%%%%(diary-anniversary %s) %s" - (calendar-date-string d1 nil t) text)))) + (insert (format "%%%%(org-anniversary %d %2d %2d) %s" + (nth 2 d1) (car d1) (nth 1 d1) text))) ((eq type 'day) (let ((org-prefix-has-time t) (org-agenda-time-leading-zero t) @@ -7761,6 +8102,20 @@ This is a command that has to be installed in `calendar-mode-map'." (message "%d entries marked for bulk action" (length org-agenda-bulk-marked-entries)))))) +(defun org-agenda-bulk-mark-regexp (regexp) + "Mark entries match REGEXP." + (interactive "sMark entries matching regexp: ") + (let (entries-marked) + (save-excursion + (goto-char (point-min)) + (goto-char (next-single-property-change (point) 'txt)) + (while (re-search-forward regexp nil t) + (when (string-match regexp (get-text-property (point) 'txt)) + (setq entries-marked (+ entries-marked 1)) + (call-interactively 'org-agenda-bulk-mark)))) + (if (not entries-marked) + (message "No entry matching this regexp.")))) + (defun org-agenda-bulk-unmark () "Unmark the entry at point for future bulk action." (interactive) @@ -7807,9 +8162,25 @@ This will remove the markers, and the overlays." "Execute an remote-editing action on all marked entries. The prefix arg is passed through to the command if possible." (interactive "P") - (unless org-agenda-bulk-marked-entries - (error "No entries are marked")) - (message "Bulk: [r]efile [$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [S]catter [d]eadline") + ;; Make sure we have markers, and only valid ones + (unless org-agenda-bulk-marked-entries (error "No entries are marked")) + (mapc + (lambda (m) + (unless (and (markerp m) + (marker-buffer m) + (buffer-live-p (marker-buffer m)) + (marker-position m)) + (error "Marker %s for bulk command is invalid" m))) + org-agenda-bulk-marked-entries) + + ;; Prompt for the bulk command + (message (concat "Bulk: [r]efile [$]arch [A]rch->sib [t]odo" + " [+/-]tag [s]chd [S]catter [d]eadline [f]unction" + (when org-agenda-bulk-custom-functions + (concat " Custom: [" + (mapconcat (lambda(f) (char-to-string (car f))) + org-agenda-bulk-custom-functions "") + "]")))) (let* ((action (read-char-exclusive)) (org-log-refile (if org-log-refile 'time nil)) (entries (reverse org-agenda-bulk-marked-entries)) @@ -7824,7 +8195,7 @@ The prefix arg is passed through to the command if possible." ((member action '(?r ?w)) (setq rfloc (org-refile-get-location - "Refile to: " + "Refile to" (marker-buffer (car org-agenda-bulk-marked-entries)) org-refile-allow-creating-parent-nodes)) (if (nth 3 rfloc) @@ -7872,27 +8243,45 @@ The prefix arg is passed through to the command if possible." (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) + ((equal action ?S) + (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) + (error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type) + (let ((days (read-number + (format "Scatter tasks across how many %sdays: " + (if arg "week" "")) 7))) + (setq cmd + `(let ((distance (1+ (random ,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))) - (incf day-of-week) - (if (= day-of-week 7) - (setq day-of-week 0))))) - (org-agenda-date-later distance))))) + (setq day-of-week 0))))) + ;; silently fail when try to replan a sexp entry + (condition-case nil + (let* ((date (calendar-gregorian-from-absolute + (+ (org-today) distance))) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) + (nth 2 date)))) + (org-agenda-schedule nil time)) + (error nil))))))) + + ((assoc action org-agenda-bulk-custom-functions) + (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions))) + redo-at-end t)) + + ((equal action ?f) + (setq cmd (list (intern + (org-icompleting-read "Function: " + obarray 'fboundp t nil nil))))) (t (error "Invalid bulk action"))) @@ -8057,5 +8446,6 @@ belonging to the \"Work\" category." (provide 'org-agenda) +;; arch-tag: 77f7565d-7c4b-44af-a2df-9f6f7070cff1 ;;; org-agenda.el ends here diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index 4a934517cfe..6c46b511786 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -1,11 +1,12 @@ ;;; org-archive.el --- Archiving for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -70,6 +71,14 @@ This variable is obsolete and has no effect anymore, instead add or remove :group 'org-archive :type 'boolean) +(defcustom org-archive-subtree-add-inherited-tags 'infile + "Non-nil means append inherited tags when archiving a subtree." + :group 'org-archive + :type '(choice + (const :tag "Never" nil) + (const :tag "When archiving a subtree to the same file" infile) + (const :tag "Always" t))) + (defcustom org-archive-save-context-info '(time file olpath category todo itags) "Parts of context info that should be stored as properties when archiving. When a subtree is moved to an archive file, it loses information given by @@ -87,7 +96,7 @@ olpath The outline path to the item. These are all headlines above the current item, separated by /, like a file path. For each symbol present in the list, a property will be created in -the archived entry, with a prefix \"PRE_ARCHIVE_\", to remember this +the archived entry, with a prefix \"ARCHIVE_\", to remember this information." :group 'org-archive :type '(set :greedy t @@ -156,10 +165,11 @@ if LOCATION is not given, the value of `org-archive-location' is used." (setq location (or location org-archive-location)) (if (string-match "\\(.*\\)::\\(.*\\)" location) (if (= (match-beginning 1) (match-end 1)) - (buffer-file-name) + (buffer-file-name (buffer-base-buffer)) (expand-file-name (format (match-string 1 location) - (file-name-nondirectory buffer-file-name)))))) + (file-name-nondirectory + (buffer-file-name (buffer-base-buffer)))))))) (defun org-extract-archive-heading (&optional location) "Extract the heading from archive LOCATION. @@ -167,7 +177,8 @@ if LOCATION is not given, the value of `org-archive-location' is used." (setq location (or location org-archive-location)) (if (string-match "\\(.*\\)::\\(.*\\)" location) (format (match-string 2 location) - (file-name-nondirectory buffer-file-name)))) + (file-name-nondirectory + (buffer-file-name (buffer-base-buffer)))))) (defun org-archive-subtree (&optional find-done) "Move the current subtree to the archive. @@ -193,21 +204,24 @@ this heading." (tr-org-todo-line-regexp org-todo-line-regexp) (tr-org-odd-levels-only org-odd-levels-only) (this-buffer (current-buffer)) - ;; start of variables that will be used for saving context + ;; start of variables that will be used for saving context ;; The compiler complains about them - keep them anyway! - (file (abbreviate-file-name (buffer-file-name))) + (file (abbreviate-file-name + (or (buffer-file-name (buffer-base-buffer)) + (error "No file associated to buffer")))) (olpath (mapconcat 'identity (org-get-outline-path) "/")) (time (format-time-string (substring (cdr org-time-stamp-formats) 1 -1) (current-time))) - category todo priority ltags itags - ;; end of variables that will be used for saving context - location afile heading buffer level newfile-p visiting) + category todo priority ltags itags atags + ;; end of variables that will be used for saving context + location afile heading buffer level newfile-p infile-p visiting) ;; Find the local archive location (setq location (org-get-local-archive-location) afile (org-extract-archive-file location) - heading (org-extract-archive-heading location)) + heading (org-extract-archive-heading location) + infile-p (equal file (abbreviate-file-name afile))) (unless afile (error "Invalid `org-archive-location'")) @@ -225,14 +239,14 @@ this heading." (save-excursion (org-back-to-heading t) ;; Get context information that will be lost by moving the tree - (org-refresh-category-properties) - (setq category (org-get-category) + (setq category (org-get-category nil 'force-refresh) todo (and (looking-at org-todo-line-regexp) (match-string 2)) priority (org-get-priority (if (match-end 3) (match-string 3) "")) ltags (org-get-tags) - itags (org-delete-all ltags (org-get-tags-at))) + itags (org-delete-all ltags (org-get-tags-at)) + atags (org-get-tags-at)) (setq ltags (mapconcat 'identity ltags " ") itags (mapconcat 'identity itags " ")) ;; We first only copy, in case something goes wrong @@ -289,7 +303,12 @@ this heading." (goto-char (point-max)) (insert "\n")) ;; Paste (org-paste-subtree (org-get-valid-level level (and heading 1))) - + ;; Shall we append inherited tags? + (and itags + (or (and (eq org-archive-subtree-add-inherited-tags 'infile) + infile-p) + (eq org-archive-subtree-add-inherited-tags t)) + (org-set-tags-to atags)) ;; Mark the entry as done (when (and org-archive-mark-done (looking-at org-todo-line-regexp) @@ -311,8 +330,7 @@ this heading." ;; Save and kill the buffer, if it is not the same buffer. (when (not (eq this-buffer buffer)) - (save-buffer)) - )) + (save-buffer)))) ;; Here we are back in the original buffer. Everything seems to have ;; worked. So now cut the tree and finish up. (let (this-command) (org-cut-subtree)) @@ -388,7 +406,7 @@ sibling does not exist, it will be created at the end of the subtree." If the cursor is not on a headline, try all level 1 trees. If it is on a headline, try all direct children. When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." - (let ((re (concat "^\\*+ +" org-not-done-regexp)) re1 + (let ((re (concat org-outline-regexp-bol "+" org-not-done-regexp)) re1 (rea (concat ".*:" org-archive-tag ":")) (begm (make-marker)) (endm (make-marker)) @@ -465,5 +483,6 @@ This command is set with the variable `org-archive-default-command'." (provide 'org-archive) +;; arch-tag: 0837f601-9699-43c3-8b90-631572ae6c85 ;;; org-archive.el ends here diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el index fbe0c0a30a3..8c37f9c08df 100644 --- a/lisp/org/org-ascii.el +++ b/lisp/org/org-ascii.el @@ -1,11 +1,12 @@ ;;; org-ascii.el --- ASCII export for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -37,7 +38,7 @@ :tag "Org Export ASCII" :group 'org-export) -(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) +(defcustom org-export-ascii-underline '(?\- ?\= ?\~ ?^ ?\# ?\$) "Characters for underlining headings in ASCII export. In the given sequence, these characters will be used for level 1, 2, ..." :group 'org-export-ascii @@ -95,29 +96,30 @@ utf8 Use all UTF-8 characters") (defun org-export-as-latin1 (&rest args) "Like `org-export-as-ascii', use latin1 encoding for special symbols." (interactive) - (org-export-as-encoding 'org-export-as-ascii (interactive-p) + (org-export-as-encoding 'org-export-as-ascii (org-called-interactively-p 'any) 'latin1 args)) ;;;###autoload (defun org-export-as-latin1-to-buffer (&rest args) "Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols." (interactive) - (org-export-as-encoding 'org-export-as-ascii-to-buffer (interactive-p) - 'latin1 args)) + (org-export-as-encoding 'org-export-as-ascii-to-buffer + (org-called-interactively-p 'any) 'latin1 args)) ;;;###autoload (defun org-export-as-utf8 (&rest args) - "Like `org-export-as-ascii', use use encoding for special symbols." + "Like `org-export-as-ascii', use encoding for special symbols." (interactive) - (org-export-as-encoding 'org-export-as-ascii (interactive-p) + (org-export-as-encoding 'org-export-as-ascii + (org-called-interactively-p 'any) 'utf8 args)) ;;;###autoload (defun org-export-as-utf8-to-buffer (&rest args) "Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols." (interactive) - (org-export-as-encoding 'org-export-as-ascii-to-buffer (interactive-p) - 'utf8 args)) + (org-export-as-encoding 'org-export-as-ascii-to-buffer + (org-called-interactively-p 'any) 'utf8 args)) (defun org-export-as-encoding (command interactivep encoding &rest args) (let ((org-export-ascii-entities encoding)) @@ -175,7 +177,7 @@ a Lisp program could call this function in the following way: When called interactively, the output buffer is selected, and shown in a window. A non-interactive call will only return the buffer." (interactive "r\nP") - (when (interactive-p) + (when (org-called-interactively-p 'any) (setq buffer "*Org ASCII Export*")) (let ((transient-mark-mode t) (zmacs-regions t) ext-plist rtn) @@ -187,7 +189,7 @@ in a window. A non-interactive call will only return the buffer." nil nil ext-plist buffer body-only)) (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (interactive-p) (bufferp rtn)) + (if (and (org-called-interactively-p 'any) (bufferp rtn)) (switch-to-buffer-other-window rtn) rtn))) @@ -290,10 +292,12 @@ publishing directory." (buffer-substring (if (org-region-active-p) (region-beginning) (point-min)) (if (org-region-active-p) (region-end) (point-max)))) + (org-export-footnotes-seen nil) + (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) (lines (org-split-string (org-export-preprocess-string region - :for-ascii t + :for-backend 'ascii :skip-before-1st-heading (plist-get opt-plist :skip-before-1st-heading) :drawers (plist-get opt-plist :drawers) @@ -302,6 +306,7 @@ publishing directory." :footnotes (plist-get opt-plist :footnotes) :timestamps (plist-get opt-plist :timestamps) :todo-keywords (plist-get opt-plist :todo-keywords) + :tasks (plist-get opt-plist :tasks) :verbatim-multiline t :select-tags (plist-get opt-plist :select-tags) :exclude-tags (plist-get opt-plist :exclude-tags) @@ -369,61 +374,61 @@ publishing directory." (push (concat (nth 3 lang-words) "\n") thetoc) (push (concat (make-string (string-width (nth 3 lang-words)) ?=) "\n") thetoc) - (mapc (lambda (line) - (if (string-match org-todo-line-regexp - line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (match-string 3 line) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) + (mapc #'(lambda (line) + (if (string-match org-todo-line-regexp + line) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (match-string 3 line) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (setq txt (org-html-expand-for-ascii txt)) - - (while (string-match org-bracket-link-regexp txt) - (setq txt - (replace-match - (match-string (if (match-end 2) 3 1) txt) - t t txt))) - - (if (and (memq org-export-with-tags '(not-in-toc nil)) - (string-match - (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") - txt)) - (setq txt (replace-match "" t t txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - - (if org-export-with-section-numbers - (setq txt (concat (org-section-number level) - " " txt))) - (if (<= level umax-toc) - (progn - (push - (concat - (make-string - (* (max 0 (- level org-min-level)) 4) ?\ ) - (format (if todo "%s (*)\n" "%s\n") txt)) - thetoc) - (setq org-last-level level)) - )))) + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (setq txt (org-html-expand-for-ascii txt)) + + (while (string-match org-bracket-link-regexp txt) + (setq txt + (replace-match + (match-string (if (match-end 2) 3 1) txt) + t t txt))) + + (if (and (memq org-export-with-tags '(not-in-toc nil)) + (string-match + (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") + txt)) + (setq txt (replace-match "" t t txt))) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + + (if org-export-with-section-numbers + (setq txt (concat (org-section-number level) + " " txt))) + (if (<= level umax-toc) + (progn + (push + (concat + (make-string + (* (max 0 (- level org-min-level)) 4) ?\ ) + (format (if todo "%s (*)\n" "%s\n") txt)) + thetoc) + (setq org-last-level level)) + )))) lines) (setq thetoc (if have-headings (nreverse thetoc) nil)))) (org-init-section-numbers) (while (setq line (pop lines)) - (when (and link-buffer (string-match "^\\*+ " line)) + (when (and link-buffer (string-match org-outline-regexp-bol line)) (org-export-ascii-push-links (nreverse link-buffer)) (setq link-buffer nil)) (setq wrap nil) @@ -576,8 +581,8 @@ publishing directory." (replace-match "\\1\\2"))) ;; Remove list start counters (goto-char (point-min)) - (while (org-search-forward-unenclosed - "\\[@\\(?:start:\\)?[0-9]+\\][ \t]*" nil t) + (while (org-list-search-forward + "\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*" nil t) (replace-match "")) (remove-text-properties (point-min) (point-max) @@ -624,7 +629,9 @@ publishing directory." (save-match-data (if (save-excursion (re-search-backward - "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t)) + (concat "^\\(\\([ \t]*\\)\\|\\(" + org-outline-regexp + "\\)\\)[^ \t\n]") nil t)) (setq ind (or (match-string 2) (make-string (length (match-string 3)) ?\ ))))) (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n")) @@ -651,7 +658,8 @@ publishing directory." (if (or (not (equal (char-before) ?\n)) (not (equal (char-before (1- (point))) ?\n))) (insert "\n")) - (setq char (nth (- umax level) (reverse org-export-ascii-underline))) + (setq char (or (nth (1- level) org-export-ascii-underline) + (car (last org-export-ascii-underline)))) (unless org-export-with-tags (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) (setq title (replace-match "" t t title)))) @@ -718,4 +726,5 @@ publishing directory." (provide 'org-ascii) +;; arch-tag: aa96f882-f477-4e13-86f5-70d43e7adf3c ;;; org-ascii.el ends here diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index ae97db20f70..809ec159496 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -1,10 +1,10 @@ ;;; org-attach.el --- Manage file attachments to org-mode tasks -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@newartisans.com> ;; Keywords: org data task -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. ;; @@ -96,10 +96,17 @@ ln create a hard link. Note that this is not supported :group 'org-attach :type 'boolean) - (defvar org-attach-inherited nil "Indicates if the last access to the attachment directory was inherited.") +(defcustom org-attach-store-link-p nil + "Non-nil means store a link to a file when attaching it." + :group 'org-attach + :type '(choice + (const :tag "Don't store link" nil) + (const :tag "Link to origin location" t) + (const :tag "Link to the attach-dir location" 'attached))) + ;;;###autoload (defun org-attach () "The dispatcher for attachment commands. @@ -246,10 +253,10 @@ This checks for the existence of a \".git\" directory in that directory." (cd dir) (shell-command "git add .") (shell-command "git ls-files --deleted" t) - (mapc (lambda (file) - (unless (string= file "") - (shell-command - (concat "git rm \"" file "\"")))) + (mapc #'(lambda (file) + (unless (string= file "") + (shell-command + (concat "git rm \"" file "\"")))) (split-string (buffer-string) "\n")) (shell-command "git commit -m 'Synchronized attachments'"))))) @@ -264,6 +271,14 @@ This checks for the existence of a \".git\" directory in that directory." "Turn the autotag off." (org-attach-tag 'off)) +(defun org-attach-store-link (file) + "Add a link to `org-stored-link' when attaching a file. +Only do this when `org-attach-store-link-p' is non-nil." + (setq org-stored-links + (cons (list (org-attach-expand-link file) + (file-name-nondirectory file)) + org-stored-links))) + (defun org-attach-attach (file &optional visit-dir method) "Move/copy/link FILE into the attachment directory of the current task. If VISIT-DIR is non-nil, visit the directory with dired. @@ -282,6 +297,10 @@ METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'." ((eq method 'ln) (add-name-to-file file fname))) (org-attach-commit) (org-attach-tag) + (cond ((eq org-attach-store-link-p 'attached) + (org-attach-store-link fname)) + ((eq org-attach-store-link-p t) + (org-attach-store-link file))) (if visit-dir (dired attach-dir) (message "File \"%s\" is now a task attachment." basename))))) @@ -418,4 +437,5 @@ prefix." (provide 'org-attach) +;; arch-tag: fce93c2e-fe07-4fa3-a905-e10dcc7a6248 ;;; org-attach.el ends here diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index 49393db4304..b405718a49a 100644 --- a/lisp/org/org-bbdb.el +++ b/lisp/org/org-bbdb.el @@ -1,12 +1,13 @@ ;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org>, ;; Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -135,12 +136,12 @@ '(("birthday" lambda (name years suffix) (concat "Birthday: [[bbdb:" name "][" name " (" - (number-to-string years) + (format "%s" years) ; handles numbers as well as strings suffix ")]]")) ("wedding" lambda (name years suffix) (concat "[[bbdb:" name "][" name "'s " - (number-to-string years) + (format "%s" years) suffix " wedding anniversary]]"))) "How different types of anniversaries should be formatted. An alist of elements (STRING . FORMAT) where STRING is the name of an @@ -207,10 +208,12 @@ date year)." "Create the export version of a BBDB link specified by PATH or DESC. If exporting to either HTML or LaTeX FORMAT the link will be italicized, in all other cases it is left unchanged." + (when (string= desc (format "bbdb:%s" path)) + (setq desc path)) (cond - ((eq format 'html) (format "<i>%s</i>" (or desc path))) - ((eq format 'latex) (format "\\textit{%s}" (or desc path))) - (t (or desc path)))) + ((eq format 'html) (format "<i>%s</i>" desc)) + ((eq format 'latex) (format "\\textit{%s}" desc)) + (t desc))) (defun org-bbdb-open (name) "Follow a BBDB link to NAME." @@ -238,11 +241,16 @@ italicized, in all other cases it is left unchanged." (defun org-bbdb-anniv-extract-date (time-str) "Convert YYYY-MM-DD to (month date year). -Argument TIME-STR is the value retrieved from BBDB." - (multiple-value-bind (y m d) (values-list (bbdb-split time-str "-")) - (list (string-to-number m) - (string-to-number d) - (string-to-number y)))) +Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted +it will be considered unknown." + (multiple-value-bind (a b c) (values-list (bbdb-split time-str "-")) + (if (eq c nil) + (list (string-to-number a) + (string-to-number b) + nil) + (list (string-to-number b) + (string-to-number c) + (string-to-number a))))) (defun org-bbdb-anniv-split (str) "Split multiple entries in the BBDB anniversary field. @@ -325,8 +333,12 @@ This is used by Org to re-create the anniversary hash table." class org-bbdb-anniversary-format-alist t)) class)) ; (as format string) (name (nth 1 rec)) - (years (- y (car rec))) - (suffix (diary-ordinal-suffix years)) + (years (if (eq (car rec) nil) + "unknown" + (- y (car rec)))) + (suffix (if (eq (car rec) nil) + "" + (diary-ordinal-suffix years))) (tmp (cond ((functionp form) (funcall form name years suffix)) @@ -380,5 +392,6 @@ END:VEVENT\n" (provide 'org-bbdb) +;; arch-tag: 9e4f275d-d080-48c1-b040-62247f66b5c2 ;;; org-bbdb.el ends here diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el index 7b698da9681..97f17c043af 100644 --- a/lisp/org/org-beamer.el +++ b/lisp/org/org-beamer.el @@ -1,8 +1,8 @@ ;;; org-beamer.el --- Beamer-specific LaTeX export for org-mode ;; -;; Copyright (C) 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; -;; Version: 7.4 +;; Version: 7.7 ;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -139,6 +139,7 @@ open The opening template for the environment, with the following escapes %h the headline text %H if there is headline text, that text in {} braces %U if there is headline text, that text in [] brackets + %x the content of the BEAMER_extra property close The closing string of the environment." :group 'org-beamer @@ -399,7 +400,7 @@ the value will be inserted right after the documentclass statement." (insert org-beamer-header-extra) (or (bolp) (insert "\n")))))) -(defcustom org-beamer-fragile-re "^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\)}" +(defcustom org-beamer-fragile-re "^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}" "If this regexp matches in a frame, the frame is marked as fragile." :group 'org-beamer :type 'regexp) @@ -631,5 +632,6 @@ include square brackets." (provide 'org-beamer) +;; arch-tag: 68bac91a-a946-43a3-8173-a9269306f67c ;;; org-beamer.el ends here diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index 0c7edc6cbdb..da6c1fec58c 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -1,11 +1,12 @@ ;;; org-bibtex.el --- Org links to BibTeX entries ;; -;; Copyright (C) 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; ;; Author: Bastien Guerry <bzg at altern dot org> ;; Carsten Dominik <carsten dot dominik at gmail dot com> +;; Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: org, wp, remember -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -66,12 +67,30 @@ ;; ===================================================================== ;; * READ <== [point here] ;; -;; [[file:/file.bib::dolev83][Dolev & Yao 1983: security of public key protocols]] +;; [[file:file.bib::dolev83][Dolev & Yao 1983: security of public key protocols]] ;; ;; Danny Dolev and Andrew C. Yao (1983): On the security of public-key protocols ;; In IEEE Transaction on Information Theory, 198--208. ;; ===================================================================== ;; +;; Additionally, the following functions are now available for storing +;; bibtex entries within Org-mode documents. +;; +;; - Run `org-bibtex' to export the current file to a .bib. +;; +;; - Run `org-bibtex-check' or `org-bibtex-check-all' to check and +;; fill in missing field of either the current, or all headlines +;; +;; - Run `org-bibtex-create' to add a bibtex entry +;; +;; - Use `org-bibtex-read' to read a bibtex entry after `point' or in +;; the active region, then call `org-bibtex-write' in a .org file to +;; insert a heading for the read bibtex entry +;; +;; - All Bibtex information is taken from the document compiled by +;; Andrew Roberts from the Bibtex manual, available at +;; http://www.andy-roberts.net/misc/latex/sessions/bibtex/bibentries.pdf +;; ;;; History: ;; ;; The link creation part has been part of Org-mode for a long time. @@ -80,34 +99,321 @@ ;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112 ;; and then implemented by Bastien Guerry. ;; +;; Eric Schulte eventually added the functions for translating between +;; Org-mode headlines and Bibtex entries, and for fleshing out the Bibtex +;; fields of existing Org-mode headlines. +;; ;; Org-mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;;; Code: (require 'org) +(require 'bibtex) +(eval-when-compile + (require 'cl)) (defvar description nil) ; dynamically scoped from org.el +(defvar org-id-locations) (declare-function bibtex-beginning-of-entry "bibtex" ()) (declare-function bibtex-generate-autokey "bibtex" ()) (declare-function bibtex-parse-entry "bibtex" (&optional content)) (declare-function bibtex-url "bibtex" (&optional pos no-browse)) +(declare-function longlines-mode "longlines" (&optional arg)) +(declare-function org-babel-trim "ob" (string &optional regexp)) + + +;;; Bibtex data +(defvar org-bibtex-types + '((:article + (:description . "An article from a journal or magazine") + (:required :author :title :journal :year) + (:optional :volume :number :pages :month :note)) + (:book + (:description . "A book with an explicit publisher") + (:required (:editor :author) :title :publisher :year) + (:optional (:volume :number) :series :address :edition :month :note)) + (:booklet + (:description . "A work that is printed and bound, but without a named publisher or sponsoring institution.") + (:required :title) + (:optional :author :howpublished :address :month :year :note)) + (:conference + (:description . "") + (:required :author :title :booktitle :year) + (:optional :editor :pages :organization :publisher :address :month :note)) + (:inbook + (:description . "A part of a book, which may be a chapter (or section or whatever) and/or a range of pages.") + (:required (:author :editor) :title (:chapter :pages) :publisher :year) + (:optional :crossref (:volume :number) :series :type :address :edition :month :note)) + (:incollection + (:description . "A part of a book having its own title.") + (:required :author :title :booktitle :publisher :year) + (:optional :crossref :editor (:volume :number) :series :type :chapter :pages :address :edition :month :note)) + (:inproceedings + (:description . "An article in a conference proceedings") + (:required :author :title :booktitle :year) + (:optional :crossref :editor (:volume :number) :series :pages :address :month :organization :publisher :note)) + (:manual + (:description . "Technical documentation.") + (:required :title) + (:optional :author :organization :address :edition :month :year :note)) + (:mastersthesis + (:description . "A Master’s thesis.") + (:required :author :title :school :year) + (:optional :type :address :month :note)) + (:misc + (:description . "Use this type when nothing else fits.") + (:required) + (:optional :author :title :howpublished :month :year :note)) + (:phdthesis + (:description . "A PhD thesis.") + (:required :author :title :school :year) + (:optional :type :address :month :note)) + (:proceedings + (:description . "The proceedings of a conference.") + (:required :title :year) + (:optional :editor (:volume :number) :series :address :month :organization :publisher :note)) + (:techreport + (:description . "A report published by a school or other institution.") + (:required :author :title :institution :year) + (:optional :type :address :month :note)) + (:unpublished + (:description . "A document having an author and title, but not formally published.") + (:required :author :title :note) + (:optional :month :year))) + "Bibtex entry types with required and optional parameters.") + +(defvar org-bibtex-fields + '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.") + (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.") + (:author . "The name(s) of the author(s), in the format described in the LaTeX book. Remember, all names are separated with the and keyword, and not commas.") + (:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.") + (:chapter . "A chapter (or section or whatever) number.") + (:crossref . "The database key of the entry being cross referenced.") + (:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.") + (:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.") + (:howpublished . "How something strange has been published. The first word should be capitalized.") + (:institution . "The sponsoring institution of a technical report.") + (:journal . "A journal name.") + (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.") + (:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,") + (:note . "Any additional information that can help the reader. The first word should be capitalized.") + (:number . "Any additional information that can help the reader. The first word should be capitalized.") + (:organization . "The organization that sponsors a conference or that publishes a manual.") + (:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).") + (:publisher . "The publisher’s name.") + (:school . "The name of the school where a thesis was written.") + (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.") + (:title . "The work’s title, typed as explained in the LaTeX book.") + (:type . "The type of a technical report for example, 'Research Note'.") + (:volume . "The volume of a journal or multi-volume book.") + (:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'")) + "Bibtex fields with descriptions.") + +(defvar *org-bibtex-entries* nil + "List to hold parsed bibtex entries.") + +(defcustom org-bibtex-autogen-keys nil + "Set to a truthy value to use `bibtex-generate-autokey' to generate keys." + :group 'org-bibtex + :type 'boolean) + +(defcustom org-bibtex-prefix nil + "Optional prefix for all bibtex property names. +For example setting to 'BIB_' would allow interoperability with fireforg." + :group 'org-bibtex + :type 'string) + +(defcustom org-bibtex-treat-headline-as-title t + "Treat headline text as title if title property is absent. +If an entry is missing a title property, use the headline text as +the property. If this value is t, `org-bibtex-check' will ignore +a missing title field." + :group 'org-bibtex + :type 'boolean) + +(defcustom org-bibtex-export-arbitrary-fields nil + "When converting to bibtex allow fields not defined in `org-bibtex-fields'. +This only has effect if `org-bibtex-prefix' is defined, so as to +ensure that other org-properties, such as CATEGORY or LOGGING are +not placed in the exported bibtex entry." + :group 'org-bibtex + :type 'boolean) + +(defcustom org-bibtex-key-property "CUSTOM_ID" + "Property that holds the bibtex key. +By default, this is CUSTOM_ID, which enables easy linking to +bibtex headlines from within an org file. This can be set to ID +to enable global links, but only with great caution, as global +IDs must be unique." + :group 'org-bibtex + :type 'string) + +(defcustom org-bibtex-tags nil + "List of tag(s) that should be added to new bib entries." + :group 'org-bibtex + :type '(repeat :tag "Tag" (string))) + +(defcustom org-bibtex-tags-are-keywords nil + "Convert the value of the keywords field to tags and vice versa. +If set to t, comma-separated entries in a bibtex entry's keywords +field will be converted to org tags. Note: spaces will be escaped +with underscores, and characters that are not permitted in org +tags will be removed. + +If t, local tags in an org entry will be exported as a +comma-separated string of keywords when exported to bibtex. Tags +defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will +not be exported." + :group 'org-bibtex + :type 'boolean) +(defcustom org-bibtex-no-export-tags nil + "List of tag(s) that should not be converted to keywords. +This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t." + :group 'org-bibtex + :type '(repeat :tag "Tag" (string))) + + +;;; Utility functions +(defun org-bibtex-get (property) + ((lambda (it) (when it (org-babel-trim it))) + (or (org-entry-get (point) (upcase property)) + (org-entry-get (point) (concat org-bibtex-prefix (upcase property)))))) + +(defun org-bibtex-put (property value) + (let ((prop (upcase (if (keywordp property) + (substring (symbol-name property) 1) + property)))) + (org-set-property + (concat (unless (string= org-bibtex-key-property prop) org-bibtex-prefix) + prop) + value))) + +(defun org-bibtex-headline () + "Return a bibtex entry of the given headline as a string." + (flet ((val (key lst) (cdr (assoc key lst))) + (to (string) (intern (concat ":" string))) + (from (key) (substring (symbol-name key) 1)) + (flatten (&rest lsts) + (apply #'append (mapcar + (lambda (e) + (if (listp e) (apply #'flatten e) (list e))) + lsts)))) + (let ((notes (buffer-string)) + (id (org-bibtex-get org-bibtex-key-property)) + (type (org-bibtex-get "type")) + (tags (when org-bibtex-tags-are-keywords + (delq nil + (mapcar + (lambda (tag) + (unless (member tag + (append org-bibtex-tags + org-bibtex-no-export-tags)) + tag)) + (org-get-local-tags-at)))))) + (when type + (let ((entry (format + "@%s{%s,\n%s\n}\n" type id + (mapconcat + (lambda (pair) (format " %s={%s}" (car pair) (cdr pair))) + (remove nil + (if (and org-bibtex-export-arbitrary-fields + org-bibtex-prefix) + (mapcar + (lambda (kv) + (let ((key (car kv)) (val (cdr kv))) + (when (and (string-match org-bibtex-prefix key) + (not (string= + (downcase (concat org-bibtex-prefix "TYPE")) (downcase key)))) + (cons (downcase (replace-regexp-in-string + org-bibtex-prefix "" key)) + val)))) + (org-entry-properties nil 'standard)) + (mapcar + (lambda (field) + (let ((value (or (org-bibtex-get (from field)) + (and (equal :title field) + (nth 4 (org-heading-components)))))) + (when value (cons (from field) value)))) + (flatten + (val :required (val (to type) org-bibtex-types)) + (val :optional (val (to type) org-bibtex-types)))))) + ",\n")))) + (with-temp-buffer + (insert entry) + (when tags + (bibtex-beginning-of-entry) + (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t) + (progn (goto-char (match-end 1)) (insert ", ")) + (bibtex-make-field "keywords" t t)) + (insert (mapconcat #'identity tags ", "))) + (bibtex-reformat) (buffer-string))))))) + +(defun org-bibtex-ask (field) + (unless (assoc field org-bibtex-fields) + (error "field:%s is not known" field)) + (save-window-excursion + (let* ((name (substring (symbol-name field) 1)) + (buf-name (format "*Bibtex Help %s*" name))) + (with-output-to-temp-buffer buf-name + (princ (cdr (assoc field org-bibtex-fields)))) + (with-current-buffer buf-name (longlines-mode t)) + (org-fit-window-to-buffer (get-buffer-window buf-name)) + ((lambda (result) (when (> (length result) 0) result)) + (read-from-minibuffer (format "%s: " name)))))) + +(defun org-bibtex-autokey () + "Generate an autokey for the current headline" + (org-bibtex-put org-bibtex-key-property + (if org-bibtex-autogen-keys + (let* ((entry (org-bibtex-headline)) + (key + (with-temp-buffer + (insert entry) + (bibtex-generate-autokey)))) + ;; test for duplicate IDs if using global ID + (when (and + (equal org-bibtex-key-property "ID") + (featurep 'org-id) + (hash-table-p org-id-locations) + (gethash key org-id-locations)) + (warn "Another entry has the same ID")) + key) + (read-from-minibuffer "id: ")))) + +(defun org-bibtex-fleshout (type &optional optional) + "Fleshout the current heading, ensuring that all required fields are present. +With optional argument OPTIONAL, also prompt for optional fields." + (flet ((val (key lst) (cdr (assoc key lst))) + (keyword (name) (intern (concat ":" (downcase name)))) + (name (keyword) (substring (symbol-name keyword) 1))) + (dolist (field (append + (if org-bibtex-treat-headline-as-title + (remove :title (val :required (val type org-bibtex-types))) + (val :required (val type org-bibtex-types))) + (when optional (val :optional (val type org-bibtex-types))))) + (when (consp field) ; or'd pair of fields e.g., (:editor :author) + (let ((present (first (remove nil + (mapcar + (lambda (f) (when (org-bibtex-get (name f)) f)) + field))))) + (setf field (or present (keyword (org-icompleting-read + "Field: " (mapcar #'name field))))))) + (let ((name (name field))) + (unless (org-bibtex-get name) + (let ((prop (org-bibtex-ask field))) + (when prop (org-bibtex-put name prop))))))) + (when (and type (assoc type org-bibtex-types) + (not (org-bibtex-get org-bibtex-key-property))) + (org-bibtex-autokey))) + + +;;; Bibtex link functions (org-add-link-type "bibtex" 'org-bibtex-open) (add-hook 'org-store-link-functions 'org-bibtex-store-link) -;; (defun org-bibtex-publish (path) -;; "Build the description of the BibTeX entry for publishing." -;; (let* ((search (when (string-match "::\\(.+\\)\\'" path) -;; (match-string 1 path))) -;; (path (substring path 0 (match-beginning 0))) -;; key) -;; (with-temp-buffer -;; (org-open-file path t nil search) -;; (setq key (org-create-file-search-functions))) -;; (or description key))) - (defun org-bibtex-open (path) "Visit the bibliography entry on PATH." (let* ((search (when (string-match "::\\(.+\\)\\'" path) @@ -192,13 +498,150 @@ (goto-char p) (bibtex-url))) (recenter 0)) ; Move entry start to beginning of window - ;; return t to indicate that the search is done. + ;; return t to indicate that the search is done. t)) ;; Finally add the link search function to the right hook. (add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex) + +;;; Bibtex <-> Org-mode headline translation functions +(defun org-bibtex (&optional filename) + "Export each headline in the current file to a bibtex entry. +Headlines are exported using `org-bibtex-export-headline'." + (interactive + (list (read-file-name + "Bibtex file: " nil nil nil + (file-name-nondirectory + (concat (file-name-sans-extension (buffer-file-name)) ".bib"))))) + (let ((bibtex-entries (remove nil (org-map-entries #'org-bibtex-headline)))) + (with-temp-file filename + (insert (mapconcat #'identity bibtex-entries "\n"))))) + +(defun org-bibtex-check (&optional optional) + "Check the current headline for required fields. +With prefix argument OPTIONAL also prompt for optional fields." + (interactive "P") + (save-restriction + (org-narrow-to-subtree) + (let ((type ((lambda (name) (when name (intern (concat ":" name)))) + (org-bibtex-get "TYPE")))) + (when type (org-bibtex-fleshout type optional))))) + +(defun org-bibtex-check-all (&optional optional) + "Check all headlines in the current file. +With prefix argument OPTIONAL also prompt for optional fields." + (interactive) (org-map-entries (lambda () (org-bibtex-check optional)))) + +(defun org-bibtex-create (&optional arg nonew) + "Create a new entry at the given level. +With a prefix arg, query for optional fields as well. +If nonew is t, add data to the headline of the entry at point." + (interactive "P") + (let* ((type (org-icompleting-read + "Type: " (mapcar (lambda (type) + (substring (symbol-name (car type)) 1)) + org-bibtex-types) + nil nil (when nonew (org-bibtex-get "TYPE")))) + (type (if (keywordp type) type (intern (concat ":" type)))) + (org-bibtex-treat-headline-as-title (if nonew nil t))) + (unless (assoc type org-bibtex-types) + (error "type:%s is not known" type)) + (if nonew + (org-back-to-heading) + (org-insert-heading) + (let ((title (org-bibtex-ask :title))) + (insert title) + (org-bibtex-put "TITLE" title))) + (org-bibtex-put "TYPE" (substring (symbol-name type) 1)) + (org-bibtex-fleshout type arg) + (mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags))) + +(defun org-bibtex-create-in-current-entry (&optional arg) + "Add bibliographical data to the current entry. +With a prefix arg, query for optional fields." + (interactive "P") + (org-bibtex-create arg t)) + +(defun org-bibtex-read () + "Read a bibtex entry and save to `*org-bibtex-entries*'. +This uses `bibtex-parse-entry'." + (interactive) + (flet ((keyword (str) (intern (concat ":" (downcase str)))) + (clean-space (str) (replace-regexp-in-string + "[[:space:]\n\r]+" " " str)) + (strip-delim (str) ; strip enclosing "..." and {...} + (dolist (pair '((34 . 34) (123 . 125) (123 . 125))) + (when (and (= (aref str 0) (car pair)) + (= (aref str (1- (length str))) (cdr pair))) + (setf str (substring str 1 (1- (length str)))))) str)) + (push (mapcar + (lambda (pair) + (cons (let ((field (keyword (car pair)))) + (case field + (:=type= :type) + (:=key= :key) + (otherwise field))) + (clean-space (strip-delim (cdr pair))))) + (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry))) + *org-bibtex-entries*))) + +(defun org-bibtex-write () + "Insert a heading built from the first element of `*org-bibtex-entries*'." + (interactive) + (when (= (length *org-bibtex-entries*) 0) + (error "No entries in `*org-bibtex-entries*'.")) + (let ((entry (pop *org-bibtex-entries*)) + (org-special-properties nil)) ; avoids errors with `org-entry-put' + (flet ((val (field) (cdr (assoc field entry))) + (togtag (tag) (org-toggle-tag tag 'on))) + (org-insert-heading) + (insert (val :title)) + (org-bibtex-put "TITLE" (val :title)) + (org-bibtex-put "TYPE" (downcase (val :type))) + (dolist (pair entry) + (case (car pair) + (:title nil) + (:type nil) + (:key (org-bibtex-put org-bibtex-key-property (cdr pair))) + (:keywords (if org-bibtex-tags-are-keywords + (mapc + (lambda (kw) + (togtag + (replace-regexp-in-string + "[^[:alnum:]_@#%]" "" + (replace-regexp-in-string "[ \t]+" "_" kw)))) + (split-string (cdr pair) ", *")) + (org-bibtex-put (car pair) (cdr pair)))) + (otherwise (org-bibtex-put (car pair) (cdr pair))))) + (mapc #'togtag org-bibtex-tags)))) + +(defun org-bibtex-yank () + "If kill ring holds a bibtex entry yank it as an Org-mode headline." + (interactive) + (let (entry) + (with-temp-buffer (yank 1) (setf entry (org-bibtex-read))) + (if entry + (org-bibtex-write) + (error "yanked text does not appear to contain a bibtex entry")))) + +(defun org-bibtex-export-to-kill-ring () + "Export current headline to kill ring as bibtex entry." + (interactive) + (kill-new (org-bibtex-headline))) + +(defun org-bibtex-search (string) + "Search for bibliographical entries in agenda files. +This function relies `org-search-view' to locate results." + (interactive "sSearch string: ") + (let ((org-agenda-overriding-header "Bib search results:") + (org-agenda-search-view-always-boolean t)) + (org-search-view nil + (format "%s +{:%sTYPE:}" + string org-bibtex-prefix)))) + (provide 'org-bibtex) +;; arch-tag: 83987d5a-01b8-41c7-85bc-77700f1285f5 ;;; org-bibtex.el ends here diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index fb9365bda75..d2a011249c9 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1,11 +1,11 @@ ;;; org-capture.el --- Fast note taking in Org-mode -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -54,12 +54,16 @@ (require 'org-mks) (declare-function org-datetree-find-date-create "org-datetree" - (DATE &optional KEEP-RESTRICTION)) + (date &optional keep-restriction)) (declare-function org-table-get-specials "org-table" ()) (declare-function org-table-goto-line "org-table" (N)) +(declare-function org-pop-to-buffer-same-window "org-compat" + (&optional buffer-or-name norecord label)) + (defvar org-remember-default-headline) (defvar org-remember-templates) (defvar org-table-hlines) +(defvar dired-buffers) (defvar org-capture-clock-was-started nil "Internal flag, noting if the clock was started.") @@ -115,6 +119,11 @@ target Specification of where the captured item should be placed. become children of this node, other types will be added to the table or list in the body of this node. + Most target specifications contain a file name. If that file + name is the empty string, it defaults to `org-default-notes-file'. + A file can also be given as a variable, function, or Emacs Lisp + form. + Valid values are: (file \"path/to/file\") @@ -136,7 +145,7 @@ target Specification of where the captured item should be placed. 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 + Will create a heading in a date tree, prompts for date (file+function \"path/to/file\" function-finding-location) A function to find the right location in the file @@ -177,51 +186,60 @@ properties are: :clock-in Start the clock in this item. + :clock-keep Keep the clock running when filing the captured entry. + :clock-resume Start the interrupted clock when finishing the capture. + Note that :clock-keep has precedence over :clock-resume. + When setting both to `t', the current clock will run and + the previous one will not be resumed. :unnarrowed Do not narrow the target buffer, simply show the full buffer. Default is to narrow it so that you only see the new stuff. :table-line-pos Specification of the location in the table where the - new line should be inserted. It looks like \"II-3\" - which means that the new line should become the third - line before the second horizontal separator line. + new line should be inserted. It should be a string like + \"II-3\", meaning that the new line should become the + third line before the second horizontal separator line. :kill-buffer If the target file was not yet visited by a buffer when capture was invoked, kill the buffer again after capture is finalized. -The template defines the text to be inserted. Often this is an org-mode -entry (so the first line should start with a star) that will be filed as a -child of the target headline. It can also be freely formatted text. -Furthermore, the following %-escapes will be replaced with content: - - %^{prompt} prompt the user for a string and replace this sequence with it. - A default value and a completion table ca be specified like this: - %^{prompt|default|completion2|completion3|...} - %t time stamp, date only - %T time stamp with date and time - %u, %U like the above, but inactive time stamps - %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. - You may define a prompt like %^{Please specify birthday - %n user name (taken from `user-full-name') - %a annotation, normally the link created with `org-store-link' +The template defines the text to be inserted. Often this is an +org-mode entry (so the first line should start with a star) that +will be filed as a child of the target headline. It can also be +freely formatted text. Furthermore, the following %-escapes will +be replaced with content and expanded in this order: + + %[pathname] insert the contents of the file given by `pathname'. + %(sexp) evaluate elisp `(sexp)' and replace with the result. + %<...> the result of format-time-string on the ... format specification. + %t time stamp, date only. + %T time stamp with date and time. + %u, %U like the above, but inactive time stamps. + %a annotation, normally the link created with `org-store-link'. %i initial content, copied from the active region. If %i is indented, the entire inserted text will be indented as well. - %c current kill ring head - %x content of the X clipboard - %^C interactive selection of which kill or clip to use - %^L like %^C, but insert as link - %k title of currently clocked task - %K link to currently clocked task - %^g prompt for tags, with completion on tags in target file - %^G prompt for tags, with completion on all tags in all agenda files - %^{prop}p prompt the user for a value for property `prop' - %:keyword specific information for certain link types, see below - %[pathname] insert the contents of the file given by `pathname' - %(sexp) evaluate elisp `(sexp)' and replace with the result - + %A like %a, but prompt for the description part. + %c current kill ring head. + %x content of the X clipboard. + %k title of currently clocked task. + %K link to currently clocked task. + %n user name (taken from `user-full-name'). + %f file visited by current buffer when org-capture was called. + %F full path of the file or directory visited by current buffer. + %:keyword specific information for certain link types, see below. + %^g prompt for tags, with completion on tags in target file. + %^G prompt for tags, with completion on all tags in all agenda files. + %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. + You may define a prompt like %^{Please specify birthday. + %^C interactive selection of which kill or clip to use. + %^L like %^C, but insert as link. + %^{prop}p prompt the user for a value for property `prop'. + %^{prompt} prompt the user for a string and replace this sequence with it. + A default value and a completion table ca be specified like this: + %^{prompt|default|completion2|completion3|...}. %? After completing the template, position cursor here. Apart from these general escapes, you can access information specific to the @@ -309,13 +327,14 @@ calendar | %:type %:date" ((const :format "%v " :immediate-finish) (const t)) ((const :format "%v " :empty-lines) (const 1)) ((const :format "%v " :clock-in) (const t)) + ((const :format "%v " :clock-keep) (const t)) ((const :format "%v " :clock-resume) (const t)) ((const :format "%v " :unnarrowed) (const t)) ((const :format "%v " :kill-buffer) (const t)))))))) (defcustom org-capture-before-finalize-hook nil - "Hook that is run right before a remember process is finalized. -The remember buffer is still current when this hook runs." + "Hook that is run right before a capture process is finalized. +The capture buffer is still current when this hook runs." :group 'org-capture :type 'hook) @@ -329,37 +348,55 @@ The remember buffer is still current when this hook runs." (defvar org-capture-plist nil "Plist for the current capture process, global, to avoid having to pass it.") + (defvar org-capture-current-plist nil "Local variable holding the plist in a capture buffer. -This is used to store the plist for use when finishing a capture process. -Another such process might have changed the global variable by then.") +This is used to store the plist for use when finishing a capture process +because another such process might have changed the global variable by then. + +Each time a new capture buffer has been set up, the global `org-capture-plist' +is copied to this variable, which is local in the indirect buffer.") + +(defvar org-capture-clock-keep nil + "Local variable to store the value of the :clock-keep parameter. +This is needed in case org-capture-finalize is called interactively.") (defun org-capture-put (&rest stuff) + "Add properties to the capture property list `org-capture-plist'." (while stuff (setq org-capture-plist (plist-put org-capture-plist (pop stuff) (pop stuff))))) (defun org-capture-get (prop &optional local) + "Get properties from the capture property list `org-capture-plist'. +When LOCAL is set, use the local variable `org-capture-current-plist', +this is necessary after initialization of the capture process, +to avoid conflicts with other active capture processes." (plist-get (if local org-capture-current-plist org-capture-plist) prop)) -(defun org-capture-member (prop) - (plist-get org-capture-plist prop)) +(defun org-capture-member (prop &optional local) + "Is PROP a preperty in `org-capture-plist'. +When LOCAL is set, use the local variable `org-capture-current-plist', +this is necessary after initialization of the capture process, +to avoid conflicts with other active capture processes." + (plist-get (if local org-capture-current-plist org-capture-plist) prop)) ;;; The minor mode (defvar org-capture-mode-map (make-sparse-keymap) "Keymap for `org-capture-mode', a minor mode. Use this map to set additional keybindings for when Org-mode is used -for a Remember buffer.") +for a capture buffer.") (defvar org-capture-mode-hook nil "Hook for the minor `org-capture-mode'.") (define-minor-mode org-capture-mode - "Minor mode for special key bindings in a remember buffer." + "Minor mode for special key bindings in a capture buffer." nil " Rem" org-capture-mode-map (org-set-local 'header-line-format - "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")) + "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.") + (run-hooks 'org-capture-mode-hook)) (define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) (define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) (define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) @@ -397,7 +434,7 @@ bypassed." (annotation (if (and (boundp 'org-capture-link-is-already-stored) org-capture-link-is-already-stored) (plist-get org-store-link-plist :annotation) - (org-store-link nil))) + (ignore-errors (org-store-link nil)))) (initial (and (org-region-active-p) (buffer-substring (point) (mark)))) (entry (org-capture-select-template keys))) @@ -414,7 +451,16 @@ bypassed." (t (org-capture-set-plist entry) (org-capture-get-template) - (org-capture-put :original-buffer orig-buf :annotation annotation + (org-capture-put :original-buffer orig-buf + :original-file (or (buffer-file-name orig-buf) + (and (featurep 'dired) + (car (rassq orig-buf + dired-buffers)))) + :original-file-nondirectory + (and (buffer-file-name orig-buf) + (file-name-nondirectory + (buffer-file-name orig-buf))) + :annotation annotation :initial initial) (org-capture-put :default-time (or org-overriding-default-time @@ -426,6 +472,7 @@ bypassed." (if (get-buffer "*Capture*") (kill-buffer "*Capture*")) (error "Capture abort: %s" error))) + (setq org-capture-clock-keep (org-capture-get :clock-keep)) (if (equal goto 0) ;;insert at point (org-capture-insert-template-here) @@ -439,20 +486,19 @@ bypassed." (error "Capture template `%s': %s" (org-capture-get :key) (nth 1 error)))) + (if (and (org-mode-p) + (org-capture-get :clock-in)) + (condition-case nil + (progn + (if (org-clock-is-active) + (org-capture-put :interrupted-clock + (copy-marker org-clock-marker))) + (org-clock-in) + (org-set-local 'org-capture-clock-was-started t)) + (error + "Could not start the clock in this capture buffer"))) (if (org-capture-get :immediate-finish) - (org-capture-finalize) - (if (and (org-mode-p) - (org-capture-get :clock-in)) - (condition-case nil - (progn - (if (org-clock-is-active) - (org-capture-put :interrupted-clock - (copy-marker org-clock-marker))) - (org-clock-in) - (org-set-local 'org-capture-clock-was-started t)) - (error - "Could not start the clock in this capture buffer"))))))))))) - + (org-capture-finalize nil))))))))) (defun org-capture-get-template () "Get the template from a file or a function if necessary." @@ -488,8 +534,9 @@ captured item after finalizing." (> org-clock-marker (point-min)) (< org-clock-marker (point-max))) ;; Looks like the clock we started is still running. Clock out. - (let (org-log-note-clock-out) (org-clock-out)) - (when (and (org-capture-get :clock-resume 'local) + (when (not org-capture-clock-keep) (let (org-log-note-clock-out) (org-clock-out))) + (when (and (not org-capture-clock-keep) + (org-capture-get :clock-resume 'local) (markerp (org-capture-get :interrupted-clock 'local)) (buffer-live-p (marker-buffer (org-capture-get :interrupted-clock 'local)))) @@ -501,13 +548,20 @@ captured item after finalizing." (let ((beg (point-min)) (end (point-max)) (abort-note nil)) + ;; Store the size of the capture buffer + (org-capture-put :captured-entry-size (- (point-max) (point-min))) (widen) + ;; Store the insertion point in the target buffer + (org-capture-put :insertion-point (point)) (if org-note-abort (let ((m1 (org-capture-get :begin-marker 'local)) (m2 (org-capture-get :end-marker 'local))) (if (and m1 m2 (= m1 beg) (= m2 end)) (progn + (setq m2 (if (cdr (assoc 'heading org-blank-before-new-entry)) + m2 (1+ m2)) + m2 (if (< (point-max) m2) (point-max) m2)) (setq abort-note 'clean) (kill-region m1 m2)) (setq abort-note 'dirty))) @@ -533,16 +587,14 @@ captured item after finalizing." (org-at-table-p)) (if (org-table-get-stored-formulas) (org-table-recalculate 'all) ;; FIXME: Should we iterate??? - (org-table-align))) - ) + (org-table-align)))) ;; Store this place as the last one where we stored something ;; Do the marking in the base buffer, so that it makes sense after ;; the indirect buffer has been killed. (org-capture-bookmark-last-stored-position) ;; Run the hook - (run-hooks 'org-capture-before-finalize-hook) - ) + (run-hooks 'org-capture-before-finalize-hook)) ;; Kill the indirect buffer (save-buffer) @@ -551,9 +603,30 @@ captured item after finalizing." (kill-buffer (org-capture-get :kill-buffer 'local)) (base-buffer (buffer-base-buffer (current-buffer)))) - ;; Kill the indiret buffer + ;; Kill the indirect buffer (kill-buffer (current-buffer)) + ;; Narrow back the target buffer to its previous state + (with-current-buffer (org-capture-get :buffer) + (let ((reg (org-capture-get :initial-target-region)) + (pos (org-capture-get :initial-target-position)) + (ipt (org-capture-get :insertion-point)) + (size (org-capture-get :captured-entry-size))) + (when reg + (cond ((< ipt (car reg)) + ;; insertion point is before the narrowed region + (narrow-to-region (+ size (car reg)) (+ size (cdr reg)))) + ((> ipt (cdr reg)) + ;; insertion point is after the narrowed region + (narrow-to-region (car reg) (cdr reg))) + (t + ;; insertion point is within the narrowed region + (narrow-to-region (car reg) (+ size (cdr reg))))) + ;; now place back the point at its original position + (if (< ipt (car reg)) + (goto-char (+ size pos)) + (goto-char (if (< ipt pos) (+ size pos) pos)))))) + ;; Kill the target buffer if that is desired (when (and base-buffer new-buffer kill-buffer) (with-current-buffer base-buffer (save-buffer)) @@ -579,7 +652,7 @@ captured item after finalizing." (defun org-capture-refile () "Finalize the current capture and then refile the entry. Refiling is done from the base buffer, because the indirect buffer is then -already gone. Any prefix argument will be passed to the refile comand." +already gone. Any prefix argument will be passed to the refile command." (interactive) (unless (eq (org-capture-get :type 'local) 'entry) (error @@ -601,11 +674,12 @@ already gone. Any prefix argument will be passed to the refile comand." (interactive) ;; FIXME: This does not do the right thing, we need to remove the new stuff ;; By hand it is easy: undo, then kill the buffer - (let ((org-note-abort t) (org-capture-before-finalize-hook nil)) + (let ((org-note-abort t) + (org-capture-before-finalize-hook nil)) (org-capture-finalize))) (defun org-capture-goto-last-stored () - "Go to the location where the last remember note was stored." + "Go to the location where the last capture note was stored." (interactive) (org-goto-marker-or-bmk org-capture-last-stored-marker "org-capture-last-stored") @@ -613,6 +687,16 @@ already gone. Any prefix argument will be passed to the refile comand." ;;; Supporting functions for handling the process +(defun org-capture-put-target-region-and-position () + "Store the initial region with `org-capture-put'." + (org-capture-put + :initial-target-region + ;; Check if the buffer is currently narrowed + (when (/= (buffer-size) (- (point-max) (point-min))) + (cons (point-min) (point-max)))) + ;; store the current point + (org-capture-put :initial-target-position (point))) + (defun org-capture-set-target-location (&optional target) "Find target buffer and position and store then in the property list." (let ((target-entry-p t)) @@ -621,6 +705,8 @@ already gone. Any prefix argument will be passed to the refile comand." (cond ((eq (car target) 'file) (set-buffer (org-capture-target-buffer (nth 1 target))) + (org-capture-put-target-region-and-position) + (widen) (setq target-entry-p nil)) ((eq (car target) 'id) @@ -628,14 +714,20 @@ already gone. Any prefix argument will be passed to the refile comand." (if (not loc) (error "Cannot find target ID \"%s\"" (nth 1 target)) (set-buffer (org-capture-target-buffer (car loc))) + (widen) + (org-capture-put-target-region-and-position) (goto-char (cdr loc))))) ((eq (car target) 'file+headline) (set-buffer (org-capture-target-buffer (nth 1 target))) + (org-capture-put-target-region-and-position) + (widen) (let ((hd (nth 2 target))) (goto-char (point-min)) (unless (org-mode-p) - (error "Target buffer for file+headline should be in Org mode")) + (error + "Target buffer \"%s\" for file+headline should be in Org mode" + (current-buffer))) (if (re-search-forward (format org-complex-heading-regexp-format (regexp-quote hd)) nil t) @@ -646,12 +738,18 @@ already gone. Any prefix argument will be passed to the refile comand." (beginning-of-line 0)))) ((eq (car target) 'file+olp) - (let ((m (org-find-olp (cdr target)))) + (let ((m (org-find-olp + (cons (org-capture-expand-file (nth 1 target)) + (cddr target))))) (set-buffer (marker-buffer m)) + (org-capture-put-target-region-and-position) + (widen) (goto-char m))) ((eq (car target) 'file+regexp) (set-buffer (org-capture-target-buffer (nth 1 target))) + (org-capture-put-target-region-and-position) + (widen) (goto-char (point-min)) (if (re-search-forward (nth 2 target) nil t) (progn @@ -664,27 +762,32 @@ already gone. Any prefix argument will be passed to the refile comand." ((memq (car target) '(file+datetree file+datetree+prompt)) (require 'org-datetree) (set-buffer (org-capture-target-buffer (nth 1 target))) + (org-capture-put-target-region-and-position) + (widen) ;; Make a date tree entry, with the current date (or yesterday, ;; if we are extending dates for a couple of hours) (org-datetree-find-date-create (calendar-gregorian-from-absolute (cond - (org-overriding-default-time ;; use the overriding default time (time-to-days org-overriding-default-time)) ((eq (car target) 'file+datetree+prompt) ;; prompt for date - (time-to-days (org-read-date - nil t nil "Date for tree entry:" - (days-to-time (org-today))))) + (let ((prompt-time (org-read-date + nil t nil "Date for tree entry:" + (current-time)))) + (org-capture-put :prompt-time prompt-time) + (time-to-days prompt-time))) (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))) + (org-capture-put-target-region-and-position) + (widen) (funcall (nth 2 target)) (org-capture-put :exact-position (point)) (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) @@ -698,6 +801,8 @@ already gone. Any prefix argument will be passed to the refile comand." (if (and (markerp org-clock-hd-marker) (marker-buffer org-clock-hd-marker)) (progn (set-buffer (marker-buffer org-clock-hd-marker)) + (org-capture-put-target-region-and-position) + (widen) (goto-char org-clock-hd-marker)) (error "No running clock that could be used as capture target"))) @@ -706,8 +811,20 @@ already gone. Any prefix argument will be passed to the refile comand." (org-capture-put :buffer (current-buffer) :pos (point) :target-entry-p target-entry-p)))) +(defun org-capture-expand-file (file) + "Expand functions and symbols for FILE. +When FILE is a function, call it. When it is a form, evaluate +it. When it is a variable, retrieve the value. Return whatever we get." + (cond + ((org-string-nw-p file) file) + ((functionp file) (funcall file)) + ((and (symbolp file) (boundp file)) (symbol-value file)) + ((and file (consp file)) (eval file)) + (t file))) + (defun org-capture-target-buffer (file) "Get a buffer for FILE." + (setq file (org-capture-expand-file file)) (setq file (or (org-string-nw-p file) org-default-notes-file (error "No notes file specified, and no default available"))) @@ -775,6 +892,7 @@ already gone. Any prefix argument will be passed to the refile comand." (or (bolp) (insert "\n"))))) (org-capture-empty-lines-before) (setq beg (point)) + (org-capture-verify-tree txt) (org-paste-subtree level txt 'for-yank) (org-capture-empty-lines-after 1) (org-capture-position-for-last-stored beg) @@ -803,14 +921,14 @@ already gone. Any prefix argument will be passed to the refile comand." (if (org-capture-get :prepend) (progn (goto-char beg) - (if (org-search-forward-unenclosed org-item-beginning-re end t) + (if (org-list-search-forward (org-item-beginning-re) end t) (progn (goto-char (match-beginning 0)) (setq ind (org-get-indentation))) (goto-char end) (setq ind 0))) (goto-char end) - (if (org-search-backward-unenclosed org-item-beginning-re beg t) + (if (org-list-search-backward (org-item-beginning-re) beg t) (progn (setq ind (org-get-indentation)) (org-end-of-item)) @@ -921,13 +1039,28 @@ already gone. Any prefix argument will be passed to the refile comand." (org-table-align))) (defun org-capture-place-plain-text () - "Place the template plainly." + "Place the template plainly. +If the target locator points at an Org node, place the template into +the text of the entry, before the first child. If not, place the +template at the beginning or end of the file. +Of course, if exact position has been required, just put it there." (let* ((txt (org-capture-get :template)) beg end) - (goto-char (cond - ((org-capture-get :exact-position)) - ((org-capture-get :prepend) (point-min)) - (t (point-max)))) + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((and (org-capture-get :target-entry-p) + (bolp) + (looking-at org-outline-regexp)) + ;; we should place the text into this entry + (if (org-capture-get :prepend) + ;; Skip meta data and drawers + (org-end-of-meta-data-and-drawers) + ;; go to ent of the entry text, before the next headline + (outline-next-heading))) + (t + ;; beginning or end of file + (goto-char (if (org-capture-get :prepend) (point-min) (point-max))))) (or (bolp) (newline)) (org-capture-empty-lines-before) (setq beg (point)) @@ -1016,6 +1149,7 @@ Point will remain at the first line after the inserted text." (setq beg (point)) (cond ((and (eq type 'entry) (org-mode-p)) + (org-capture-verify-tree (org-capture-get :template)) (org-paste-subtree nil template t)) ((and (memq type '(item checkitem)) (org-mode-p) @@ -1067,7 +1201,7 @@ The user is queried for the template." (error "No capture template selected")) (org-capture-set-plist entry) (org-capture-set-target-location) - (switch-to-buffer (org-capture-get :buffer)) + (org-pop-to-buffer-same-window (org-capture-get :buffer)) (goto-char (org-capture-get :pos)))) (defun org-capture-get-indirect-buffer (&optional buffer prefix) @@ -1083,24 +1217,28 @@ Use PREFIX as a prefix for the name of the indirect buffer." (error (make-indirect-buffer buffer bname))))) +(defun org-capture-verify-tree (tree) + "Throw error if TREE is not a valid tree" + (unless (org-kill-is-subtree-p tree) + (error "Template is not a valid Org entry or tree"))) + ;;; The template code (defun org-capture-select-template (&optional keys) "Select a capture template. Lisp programs can force the template by setting KEYS to a string." - (if org-capture-templates - (if keys - (or (assoc keys org-capture-templates) - (error "No capture template referred to by \"%s\" keys" keys)) - (if (= 1 (length org-capture-templates)) - (car org-capture-templates) - (org-mks org-capture-templates - "Select a capture template\n=========================" - "Template key: " - '(("C" "Customize org-capture-templates") - ("q" "Abort"))))) - ;; Use an arbitrary default template - '("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a"))) + (let ((org-capture-templates + (or org-capture-templates + '(("t" "Task" entry (file+headline "" "Tasks") + "* TODO %?\n %u\n %a"))))) + (if keys + (or (assoc keys org-capture-templates) + (error "No capture template referred to by \"%s\" keys" keys)) + (org-mks org-capture-templates + "Select a capture template\n=========================" + "Template key: " + '(("C" "Customize org-capture-templates") + ("q" "Abort")))))) (defun org-capture-fill-template (&optional template initial annotation) "Fill a template and return the filled template as a string. @@ -1155,6 +1293,8 @@ The template may still contain \"%?\" for cursor positioning." (org-make-link-string (buffer-file-name (marker-buffer org-clock-marker)) org-clock-heading))) + (v-f (or (org-capture-get :original-file-nondirectory) "")) + (v-F (or (org-capture-get :original-file) "")) v-I (org-startup-folded nil) (org-inhibit-startup t) @@ -1171,7 +1311,7 @@ The template may still contain \"%?\" for cursor positioning." (sit-for 1)) (save-window-excursion (delete-other-windows) - (switch-to-buffer (get-buffer-create "*Capture*")) + (org-pop-to-buffer-same-window (get-buffer-create "*Capture*")) (erase-buffer) (insert template) (goto-char (point-min)) @@ -1198,16 +1338,18 @@ The template may still contain \"%?\" for cursor positioning." (goto-char (match-beginning 0)) (let ((template-start (point))) (forward-char 1) - (let ((result - (condition-case error - (eval (read (current-buffer))) - (error (format "%%![Error: %s]" error))))) + (let ((result (org-eval (read (current-buffer))))) (delete-region template-start (point)) (insert result))))) + ;; The current time + (goto-char (point-min)) + (while (re-search-forward "%<\\([^>\n]+\\)>" nil t) + (replace-match (format-time-string (match-string 1)) t t)) + ;; Simple %-escapes (goto-char (point-min)) - (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) + (while (re-search-forward "%\\([tTuUaiAcxkKInfF]\\)" nil t) (unless (org-capture-escaped-%) (when (and initial (equal (match-string 0) "%i")) (save-match-data @@ -1237,8 +1379,8 @@ The template may still contain \"%?\" for cursor positioning." (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) (unless (org-capture-escaped-%) - (setq char (if (match-end 3) (match-string 3)) - prompt (if (match-end 2) (match-string 2))) + (setq char (if (match-end 3) (match-string-no-properties 3)) + prompt (if (match-end 2) (match-string-no-properties 2))) (goto-char (match-beginning 0)) (replace-match "") (setq completions nil default nil) @@ -1287,29 +1429,7 @@ The template may still contain \"%?\" for cursor positioning." '(clipboards . 1) (car clipboards)))))) ((equal char "p") - (let* - ((prop (org-substring-no-properties prompt)) - (pall (concat prop "_ALL")) - (allowed - (with-current-buffer - (get-buffer (file-name-nondirectory file)) - (or (cdr (assoc pall org-file-properties)) - (cdr (assoc pall org-global-properties)) - (cdr (assoc pall org-global-properties-fixed))))) - (existing (with-current-buffer - (get-buffer (file-name-nondirectory file)) - (mapcar 'list (org-property-values prop)))) - (propprompt (concat "Value for " prop ": ")) - (val (if allowed - (org-completing-read - propprompt - (mapcar 'list (org-split-string allowed - "[ \t]+")) - nil 'req-match) - (org-completing-read-no-i propprompt - existing nil nil - "" nil "")))) - (org-set-property prop val))) + (org-set-property (org-substring-no-properties prompt) nil)) (char ;; These are the date/time related ones (setq org-time-was-given (equal (upcase char) char)) @@ -1385,5 +1505,6 @@ The template may still contain \"%?\" for cursor positioning." (provide 'org-capture) +;; arch-tag: 986bf41b-8ada-4e28-bf20-e8388a7205a0 ;;; org-capture.el ends here diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 4e30dd90d80..91d4ef11193 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1,11 +1,12 @@ ;;; org-clock.el --- The time clocking code for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -28,6 +29,7 @@ ;; This file contains the time clocking code for Org-mode (require 'org) +(require 'org-exp) ;;; Code: (eval-when-compile @@ -35,7 +37,9 @@ (declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) (declare-function notifications-notify "notifications" (&rest params)) +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (defvar org-time-stamp-formats) +(defvar org-ts-what) (defgroup org-clock nil "Options concerning clocking working time in Org-mode." @@ -62,6 +66,22 @@ which see." (const :tag "Into LOGBOOK drawer" "LOGBOOK") (string :tag "Into Drawer named..."))) +(defun org-clock-into-drawer () + "Return the value of `org-clock-into-drawer', but let properties overrule. +If the current entry has or inherits a CLOCK_INTO_DRAWER +property, it will be used instead of the default value; otherwise +if the current entry has or inherits a LOG_INTO_DRAWER property, +it will be used instead of the default value. +The default is the value of the customizable variable `org-clock-into-drawer', +which see." + (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit)) + (q (org-entry-get nil "LOG_INTO_DRAWER" 'inherit))) + (cond + ((or (not (or p q)) (equal p "nil") (equal q "nil")) org-clock-into-drawer) + ((or (equal p "t") (equal q "t")) "LOGBOOK") + ((not p) q) + (t p)))) + (defcustom org-clock-out-when-done t "When non-nil, clock will be stopped when the clocked entry is marked DONE. DONE here means any DONE-like state. @@ -227,25 +247,26 @@ string as argument." :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) + `(list + :maxlevel 2 + :lang ,org-export-default-language + :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) @@ -256,6 +277,16 @@ For more information, see `org-clocktable-write-default'." :group 'org-clocktable :type 'function) +;; FIXME: translate es and nl last string "Clock summary at" +(defcustom org-clock-clocktable-language-setup + '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at") + ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at") + ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à") + ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at")) + "Terms used in clocktable, translated to different languages." + :group 'org-clocktable + :type 'alist) + (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 @@ -387,6 +418,9 @@ of a different task.") "Return t when clocking a task." (not (equal (org-clocking-buffer) nil))) +(defvar org-clock-before-select-task-hook nil + "Hook called in task selection just before prompting the user.") + (defun org-clock-select-task (&optional prompt) "Select a task that recently was associated with clocking." (interactive) @@ -419,6 +453,7 @@ of a different task.") (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) (push s sel-list))) org-clock-history) + (run-hooks 'org-clock-before-select-task-hook) (org-fit-window-to-buffer) (message (or prompt "Select task for clocking:")) (setq rpl (read-char-exclusive)) @@ -441,13 +476,11 @@ pointing to it." (ignore-errors (goto-char marker) (setq file (buffer-file-name (marker-buffer marker)) - cat (or (org-get-category) - (progn (org-refresh-category-properties) - (org-get-category))) + cat (org-get-category) heading (org-get-heading 'notags) prefix (save-excursion (org-back-to-heading t) - (looking-at "\\*+ ") + (looking-at org-outline-regexp) (match-string 0)) task (substring (org-fontify-like-in-org-mode @@ -473,7 +506,7 @@ If not, show simply the clocked time like 01:50." (m (- clocked-time (* 60 h)))) (if org-clock-effort (let* ((effort-in-minutes - (org-hh:mm-string-to-minutes org-clock-effort)) + (org-duration-string-to-minutes org-clock-effort)) (effort-h (floor effort-in-minutes 60)) (effort-m (- effort-in-minutes (* effort-h 60))) (work-done-str @@ -547,10 +580,10 @@ the mode line." ;; A string. See if it is a delta (setq sign (string-to-char value)) (if (member sign '(?- ?+)) - (setq current (org-hh:mm-string-to-minutes current) + (setq current (org-duration-string-to-minutes current) value (substring value 1)) (setq current 0)) - (setq value (org-hh:mm-string-to-minutes value)) + (setq value (org-duration-string-to-minutes value)) (if (equal ?- sign) (setq value (- current value)) (if (equal ?+ sign) (setq value (+ current value))))) @@ -567,7 +600,7 @@ the mode line." "Show notification if we spent more time than we estimated before. Notification is shown only once." (when (org-clocking-p) - (let ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort)) + (let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort)) (clocked-time (org-clock-get-clocked-time))) (if (setq org-task-overrun (if (or (null effort-in-minutes) (zerop effort-in-minutes)) @@ -746,7 +779,8 @@ If necessary, clock-out of the currently active clock." (defun org-clock-jump-to-current-clock (&optional effective-clock) (interactive) - (let ((clock (or effective-clock (cons org-clock-marker + (let ((org-clock-into-drawer (org-clock-into-drawer)) + (clock (or effective-clock (cons org-clock-marker org-clock-start-time)))) (unless (marker-buffer (car clock)) (error "No clock is currently running")) @@ -961,6 +995,16 @@ so long." 60.0)))) org-clock-user-idle-start))))) +(defvar org-clock-current-task nil + "Task currently clocked in.") +(defun org-clock-set-current () + "Set `org-clock-current-task' to the task currently clocked in." + (setq org-clock-current-task (nth 4 (org-heading-components)))) + +(defun org-clock-delete-current () + "Reset `org-clock-current-task' to nil." + (setq org-clock-current-task nil)) + (defun org-clock-in (&optional select start-time) "Start the clock on the current item. If necessary, clock-out of the currently active clock. @@ -978,6 +1022,7 @@ the clocking selection, associated with the letter `d'." ts selected-task target-pos (msg-extra "") (leftover (and (not org-clock-resolving-clocks) org-clock-leftover-time))) + (when (and org-clock-auto-clock-resolution (or (not interrupting) (eq t org-clock-auto-clock-resolution)) @@ -986,11 +1031,17 @@ the clocking selection, associated with the letter `d'." (setq org-clock-leftover-time nil) (let ((org-clock-clocking-in t)) (org-resolve-clocks))) ; check if any clocks are dangling + (when (equal select '(4)) (setq selected-task (org-clock-select-task "Clock-in on task: ")) (if selected-task (setq selected-task (copy-marker selected-task)) (error "Abort"))) + + (when (equal select '(16)) + ;; Mark as default clocking task + (org-clock-mark-default-task)) + (when interrupting ;; We are interrupting the clocking of a different task. ;; Save a marker to this task, so that we can go back. @@ -1005,7 +1056,8 @@ the clocking selection, associated with the letter `d'." (= (marker-position org-clock-hd-marker) (if selected-task (marker-position selected-task) - (point))))) + (point))) + (equal org-clock-current-task (nth 4 (org-heading-components))))) (message "Clock continues in \"%s\"" org-clock-heading) (throw 'abort nil)) (move-marker org-clock-interrupted-task @@ -1014,10 +1066,6 @@ the clocking selection, associated with the letter `d'." (let ((org-clock-clocking-in t)) (org-clock-out t))) - (when (equal select '(16)) - ;; Mark as default clocking task - (org-clock-mark-default-task)) - ;; Clock in at which position? (setq target-pos (if (and (eobp) (not (org-on-heading-p))) @@ -1045,7 +1093,7 @@ the clocking selection, associated with the letter `d'." (match-string 2)))) (if newstate (org-todo newstate)))) ((and org-clock-in-switch-to-state - (not (looking-at (concat outline-regexp "[ \t]*" + (not (looking-at (concat org-outline-regexp "[ \t]*" org-clock-in-switch-to-state "\\>")))) (org-todo org-clock-in-switch-to-state))) @@ -1138,16 +1186,6 @@ the clocking selection, associated with the letter `d'." (message "Clock starts at %s - %s" ts msg-extra) (run-hooks 'org-clock-in-hook))))))) -(defvar org-clock-current-task nil - "Task currently clocked in.") -(defun org-clock-set-current () - "Set `org-clock-current-task' to the task currently clocked in." - (setq org-clock-current-task (nth 4 (org-heading-components)))) - -(defun org-clock-delete-current () - "Reset `org-clock-current-task' to nil." - (setq org-clock-current-task nil)) - (defun org-clock-mark-default-task () "Mark current task as default task." (interactive) @@ -1197,16 +1235,17 @@ When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock line and position cursor in that line." (org-back-to-heading t) (catch 'exit - (let ((beg (save-excursion - (beginning-of-line 2) - (or (bolp) (newline)) - (point))) - (end (progn (outline-next-heading) (point))) - (re (concat "^[ \t]*" org-clock-string)) - (cnt 0) - (drawer (if (stringp org-clock-into-drawer) - org-clock-into-drawer "LOGBOOK")) - first last ind-last) + (let* ((org-clock-into-drawer (org-clock-into-drawer)) + (beg (save-excursion + (beginning-of-line 2) + (or (bolp) (newline)) + (point))) + (end (progn (outline-next-heading) (point))) + (re (concat "^[ \t]*" org-clock-string)) + (cnt 0) + (drawer (if (stringp org-clock-into-drawer) + org-clock-into-drawer "LOGBOOK")) + first last ind-last) (goto-char beg) (when (and find-unclosed (re-search-forward @@ -1239,7 +1278,10 @@ line and position cursor in that line." (beginning-of-line 2) (if (and (>= (org-get-indentation) ind-last) (org-at-item-p)) - (org-end-of-item)) + (when (and (>= (org-get-indentation) ind-last) + (org-at-item-p)) + (let ((struct (org-list-struct))) + (goto-char (org-list-get-bottom-point struct))))) (insert ":END:\n") (beginning-of-line 0) (org-indent-line-to ind-last) @@ -1339,7 +1381,7 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (match-string 2)))) (if newstate (org-todo newstate)))) ((and org-clock-out-switch-to-state - (not (looking-at (concat outline-regexp "[ \t]*" + (not (looking-at (concat org-outline-regexp "[ \t]*" org-clock-out-switch-to-state "\\>")))) (org-todo org-clock-out-switch-to-state)))))) @@ -1349,6 +1391,76 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (run-hooks 'org-clock-out-hook) (org-clock-delete-current)))))) +(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer) + +(defun org-clock-remove-empty-clock-drawer nil + "Remove empty clock drawer in the current subtree." + (let* ((olid (or (org-entry-get (point) "LOG_INTO_DRAWER") + org-log-into-drawer)) + (clock-drawer (if (eq t olid) "LOGBOOK" olid)) + (end (save-excursion (org-end-of-subtree t t)))) + (when clock-drawer + (save-excursion + (org-back-to-heading t) + (while (search-forward clock-drawer end t) + (goto-char (match-beginning 0)) + (org-remove-empty-drawer-at clock-drawer (point)) + (forward-line 1)))))) + +(defun org-at-clock-log-p nil + "Is the cursor on the clock log line?" + (save-excursion + (move-beginning-of-line 1) + (looking-at "^[ \t]*CLOCK:"))) + +(defun org-clock-timestamps-up nil + "Increase CLOCK timestamps at cursor." + (interactive) + (org-clock-timestamps-change 'up)) + +(defun org-clock-timestamps-down nil + "Increase CLOCK timestamps at cursor." + (interactive) + (org-clock-timestamps-change 'down)) + +(defun org-clock-timestamps-change (updown) + "Change CLOCK timestamps synchronously at cursor. +UPDOWN tells whether to change 'up or 'down." + (setq org-ts-what nil) + (when (org-at-timestamp-p t) + (let ((tschange (if (eq updown 'up) 'org-timestamp-up + 'org-timestamp-down)) + ts1 begts1 ts2 begts2 updatets1 tdiff) + (save-excursion + (move-beginning-of-line 1) + (re-search-forward org-ts-regexp3 nil t) + (setq ts1 (match-string 0) begts1 (match-beginning 0)) + (when (re-search-forward org-ts-regexp3 nil t) + (setq ts2 (match-string 0) begts2 (match-beginning 0)))) + ;; Are we on the second timestamp? + (if (<= begts2 (point)) (setq updatets1 t)) + (if (not ts2) + ;; fall back on org-timestamp-up if there is only one + (funcall tschange) + ;; setq this so that (boundp 'org-ts-what is non-nil) + (funcall tschange) + (let ((ts (if updatets1 ts2 ts1)) + (begts (if updatets1 begts1 begts2))) + (setq tdiff + (subtract-time + (org-time-string-to-time org-last-changed-timestamp) + (org-time-string-to-time ts))) + (save-excursion + (goto-char begts) + (org-timestamp-change + (round (/ (org-float-time tdiff) + (cond ((eq org-ts-what 'minute) 60) + ((eq org-ts-what 'hour) 3600) + ((eq org-ts-what 'day) (* 24 3600)) + ((eq org-ts-what 'month) (* 24 3600 31)) + ((eq org-ts-what 'year) (* 24 3600 365.2))))) + org-ts-what 'updown))))))) + (defun org-clock-cancel () "Cancel the running clock by removing the start timestamp." (interactive) @@ -1387,7 +1499,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (setq recent t) (car org-clock-history)) (t (error "No active or recent clock task"))))) - (switch-to-buffer (marker-buffer m)) + (org-pop-to-buffer-same-window (marker-buffer m)) (if (or (< m (point-min)) (> m (point-max))) (widen)) (goto-char m) (org-show-entry) @@ -1502,7 +1614,9 @@ nil are excluded from the clock summation." (defun org-clock-display (&optional total-only) "Show subtree times in the entire buffer. If TOTAL-ONLY is non-nil, only show the total time for the entire file -in the echo area." +in the echo area. + +Use \\[org-clock-remove-overlays] to remove the subtree times." (interactive) (org-clock-remove-overlays) (let (time h m p) @@ -1628,7 +1742,10 @@ fontified, and then returned." (defun org-clock-report (&optional arg) "Create a table containing a report about clocked time. If the cursor is inside an existing clocktable block, then the table -will be updated. If not, a new clocktable will be inserted. +will be updated. If not, a new clocktable will be inserted. The scope +of the new clock will be subtree when called from within a subtree, and +file elsewhere. + When called with a prefix argument, move to the first clock table in the buffer and update it." (interactive "P") @@ -1638,8 +1755,12 @@ buffer and update it." (org-show-entry)) (if (org-in-clocktable-p) (goto-char (org-in-clocktable-p)) - (org-create-dblock (append (list :name "clocktable") - org-clock-clocktable-default-properties))) + (let ((props (if (ignore-errors + (save-excursion (org-back-to-heading))) + (list :name "clocktable" :scope 'subtree) + (list :name "clocktable")))) + (org-create-dblock + (org-combine-plists org-clock-clocktable-default-properties props)))) (org-update-dblock)) (defun org-in-clocktable-p () @@ -1986,7 +2107,7 @@ the currently selected interval size." (setq level (string-to-number (match-string 1 (symbol-name scope)))) (catch 'exit (while (org-up-heading-safe) - (looking-at outline-regexp) + (looking-at org-outline-regexp) (if (<= (org-reduced-level (funcall outline-level)) level) (throw 'exit nil)))) (org-narrow-to-subtree))) @@ -2007,12 +2128,16 @@ the currently selected interval size." 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... + ;; This function looks quite complicated, mainly because there are a + ;; lot of options which can add or remove columns. I have massively + ;; commented this function, the I hope it is understandable. If + ;; someone wants to write their 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 . "/"))) + (lwords (assoc (or (plist-get params :lang) + org-export-default-language) + org-clock-clocktable-language-setup)) (multifile (plist-get params :multifile)) (block (plist-get params :block)) (ts (plist-get params :tstart)) @@ -2024,6 +2149,7 @@ from the dynamic block defintion." (emph (plist-get params :emphasize)) (level-p (plist-get params :level)) (timestamp (plist-get params :timestamp)) + (properties (plist-get params :properties)) (ntcol (max 1 (or (plist-get params :tcolumns) 100))) (rm-file-column (plist-get params :one-file-with-archives)) (indent (plist-get params :indent)) @@ -2072,7 +2198,7 @@ from the dynamic block defintion." (or header ;; Format the standard header (concat - "Clock summary at [" + (nth 9 lwords) " [" (substring (format-time-string (cdr org-time-stamp-formats)) 1 -1) @@ -2087,24 +2213,29 @@ from the dynamic block defintion." (if multifile "|" "") ; file column, maybe (if level-p "|" "") ; level column, maybe (if timestamp "|" "") ; timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ;properties columns, 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 + (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe + (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe + (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe + (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe + (concat (nth 4 lwords) "|" + (nth 5 lwords) "|\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 + "|-\n" ; a hline + "|" ; table line starter + (if multifile (concat "| " (nth 6 lwords) " ") "") + ; file column, maybe + (if level-p "|" "") ; level column, maybe + (if timestamp "|" "") ; timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ;properties columns, maybe + (concat "*" (nth 7 lwords) "*| ") ; instead of a headline "*" (org-minutes-to-hh:mm-string (or total-time 0)) ; the time "*|\n") ; close line @@ -2121,12 +2252,13 @@ from the dynamic block defintion." (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 + ;; Summarize the time collected from this file (insert-before-markers - (format "| %s %s | %s*File time* | *%s*|\n" + (format (concat "| %s %s | %s%s*" (nth 8 lwords) "* | *%s*|\n") (file-name-nondirectory (car tbl)) (if level-p "| " "") ; level column, maybe (if timestamp "| " "") ; timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ;properties columns, maybe (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time ;; Get the list of node entries and iterate over it @@ -2151,6 +2283,11 @@ from the dynamic block defintion." (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 properties + (concat + (mapconcat + (lambda (p) (or (cdr (assoc p (nth 4 entry))) "")) + properties "|") "|") "") ;properties columns, maybe (if indent (org-clocktable-indent-string level) "") ; indentation hlc headline hlc "|" ; headline (make-string (min (1- ntcol) (or (- level 1))) ?|) @@ -2305,6 +2442,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time (block (plist-get params :block)) (link (plist-get params :link)) (tags (plist-get params :tags)) + (properties (plist-get params :properties)) + (inherit-property-p (plist-get params :inherit-props)) (matcher (if tags (cdr (org-make-tags-matcher tags)))) cc range-text st p time level hdl props tsp tbl) @@ -2358,8 +2497,15 @@ TIME: The sum of all time spend in this tree, in minutes. This time (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)))))) + (cdr (assoc "TIMESTAMP_IA" props)))) + props (when properties + (remove nil + (mapcar + (lambda (p) + (when (org-entry-get (point) p inherit-property-p) + (cons p (org-entry-get (point) p inherit-property-p)))) + properties)))) + (when (> time 0) (push (list level hdl tsp time props) tbl)))))) (setq tbl (nreverse tbl)) (list file org-clock-file-total-minutes tbl)))) @@ -2387,6 +2533,8 @@ This function is made for clock tables." tot)))) 0)))) +;; Saving and loading the clock + (defvar org-clock-loaded nil "Was the clock file loaded?") @@ -2478,7 +2626,7 @@ The details of what will be saved are regulated by the variable (goto-char (cdr resume-clock)) (let ((org-clock-auto-clock-resolution nil)) (org-clock-in) - (if (org-invisible-p) + (if (outline-invisible-p) (org-show-context)))))))))) ;;;###autoload @@ -2492,6 +2640,7 @@ The details of what will be saved are regulated by the variable (provide 'org-clock) +;; 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 35a23052e8a..debc92a101d 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -1,11 +1,12 @@ ;;; org-colview.el --- Column View in Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -170,7 +171,6 @@ This is the compiled version of the format.") (color (list :foreground (face-attribute ref-face :foreground))) (face (list color 'org-column ref-face)) (face1 (list color 'org-agenda-column-dateline ref-face)) - (pl (or (get-text-property (point-at-bol) 'prefix-length) 0)) (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp)) pom property ass width f string ov column val modval s2 title calc) ;; Check if the entry is in another buffer. @@ -186,11 +186,17 @@ This is the compiled version of the format.") title (nth 1 column) ass (if (equal property "ITEM") (cons "ITEM" - (save-match-data + ;; When in a buffer, get the whole line, + ;; we'll clean it later… + (if (org-mode-p) + (save-match-data + (org-no-properties + (org-remove-tabs + (buffer-substring-no-properties + (point-at-bol) (point-at-eol))))) + ;; In agenda, just get the `txt' property (org-no-properties - (org-remove-tabs - (buffer-substring-no-properties - (point-at-bol) (point-at-eol)))))) + (org-get-at-bol 'txt)))) (assoc property props)) width (or (cdr (assoc property org-columns-current-maxwidths)) (nth 2 column) @@ -206,9 +212,7 @@ This is the compiled version of the format.") ((equal property "ITEM") (if (org-mode-p) (org-columns-cleanup-item - val org-columns-current-fmt-compiled) - (org-agenda-columns-cleanup-item - val pl cphr org-columns-current-fmt-compiled))) + val org-columns-current-fmt-compiled))) ((and calc (functionp calc) (not (string= val "")) (not (get-text-property 0 'org-computed val))) @@ -365,20 +369,6 @@ for the duration of the command.") t t s))) s) -(defvar org-agenda-columns-remove-prefix-from-item) - -(defun org-agenda-columns-cleanup-item (item pl cphr fmt) - "Cleanup the time property for agenda column view. -See also the variable `org-agenda-columns-remove-prefix-from-item'." - (let* ((org-complex-heading-regexp cphr) - (prefix (substring item 0 pl)) - (rest (substring item pl)) - (fake (concat "* " rest)) - (cleaned (org-trim (substring (org-columns-cleanup-item fake fmt) 1)))) - (if org-agenda-columns-remove-prefix-from-item - cleaned - (concat prefix cleaned)))) - (defun org-columns-show-value () "Show the full value of the property." (interactive) @@ -706,7 +696,7 @@ around it." (save-restriction (narrow-to-region beg end) (org-clock-sum)))) - (while (re-search-forward (concat "^" outline-regexp) end t) + (while (re-search-forward org-outline-regexp-bol end t) (if (and org-columns-skip-archived-trees (looking-at (concat ".*:" org-archive-tag ":"))) (org-end-of-subtree t) @@ -939,7 +929,7 @@ Don't set this, this is meant for dynamic scoping.") (defun org-columns-compute (property) "Sum the values of property PROPERTY hierarchically, for the entire buffer." (interactive) - (let* ((re (concat "^" outline-regexp)) + (let* ((re org-outline-regexp-bol) (lmax 30) ; Does anyone use deeper levels??? (lvals (make-vector lmax nil)) (lflag (make-vector lmax nil)) @@ -1536,5 +1526,6 @@ The string should be two numbers joined with a \"-\"." (provide 'org-colview) +;; arch-tag: 61f5128d-747c-4983-9479-e3871fa3d73c ;;; org-colview.el ends here diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index efe54c568b3..e96918cbcb5 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -1,11 +1,12 @@ ;;; org-compat.el --- Compatibility code for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -246,6 +247,15 @@ Works on both Emacs and XEmacs." (> (point) (region-beginning))) (exchange-point-and-mark))) +;; Emacs 22 misses `activate-mark' +(if (fboundp 'activate-mark) + (defalias 'org-activate-mark 'activate-mark) + (defun org-activate-mark () + (when (mark t) + (setq mark-active t) + (unless transient-mark-mode + (setq transient-mark-mode 'lambda))))) + ;; Invisibility compatibility (defun org-remove-from-invisibility-spec (arg) @@ -423,7 +433,17 @@ With two arguments, return floor and remainder of their quotient." (let ((q (floor x y))) (list q (- x (if y (* y q) q))))) +;; `pop-to-buffer-same-window' has been introduced with Emacs 24.1. +(defun org-pop-to-buffer-same-window + (&optional buffer-or-name norecord label) + "Pop to buffer specified by BUFFER-OR-NAME in the selected window." + (if (fboundp 'pop-to-buffer-same-window) + (funcall + 'pop-to-buffer-same-window buffer-or-name norecord label) + (funcall 'switch-to-buffer buffer-or-name norecord))) + (provide 'org-compat) +;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe ;;; org-compat.el ends here diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index 0a6001bf62a..28d92cc63f7 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -1,10 +1,10 @@ ;;; org-crypt.el --- Public key encryption for org-mode entries -;; Copyright (C) 2007, 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2009, 2010 Free Software Foundation, Inc. ;; Emacs Lisp Archive Entry ;; Filename: org-crypt.el -;; Version: 7.4 +;; Version: 7.7 ;; Keywords: org-mode ;; Author: John Wiegley <johnw@gnu.org> ;; Maintainer: Peter Jones <pjones@pmade.com> @@ -56,9 +56,6 @@ ;; 4. To automatically encrypt all necessary entries when saving a ;; file, call `org-crypt-use-before-save-magic' after loading ;; org-crypt.el. -;; -;; TODO: -;; - Allow symmetric encryption as well ;;; Thanks: @@ -80,19 +77,45 @@ (defgroup org-crypt nil "Org Crypt" - :tag "Org Crypt" :group 'org) + :tag "Org Crypt" + :group 'org) (defcustom org-crypt-tag-matcher "crypt" "The tag matcher used to find headings whose contents should be encrypted. See the \"Match syntax\" section of the org manual for more details." - :type 'string :group 'org-crypt) + :type 'string + :group 'org-crypt) -(defcustom org-crypt-key nil +(defcustom org-crypt-key "" "The default key to use when encrypting the contents of a heading. This setting can also be overridden in the CRYPTKEY property." - :type 'string :group 'org-crypt) + :type 'string + :group 'org-crypt) + +(defcustom org-crypt-disable-auto-save 'ask + "What org-decrypt should do if `auto-save-mode' is enabled. + +t : Disable auto-save-mode for the current buffer + prior to decrypting an entry. + +nil : Leave auto-save-mode enabled. + This may cause data to be written to disk unencrypted! + +'ask : Ask user whether or not to disable auto-save-mode + for the current buffer. + +'encrypt : Leave auto-save-mode enabled for the current buffer, + but automatically re-encrypt all decrypted entries + *before* auto-saving. + NOTE: This only works for entries which have a tag + that matches `org-crypt-tag-matcher'." + :group 'org-crypt + :type '(choice (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "Ask" ask) + (const :tag "Encrypt" encrypt))) (defun org-crypt-key-for-heading () "Return the encryption key for the current heading." @@ -103,6 +126,15 @@ This setting can also be overridden in the CRYPTKEY property." (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to) (message "No crypt key set, using symmetric encryption.")))) +(defun org-encrypt-string (str crypt-key) + "Return STR encrypted with CRYPT-KEY." + ;; Text and key have to be identical, otherwise we re-crypt. + (if (and (string= crypt-key (get-text-property 0 'org-crypt-key str)) + (string= (sha1 str) (get-text-property 0 'org-crypt-checksum str))) + (get-text-property 0 'org-crypt-text str) + (let ((epg-context (epg-make-context nil t t))) + (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key))))) + (defun org-encrypt-entry () "Encrypt the content of the current headline." (interactive) @@ -112,7 +144,7 @@ This setting can also be overridden in the CRYPTKEY property." (let ((start-heading (point))) (forward-line) (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) - (let ((folded (org-invisible-p)) + (let ((folded (outline-invisible-p)) (epg-context (epg-make-context nil t t)) (crypt-key (org-crypt-key-for-heading)) (beg (point)) @@ -122,10 +154,7 @@ This setting can also be overridden in the CRYPTKEY property." (org-back-over-empty-lines) (setq end (point) encrypted-text - (epg-encrypt-string - epg-context - (buffer-substring-no-properties beg end) - (epg-list-keys epg-context crypt-key))) + (org-encrypt-string (buffer-substring beg end) crypt-key)) (delete-region beg end) (insert encrypted-text) (when folded @@ -136,27 +165,68 @@ This setting can also be overridden in the CRYPTKEY property." (defun org-decrypt-entry () "Decrypt the content of the current headline." (interactive) + + ; auto-save-mode may cause leakage, so check whether it's enabled. + (when buffer-auto-save-file-name + (cond + ((or + (eq org-crypt-disable-auto-save t) + (and + (eq org-crypt-disable-auto-save 'ask) + (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? "))) + (message (concat "org-decrypt: Disabling auto-save-mode for " (or (buffer-file-name) (current-buffer)))) + ; The argument to auto-save-mode has to be "-1", since + ; giving a "nil" argument toggles instead of disabling. + (auto-save-mode -1)) + ((eq org-crypt-disable-auto-save nil) + (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage.")) + ((eq org-crypt-disable-auto-save 'encrypt) + (message "org-decrypt: Enabling re-encryption on auto-save.") + (add-hook 'auto-save-hook + (lambda () + (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.") + (org-encrypt-entries)) + nil t)) + (t nil))) + (require 'epg) (unless (org-before-first-heading-p) (save-excursion (org-back-to-heading t) - (forward-line) - (when (looking-at "-----BEGIN PGP MESSAGE-----") - (let* ((beg (point)) - (end (save-excursion - (search-forward "-----END PGP MESSAGE-----") - (forward-line) - (point))) - (epg-context (epg-make-context nil t t)) - (decrypted-text - (decode-coding-string - (epg-decrypt-string - epg-context - (buffer-substring-no-properties beg end)) - 'utf-8))) - (delete-region beg end) - (insert decrypted-text) - nil))))) + (let ((heading-point (point)) + (heading-was-invisible-p + (save-excursion + (outline-end-of-heading) + (outline-invisible-p)))) + (forward-line) + (when (looking-at "-----BEGIN PGP MESSAGE-----") + (let* ((end (save-excursion + (search-forward "-----END PGP MESSAGE-----") + (forward-line) + (point))) + (epg-context (epg-make-context nil t t)) + (encrypted-text (buffer-substring-no-properties (point) end)) + (decrypted-text + (decode-coding-string + (epg-decrypt-string + epg-context + encrypted-text) + 'utf-8))) + ;; Delete region starting just before point, because the + ;; outline property starts at the \n of the heading. + (delete-region (1- (point)) end) + ;; Store a checksum of the decrypted and the encrypted + ;; text value. This allow to reuse the same encrypted text + ;; if the text does not change, and therefore avoid a + ;; re-encryption process. + (insert "\n" (propertize decrypted-text + 'org-crypt-checksum (sha1 decrypted-text) + 'org-crypt-key (org-crypt-key-for-heading) + 'org-crypt-text encrypted-text)) + (when heading-was-invisible-p + (goto-char heading-point) + (org-flag-subtree t)) + nil)))))) (defun org-encrypt-entries () "Encrypt all top-level entries in the current buffer." @@ -182,5 +252,6 @@ This setting can also be overridden in the CRYPTKEY property." (provide 'org-crypt) +;; arch-tag: 8202ed2c-221e-4001-9e4b-54674a7e846e ;;; org-crypt.el ends here diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 3bbfe18e1b4..f28823f30e9 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -1,12 +1,12 @@ ;;; org-ctags.el - Integrate Emacs "tags" facility with org mode. ;; -;; Copyright (C) 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Paul Sexton <eeeickythump@gmail.com> -;; Version: 7.4 +;; Version: 7.7 ;; Keywords: org, wp -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -140,6 +140,8 @@ (require 'org) +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) + (defgroup org-ctags nil "Options concerning use of ctags within org mode." :tag "Org-Ctags" @@ -385,7 +387,7 @@ the new file." (cond ((get-buffer (concat name ".org")) ;; Buffer is already open - (switch-to-buffer (get-buffer (concat name ".org")))) + (org-pop-to-buffer-same-window (get-buffer (concat name ".org")))) ((file-exists-p filename) ;; File exists but is not open --> open it (message "Opening existing org file `%S'..." @@ -537,4 +539,5 @@ a new topic." (provide 'org-ctags) +;; arch-tag: 4b1ddd5a-8529-4b17-bcde-96a922d26343 ;;; org-ctags.el ends here diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index 47ca287d8fc..11e81a8a155 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -1,11 +1,11 @@ ;;; org-datetree.el --- Create date entries in a tree -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -64,7 +64,7 @@ tree can be found." (goto-char (prog1 (point) (widen)))))) (defun org-datetree-find-year-create (year) - (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)[ \t\n]") + (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)$") match) (goto-char (point-min)) (while (and (setq match (re-search-forward re nil t)) @@ -83,7 +83,7 @@ tree can be found." (defun org-datetree-find-month-create (year month) (org-narrow-to-subtree) - (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\)[ \t\n]" year)) + (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year)) match) (goto-char (point-min)) (while (and (setq match (re-search-forward re nil t)) @@ -102,7 +102,7 @@ tree can be found." (defun org-datetree-find-day-create (year month day) (org-narrow-to-subtree) - (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\)[ \t\n]" year month)) + (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month)) match) (goto-char (point-min)) (while (and (setq match (re-search-forward re nil t)) @@ -195,5 +195,6 @@ before running this command, even though the command tries to be smart." (provide 'org-datetree) +;; arch-tag: 1daea962-fd08-448b-9f98-6e8b511b3601 ;;; org-datetree.el ends here diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el index e883d71b6f4..bb17a4dcde2 100644 --- a/lisp/org/org-docbook.el +++ b/lisp/org/org-docbook.el @@ -1,10 +1,10 @@ ;;; org-docbook.el --- DocBook exporter for org-mode ;; -;; Copyright (C) 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; ;; Emacs Lisp Archive Entry ;; Filename: org-docbook.el -;; Version: 7.4 +;; Version: 7.7 ;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Keywords: org, wp, docbook @@ -148,6 +148,11 @@ avoid same set of footnote IDs being used multiple times." :group 'org-export-docbook :type 'string) +(defcustom org-export-docbook-footnote-separator "<superscript>, </superscript>" + "Text used to separate footnotes." + :group 'org-export-docbook + :type 'string) + (defcustom org-export-docbook-emphasis-alist `(("*" "<emphasis role=\"bold\">" "</emphasis>") ("/" "<emphasis>" "</emphasis>") @@ -320,7 +325,7 @@ could call this function in the following way: When called interactively, the output buffer is selected, and shown in a window. A non-interactive call will only return the buffer." (interactive "r\nP") - (when (interactive-p) + (when (org-called-interactively-p 'any) (setq buffer "*Org DocBook Export*")) (let ((transient-mark-mode t) (zmacs-regions t) @@ -332,7 +337,7 @@ in a window. A non-interactive call will only return the buffer." nil nil buffer body-only)) (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (interactive-p) (bufferp rtn)) + (if (and (org-called-interactively-p 'any) (bufferp rtn)) (switch-to-buffer-other-window rtn) rtn))) @@ -499,9 +504,6 @@ publishing directory." (inquote nil) (infixed nil) (inverse nil) - (in-local-list nil) - (local-list-type nil) - (local-list-indent nil) (llt org-plain-list-ordered-item-terminator) (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) @@ -522,16 +524,19 @@ publishing directory." (buffer-substring (if region-p (region-beginning) (point-min)) (if region-p (region-end) (point-max)))) + (org-export-footnotes-seen nil) + (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) (lines (org-split-string (org-export-preprocess-string region :emph-multiline t - :for-docbook t + :for-backend 'docbook :skip-before-1st-heading (plist-get opt-plist :skip-before-1st-heading) :drawers (plist-get opt-plist :drawers) :todo-keywords (plist-get opt-plist :todo-keywords) + :tasks (plist-get opt-plist :tasks) :tags (plist-get opt-plist :tags) :priority (plist-get opt-plist :priority) :footnotes (plist-get opt-plist :footnotes) @@ -646,7 +651,7 @@ publishing directory." (catch 'nextline ;; End of quote section? - (when (and inquote (string-match "^\\*+ " line)) + (when (and inquote (string-match org-outline-regexp-bol line)) (insert "]]></programlisting>\n") (org-export-docbook-open-para) (setq inquote nil)) @@ -671,22 +676,6 @@ publishing directory." (org-export-docbook-open-para)) (throw 'nextline nil)) - ;; List ender: close every open list. - (when (equal "ORG-LIST-END" line) - (while local-list-type - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type)) - ;; We did close a list, normal text follows: need <para> - (org-export-docbook-open-para) - (setq local-list-indent nil - in-local-list nil) - (throw 'nextline nil)) - ;; Protected HTML (when (get-text-property 0 'org-protected line) (let (par (ind (get-text-property 0 'original-indentation line))) @@ -947,7 +936,10 @@ publishing directory." (when org-export-with-footnotes (setq start 0) (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start) - (if (get-text-property (match-beginning 2) 'org-protected line) + ;; Discard protected matches not clearly identified as + ;; footnote markers. + (if (or (get-text-property (match-beginning 2) 'org-protected line) + (not (get-text-property (match-beginning 2) 'org-footnote line))) (setq start (match-end 2)) (let* ((num (match-string 2 line)) (footnote-def (assoc num footnote-list))) @@ -958,14 +950,22 @@ publishing directory." org-export-docbook-footnote-id-prefix num) t t line)) (setq line (replace-match - (format "%s<footnote xml:id=\"%s%s\"><para>%s</para></footnote>" - (match-string 1 line) - org-export-docbook-footnote-id-prefix - num - (if footnote-def - (save-match-data - (org-docbook-expand (cdr footnote-def))) - (format "FOOTNOTE DEFINITION NOT FOUND: %s" num))) + (concat + (format "%s<footnote xml:id=\"%s%s\"><para>%s</para></footnote>" + (match-string 1 line) + org-export-docbook-footnote-id-prefix + num + (if footnote-def + (save-match-data + (org-docbook-expand (cdr footnote-def))) + (format "FOOTNOTE DEFINITION NOT FOUND: %s" num))) + ;; If another footnote is following the + ;; current one, add a separator. + (if (save-match-data + (string-match "\\`\\[[0-9]+\\]" + (substring line (match-end 0)))) + org-export-docbook-footnote-separator + "")) t t line)) (push (cons num 1) footref-seen)))))) @@ -1008,93 +1008,15 @@ publishing directory." (org-format-table-html table-buffer table-orig-buffer 'no-css))))) + ;; Normal lines (t - ;; Normal lines - (when (string-match - (cond - ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) - line) - (setq ind (or (get-text-property 0 'original-indentation line) - (org-get-string-indentation line)) - item-type (if (match-beginning 4) "o" "u") - starter (if (match-beginning 2) - (substring (match-string 2 line) 0 -1)) - line (substring line (match-beginning 5)) - item-tag nil - item-number nil) - (if (string-match "\\[@\\(?:start:\\)?\\([0-9]+\\)\\][ \t]?" line) - (setq item-number (match-string 1 line) - line (replace-match "" t t line))) - (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) - (setq item-type "d" - item-tag (match-string 1 line) - line (substring line (match-end 0)))) - (cond - ((and starter - (or (not in-local-list) - (> ind (car local-list-indent)))) - ;; Start new (level of) list - (org-export-docbook-close-para-maybe) - (insert (cond - ((equal item-type "u") "<itemizedlist>\n<listitem>\n") - ((and (equal item-type "o") item-number) - ;; Check for a specific start number. If it - ;; is specified, we use the ``override'' - ;; attribute of element <listitem> to pass the - ;; info to DocBook. We could also use the - ;; ``startingnumber'' attribute of element - ;; <orderedlist>, but the former works on both - ;; DocBook 5.0 and prior versions. - (format "<orderedlist>\n<listitem override=\"%s\">\n" item-number)) - ((equal item-type "o") "<orderedlist>\n<listitem>\n") - ((equal item-type "d") - (format "<variablelist>\n<varlistentry><term>%s</term><listitem>\n" item-tag)))) - ;; For DocBook, we need to open a para right after tag - ;; <listitem>. - (org-export-docbook-open-para) - (push item-type local-list-type) - (push ind local-list-indent) - (setq in-local-list t)) - ;; Continue current list - (starter - ;; terminate any previous sublist but first ensure - ;; list is not ill-formed - (let ((min-ind (apply 'min local-list-indent))) - (when (< ind min-ind) (setq ind min-ind))) - (while (< ind (car local-list-indent)) - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) - ;; insert new item - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((and (equal listtype "o") item-number) - (format "<listitem override=\"%s\">" item-number)) - ((equal listtype "o") "<listitem>") - ((equal listtype "u") "<listitem>") - ((equal listtype "d") (format - "<varlistentry><term>%s</term><listitem>" - (or item-tag - "???")))))) - ;; For DocBook, we need to open a para right after tag - ;; <listitem>. - (org-export-docbook-open-para))) - ;; Checkboxes. - (if (string-match "^[ \t]*\\(\\[[X -]\\]\\)" line) - (setq line - (replace-match (concat checkbox-start - (match-string 1 line) - checkbox-end) - t t line)))) + ;; This line either is list item or end a list. + (when (when (get-text-property 0 'list-item line) + (setq line (org-export-docbook-list-line + line + (get-text-property 0 'list-item line) + (get-text-property 0 'list-struct line) + (get-text-property 0 'list-prevs line))))) ;; Empty lines start a new paragraph. If hand-formatted lists ;; are not fully interpreted, lines starting with "-", "+", "*" @@ -1138,20 +1060,12 @@ publishing directory." (if (eq major-mode (default-value 'major-mode)) (nxml-mode))) - ;; Remove empty paragraphs and lists. Replace them with a - ;; newline. + ;; Remove empty paragraphs. Replace them with a newline. (goto-char (point-min)) (while (re-search-forward "[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t) (when (not (get-text-property (match-beginning 1) 'org-protected)) (replace-match "\n") - ;; Avoid empty <listitem></listitem> caused by inline tasks. - ;; We should add an empty para to make everything valid. - (when (and (looking-at "</listitem>") - (save-excursion - (backward-char (length "<listitem>\n")) - (looking-at "<listitem>"))) - (insert "<para></para>")) (backward-char 1))) ;; Fill empty sections with <para></para>. This is to make sure ;; that the DocBook document generated is valid and well-formed. @@ -1193,10 +1107,6 @@ publishing directory." (insert "</listitem></varlistentry>\n") (insert "</listitem>\n"))) -(defvar in-local-list) -(defvar local-list-indent) -(defvar local-list-type) - (defun org-export-docbook-level-start (level title) "Insert a new level in DocBook export. When TITLE is nil, just close all open levels." @@ -1367,7 +1277,7 @@ TABLE is a string containing the HTML code generated by (match-string 1 table) (match-string 4 table) "</table>") - nil nil table) + nil t table) table)) ;; Change <table> into <informaltable> if caption does not exist. (if (string-match @@ -1377,7 +1287,7 @@ TABLE is a string containing the HTML code generated by (match-string 1 table-with-label) (match-string 3 table-with-label) "</informaltable>") - nil nil table-with-label) + nil t table-with-label) table-with-label))) ;; Note: This function is very similar to @@ -1438,6 +1348,102 @@ that need to be preserved in later phase of DocBook exporting." line (substring line (match-end 0)))) (concat replaced line))) +(defun org-export-docbook-list-line (line pos struct prevs) + "Insert list syntax in export buffer. Return LINE, maybe modified. + +POS is the item position or line position the line had before +modifications to buffer. STRUCT is the list structure. PREVS is +the alist of previous items." + (let* ((get-type + (function + ;; Translate type of list containing POS to "ordered", + ;; "variable" or "itemized". + (lambda (pos struct prevs) + (let ((type (org-list-get-list-type pos struct prevs))) + (cond + ((eq 'ordered type) "ordered") + ((eq 'descriptive type) "variable") + (t "itemized")))))) + (get-closings + (function + ;; Return list of all items and sublists ending at POS, in + ;; reverse order. + (lambda (pos) + (let (out) + (catch 'exit + (mapc (lambda (e) + (let ((end (nth 6 e)) + (item (car e))) + (cond + ((= end pos) (push item out)) + ((>= item pos) (throw 'exit nil))))) + struct)) + out))))) + ;; First close any previous item, or list, ending at POS. + (mapc (lambda (e) + (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) + (first-item (org-list-get-list-begin e struct prevs)) + (type (funcall get-type first-item struct prevs))) + ;; Ending for every item + (org-export-docbook-close-para-maybe) + (insert (if (equal type "variable") + "</listitem></varlistentry>\n" + "</listitem>\n")) + ;; We're ending last item of the list: end list. + (when lastp + (insert (format "</%slist>\n" type)) + (org-export-docbook-open-para)))) + (funcall get-closings pos)) + (cond + ;; At an item: insert appropriate tags in export buffer. + ((assq pos struct) + (string-match (concat "[ \t]*\\(\\S-+[ \t]*\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\][ \t]*\\)?" + "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" + "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" + "\\(.*\\)") + line) + (let* ((checkbox (match-string 3 line)) + (desc-tag (or (match-string 4 line) "???")) + (body (match-string 5 line)) + (list-beg (org-list-get-list-begin pos struct prevs)) + (firstp (= list-beg pos)) + ;; Always refer to first item to determine list type, in + ;; case list is ill-formed. + (type (funcall get-type list-beg struct prevs)) + ;; Special variables for ordered lists. + (counter (let ((count-tmp (org-list-get-counter pos struct))) + (cond + ((not count-tmp) nil) + ((string-match "[A-Za-z]" count-tmp) + (- (string-to-char (upcase count-tmp)) 64)) + ((string-match "[0-9]+" count-tmp) + count-tmp))))) + ;; When FIRSTP, a new list or sub-list is starting. + (when firstp + (org-export-docbook-close-para-maybe) + (insert (format "<%slist>\n" type))) + (insert (cond + ((equal type "variable") + (format "<varlistentry><term>%s</term><listitem>" desc-tag)) + ((and (equal type "ordered") counter) + (format "<listitem override=\"%s\">" counter)) + (t "<listitem>"))) + ;; For DocBook, we need to open a para right after tag + ;; <listitem>. + (org-export-docbook-open-para) + ;; If line had a checkbox, some additional modification is required. + (when checkbox (setq body (concat checkbox " " body))) + ;; Return modified line + body)) + ;; At a list ender: normal text follows: need <para>. + ((equal "ORG-LIST-END-MARKER" line) + (org-export-docbook-open-para) + (throw 'nextline nil)) + ;; Not at an item: return line unchanged (side-effects only). + (t line)))) + (provide 'org-docbook) +;; arch-tag: a24a127c-d365-4c2a-9e9b-f7dcb0ebfdc3 ;;; org-docbook.el ends here diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el index ee39d8afc63..e13cdfd666a 100644 --- a/lisp/org/org-docview.el +++ b/lisp/org/org-docview.el @@ -1,11 +1,11 @@ ;;; org-docview.el --- support for links to doc-view-mode buffers -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Jan Böcker <jan.boecker at jboecker dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -88,5 +88,6 @@ and append it." (provide 'org-docview) +;; arch-tag: dd147a78-cce1-481b-b40a-15869417debe ;;; org-docview.el ends here diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 7115972b73e..0146abb07cf 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -1,12 +1,12 @@ ;;; org-entities.el --- Support for special entities in Org-mode -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org>, ;; Ulf Stegemann <ulf at zeitform dot de> ;; Keywords: outlines, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -304,7 +304,7 @@ loaded, add these packages to `org-export-latex-packages-alist'." ("prod" "\\prod" t "∏" "[product]" "[n-ary product]" "∏") ("micro" "\\textmu{}" nil "µ" "micro" "µ" "µ") ("macr" "\\textasciimacron{}" nil "¯" "[macron]" "¯" "¯") - ("deg" "\\textdegree{}" nil "deg" "degree" "°" "°") + ("deg" "\\textdegree{}" nil "°" "degree" "°" "°") ("prime" "\\prime" t "′" "'" "'" "′") ("Prime" "\\prime{}\\prime" t "″" "''" "''" "″") ("infin" "\\propto" t "∞" "[infinity]" "[infinity]" "∞") @@ -568,5 +568,6 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." ;; coding: utf-8 ;; End: +;; arch-tag: e6bd163f-7419-4009-9c93-a74623016424 ;;; org-entities.el ends here diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el index f5b635838fe..43cb9d10f03 100644 --- a/lisp/org/org-exp-blocks.el +++ b/lisp/org/org-exp-blocks.el @@ -1,9 +1,10 @@ ;;; org-exp-blocks.el --- pre-process blocks when exporting org files -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Eric Schulte -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. ;; @@ -47,13 +48,15 @@ ;; ;;; Currently Implemented Block Types ;; -;; ditaa :: Convert ascii pictures to actual images using ditaa +;; ditaa :: (DEPRECATED--use "#+begin_src ditaa" code blocks) Convert +;; ascii pictures to actual images using ditaa ;; http://ditaa.sourceforge.net/. To use this set ;; `org-ditaa-jar-path' to the path to ditaa.jar on your ;; system (should be set automatically in most cases) . ;; -;; dot :: Convert graphs defined using the dot graphing language to -;; images using the dot utility. For information on dot see +;; dot :: (DEPRECATED--use "#+begin_src dot" code blocks) Convert +;; graphs defined using the dot graphing language to images +;; using the dot utility. For information on dot see ;; http://www.graphviz.org/ ;; ;; comment :: Wrap comments with titles and author information, in @@ -73,11 +76,6 @@ (require 'cl)) (require 'org) -(defvar htmlp) -(defvar latexp) -(defvar docbookp) -(defvar asciip) - (defun org-export-blocks-set (var value) "Set the value of `org-export-blocks' and install fontification." (set var value) @@ -170,33 +168,52 @@ which defaults to the value of `org-export-blocks-witheld'." (save-window-excursion (let ((case-fold-search t) (types '()) - indentation type func start body headers preserve-indent progress-marker) + matched indentation type func + start end body headers preserve-indent progress-marker) (flet ((interblock (start end) (mapcar (lambda (pair) (funcall (second pair) start end)) org-export-interblocks))) (goto-char (point-min)) (setq start (point)) - (while (re-search-forward - "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n][ \t]*#\\+end_\\S-+.*[\r\n]?" nil t) - (setq indentation (length (match-string 1))) - (setq type (intern (downcase (match-string 2)))) - (setq headers (save-match-data (org-split-string (match-string 3) "[ \t]+"))) - (setq body (match-string 4)) - (setq preserve-indent (or org-src-preserve-indentation (member "-i" headers))) - (unless preserve-indent - (setq body (save-match-data (org-remove-indentation body)))) - (unless (memq type types) (setq types (cons type types))) - (save-match-data (interblock start (match-beginning 0))) - (when (setq func (cadr (assoc type org-export-blocks))) - (let ((replacement (save-match-data - (if (memq type org-export-blocks-witheld) "" - (apply func body headers))))) - (when replacement - (replace-match replacement t t) - (unless preserve-indent - (indent-code-rigidly - (match-beginning 0) (match-end 0) indentation))))) - (setq start (match-end 0))) + (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]")) + (while (re-search-forward beg-re nil t) + (let* ((match-start (match-beginning 0)) + (body-start (match-end 0)) + (indentation (length (match-string 1))) + (inner-re (format "[\r\n]*[ \t]*#\\+\\(begin\\|end\\)_%s" + (regexp-quote (downcase (match-string 2))))) + (type (intern (downcase (match-string 2)))) + (headers (save-match-data + (org-split-string (match-string 3) "[ \t]+"))) + (balanced 1) + (preserve-indent (or org-src-preserve-indentation + (member "-i" headers))) + match-end) + (while (and (not (zerop balanced)) + (re-search-forward inner-re nil t)) + (if (string= (downcase (match-string 1)) "end") + (decf balanced) + (incf balanced))) + (when (not (zerop balanced)) + (error "unbalanced begin/end_%s blocks with %S" + type (buffer-substring match-start (point)))) + (setq match-end (match-end 0)) + (unless preserve-indent + (setq body (save-match-data (org-remove-indentation + (buffer-substring + body-start (match-beginning 0)))))) + (unless (memq type types) (setq types (cons type types))) + (save-match-data (interblock start match-start)) + (when (setq func (cadr (assoc type org-export-blocks))) + (let ((replacement (save-match-data + (if (memq type org-export-blocks-witheld) "" + (apply func body headers))))) + (when replacement + (delete-region match-start match-end) + (goto-char match-start) (insert replacement) + (unless preserve-indent + (indent-code-rigidly match-start (point) indentation)))))) + (setq start (point)))) (interblock start (point-max)) (run-hooks 'org-export-blocks-postblock-hook))))) @@ -216,12 +233,15 @@ which defaults to the value of `org-export-blocks-witheld'." (file-name-directory (or load-file-name buffer-file-name))))))) "Path to the ditaa jar executable.") +(defvar org-export-current-backend) ; dynamically bound in org-exp.el (defun org-export-blocks-format-ditaa (body &rest headers) - "Pass block BODY to the ditaa utility creating an image. + "DEPRECATED: use begin_src ditaa code blocks + +Pass block BODY to the ditaa utility creating an image. Specify the path at which the image should be saved as the first element of headers, any additional elements of headers will be passed to the ditaa utility as command line arguments." - (message "ditaa-formatting...") + (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks") (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) (data-file (make-temp-file "org-ditaa")) (hash (progn @@ -240,8 +260,9 @@ passed to the ditaa utility as command line arguments." (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1))) (org-split-string body "\n") "\n"))) + (prog1 (cond - ((or htmlp latexp docbookp) + ((member org-export-current-backend '(html latex docbook)) (unless (file-exists-p out-file) (mapc ;; remove old hashed versions of this file (lambda (file) @@ -261,13 +282,16 @@ passed to the ditaa utility as command line arguments." (t (concat "\n#+BEGIN_EXAMPLE\n" body (if (string-match "\n$" body) "" "\n") - "#+END_EXAMPLE\n"))))) + "#+END_EXAMPLE\n"))) + (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")))) ;;-------------------------------------------------------------------------------- ;; dot: create graphs using the dot graphing language ;; (require the dot executable to be in your path) (defun org-export-blocks-format-dot (body &rest headers) - "Pass block BODY to the dot graphing utility creating an image. + "DEPRECATED: use \"#+begin_src dot\" code blocks + +Pass block BODY to the dot graphing utility creating an image. Specify the path at which the image should be saved as the first element of headers, any additional elements of headers will be passed to the dot utility as command line arguments. Don't @@ -283,7 +307,7 @@ digraph data_relationships { \"data_requirement\" -> \"data_product\" } #+end_dot" - (message "dot-formatting...") + (message "begin_dot blocks are DEPRECATED, use begin_src blocks") (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) (data-file (make-temp-file "org-ditaa")) (hash (progn @@ -295,28 +319,30 @@ digraph data_relationships { (match-string 2 raw-out-file)) (cons raw-out-file "png"))) (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) + (prog1 (cond - ((or htmlp latexp docbookp) + ((member org-export-current-backend '(html latex docbook)) (unless (file-exists-p out-file) - (mapc ;; remove old hashed versions of this file - (lambda (file) - (when (and (string-match (concat (regexp-quote (car out-file-parts)) - "_\\([[:alnum:]]+\\)\\." - (regexp-quote (cdr out-file-parts))) - file) - (= (length (match-string 1 out-file)) 40)) - (delete-file (expand-file-name file - (file-name-directory out-file))))) - (directory-files (or (file-name-directory out-file) - default-directory))) - (with-temp-file data-file (insert body)) - (message (concat "dot " data-file " " args " -o " out-file)) - (shell-command (concat "dot " data-file " " args " -o " out-file))) + (mapc ;; remove old hashed versions of this file + (lambda (file) + (when (and (string-match (concat (regexp-quote (car out-file-parts)) + "_\\([[:alnum:]]+\\)\\." + (regexp-quote (cdr out-file-parts))) + file) + (= (length (match-string 1 out-file)) 40)) + (delete-file (expand-file-name file + (file-name-directory out-file))))) + (directory-files (or (file-name-directory out-file) + default-directory))) + (with-temp-file data-file (insert body)) + (message (concat "dot " data-file " " args " -o " out-file)) + (shell-command (concat "dot " data-file " " args " -o " out-file))) (format "\n[[file:%s]]\n" out-file)) (t (concat "\n#+BEGIN_EXAMPLE\n" body (if (string-match "\n$" body) "" "\n") - "#+END_EXAMPLE\n"))))) + "#+END_EXAMPLE\n"))) + (message "begin_dot blocks are DEPRECATED, use begin_src blocks")))) ;;-------------------------------------------------------------------------------- ;; comment: export comments in author-specific css-stylable divs @@ -327,17 +353,17 @@ other backends, it converts the comment into an EXAMPLE segment." (let ((owner (if headers (car headers))) (title (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))) (cond - (htmlp ;; We are exporting to HTML + ((eq org-export-current-backend 'html) ;; We are exporting to HTML (concat "#+BEGIN_HTML\n" "<div class=\"org-comment\"" (if owner (format " id=\"org-comment-%s\" " owner)) ">\n" (if owner (concat "<b>" owner "</b> ") "") - (if (and title (> (length title) 0)) (concat " -- " title "</br>\n") "</br>\n") + (if (and title (> (length title) 0)) (concat " -- " title "<br/>\n") "<br/>\n") "<p>\n" "#+END_HTML\n" body - "#+BEGIN_HTML\n" + "\n#+BEGIN_HTML\n" "</p>\n" "</div>\n" "#+END_HTML\n")) @@ -351,4 +377,5 @@ other backends, it converts the comment into an EXAMPLE segment." (provide 'org-exp-blocks) +;; arch-tag: 1c365fe9-8808-4f72-bb15-0b00f36d8024 ;;; org-exp-blocks.el ends here diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el index 3278d108b52..b00e86dabf6 100644 --- a/lisp/org/org-exp.el +++ b/lisp/org/org-exp.el @@ -1,11 +1,12 @@ ;;; org-exp.el --- ASCII, HTML, XOXO and iCalendar export for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -47,7 +48,16 @@ (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) (declare-function org-table-cookie-line-p "org-table" (line)) (declare-function org-table-colgroup-line-p "org-table" (line)) +(declare-function org-pop-to-buffer-same-window "org-compat" + (&optional buffer-or-name norecord label)) + (autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t) + +(autoload 'org-export-as-odt "org-odt" + "Export the outline to a OpenDocumentText file." t) +(autoload 'org-export-as-odt-and-open "org-odt" + "Export the outline to a OpenDocumentText file and open it." t) + (defgroup org-export nil "Options for exporting org-listings." :tag "Org Export" @@ -87,7 +97,7 @@ is nil, the buffer remains buried also in these cases." (defcustom org-export-kill-product-buffer-when-displayed nil "Non-nil means kill the product buffer if it is displayed immediately. -This applied to the commands `org-export-html-and-open' and +This applied to the commands `org-export-as-html-and-open' and `org-export-as-pdf-and-open'." :group 'org-export-general :type 'boolean) @@ -108,6 +118,14 @@ force an export command into the current process." :group 'org-export-general :type 'boolean) +(defcustom org-export-initial-scope 'buffer + "The initial scope when exporting with `org-export'. +This variable can be either set to 'buffer or 'subtree." + :group 'org-export-general + :type '(choice + (const :tag "Export current buffer" 'buffer) + (const :tag "Export current subtree" 'subtree))) + (defcustom org-export-select-tags '("export") "Tags that select a tree for export. If any such tag is found in a buffer, all trees that do not carry one @@ -195,8 +213,9 @@ or use the +OPTION lines for a per-file setting." (string :tag "Footnotes")))) (defcustom org-export-default-language "en" - "The default language of HTML export, as a string. -This should have an association in `org-export-language-setup'." + "The default language for export and clocktable translations, as a string. +This should have an association in `org-export-language-setup' +and in `org-clock-clocktable-language-setup'." :group 'org-export-general :type 'string) @@ -286,6 +305,23 @@ When nil, remove all these keywords from the export." :group 'org-export-general :type 'boolean) +(defcustom org-export-with-tasks t + "Non-nil means include TODO items for export. +This may have the following values: +t include tasks independent of state. +todo include only tasks that are not yet done. +done include only tasks that are already done. +nil remove all tasks before export +list of TODO kwds keep only tasks with these keywords" + :group 'org-export-general + :type '(choice + (const :tag "All tasks" t) + (const :tag "No tasks" nil) + (const :tag "Not-done tasks" todo) + (const :tag "Only done tasks" done) + (repeat :tag "Specific TODO keywords" + (string :tag "Keyword")))) + (defcustom org-export-with-priority nil "Non-nil means include priority cookies in export. When nil, remove priority cookies for export." @@ -387,7 +423,7 @@ Good for general initialization") "Hook for preprocessing an export buffer. Pretty much the first thing when exporting is running this hook. Point will be in a temporary buffer that contains a copy of -the original buffer, or of the section that is being export. +the original buffer, or of the section that is being exported. All the other hooks in the org-export-preprocess... category also work in that temporary buffer, already modified by various stages of the processing.") @@ -474,15 +510,15 @@ This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." "Non-nil means process LaTeX math fragments for HTML display. When set, the exporter will find and process LaTeX environments if the \\begin line is the first non-white thing on a line. It will also find -and process the math delimiters like $a=b$ and \\( a=b \\) for inline math, -$$a=b$$ and \\[ a=b \\] for display math. +and process the math delimiters like $a=b$ and \\( a=b \\) for inline math, +$$a=b$$ and \\=\\[ a=b \\] for display math. This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\". Allowed values are: nil Don't do anything. -verbatim Keep eveything in verbatim +verbatim Keep everything in verbatim dvipng Process the LaTeX fragments to images. This will also include processing of non-math environments. t Do MathJax preprocessing if there is at least on math snippet, @@ -550,6 +586,13 @@ the values of constants may be useful to have." :group 'org-export-tables :type 'boolean) +(defcustom org-export-table-remove-empty-lines t + "Remove empty lines when exporting tables. +This is the global equivalent of the :remove-nil-lines option +when locally sending a table with #+ORGTBL." + :group 'org-export-tables + :type 'boolean) + (defcustom org-export-prefer-native-exporter-for-tables nil "Non-nil means always export tables created with table.el natively. Natively means use the HTML code generator in table.el. @@ -562,18 +605,20 @@ table.el tables." :group 'org-export-tables :type 'boolean) - -(defgroup org-export-xml nil - "Options specific for XML export of Org-mode files." - :tag "Org Export XML" - :group 'org-export) - ;;;; Exporting ;;; Variables, constants, and parameter plists (defconst org-level-max 20) +(defvar org-export-current-backend nil + "During export, this will be bound to a symbol such as 'html, + 'latex, 'docbook, 'ascii, etc, indicating which of the export + backends is in use. Otherwise it has the value nil. Users + should not attempt to change the value of this variable + directly, but it can be used in code to test whether export is + in progress, and if so, what the backend is.") + (defvar org-current-export-file nil) ; dynamically scoped parameter (defvar org-current-export-dir nil) ; dynamically scoped parameter (defvar org-export-opt-plist nil @@ -581,6 +626,11 @@ table.el tables." (defvar org-last-level nil) ; dynamically scoped variable (defvar org-min-level nil) ; dynamically scoped variable (defvar org-levels-open nil) ; dynamically scoped parameter +(defvar org-export-footnotes-data nil + "Alist of labels used in buffers, along with their definition.") +(defvar org-export-footnotes-seen nil + "Alist of labels encountered so far by the exporter, along with their definition.") + (defconst org-export-plist-vars '((:link-up nil org-export-html-link-up) @@ -602,6 +652,7 @@ table.el tables." (:drawers "d" org-export-with-drawers) (:tags "tags" org-export-with-tags) (:todo-keywords "todo" org-export-with-todo-keywords) + (:tasks "tasks" org-export-with-tasks) (:priority "pri" org-export-with-priority) (:TeX-macros "TeX" org-export-with-TeX-macros) (:LaTeX-fragments "LaTeX" org-export-with-LaTeX-fragments) @@ -609,6 +660,8 @@ table.el tables." (:skip-before-1st-heading "skip" org-export-skip-text-before-1st-heading) (:fixed-width ":" org-export-with-fixed-width) (:timestamps "<" org-export-with-timestamps) + (:author nil user-full-name) + (:email nil user-mail-address) (:author-info "author" org-export-author-info) (:email-info "email" org-export-email-info) (:creator-info "creator" org-export-creator-info) @@ -623,17 +676,13 @@ table.el tables." (:convert-org-links nil org-export-html-link-org-files-as-html) (:inline-images nil org-export-html-inline-images) (:html-extension nil org-export-html-extension) + (:html-preamble nil org-export-html-preamble) + (:html-postamble nil org-export-html-postamble) (:xml-declaration nil org-export-html-xml-declaration) (:html-table-tag nil org-export-html-table-tag) (:expand-quoted-html "@" org-export-html-expand) (:timestamp nil org-export-html-with-timestamp) (:publishing-directory nil org-export-publishing-directory) - (:preamble nil org-export-html-preamble) - (:postamble nil org-export-html-postamble) - (:auto-preamble nil org-export-html-auto-preamble) - (:auto-postamble nil org-export-html-auto-postamble) - (:author nil user-full-name) - (:email nil user-mail-address) (:select-tags nil org-export-select-tags) (:exclude-tags nil org-export-exclude-tags) @@ -697,7 +746,7 @@ modified) list.") (case-fold-search t) p key val text options mathjax a pr style latex-header latex-class macros letbind - ext-setup-or-nil setup-contents (start 0)) + ext-setup-or-nil setup-file setup-dir setup-contents (start 0)) (while (or (and ext-setup-or-nil (string-match re ext-setup-or-nil start) (setq start (match-end 0))) @@ -744,11 +793,14 @@ modified) list.") ((string-equal key "MACRO") (push val macros)) ((equal key "SETUPFILE") - (setq setup-contents (org-file-contents - (expand-file-name - (org-remove-double-quotes - (org-trim val))) - 'noerror)) + (setq setup-file (org-remove-double-quotes (org-trim val)) + ;; take care of recursive inclusion of setupfiles + setup-file (if (or (file-name-absolute-p val) (not setup-dir)) + (expand-file-name setup-file) + (let ((default-directory setup-dir)) + (expand-file-name setup-file)))) + (setq setup-dir (file-name-directory setup-file)) + (setq setup-contents (org-file-contents setup-file 'noerror)) (if (not ext-setup-or-nil) (setq ext-setup-or-nil setup-contents start 0) (setq ext-setup-or-nil @@ -799,7 +851,7 @@ modified) list.") (defvar org-export-allow-BIND-local nil) (defun org-export-confirm-letbind () "Can we use #+BIND values during export? -By default this will ask fro confirmation by the user, to divert possible +By default this will ask for confirmation by the user, to divert possible security risks." (cond ((not org-export-allow-BIND) nil) @@ -823,12 +875,13 @@ security risks." (let ((op org-export-plist-vars)) (while (setq o (pop op)) (if (and (nth 1 o) - (string-match (concat (regexp-quote (nth 1 o)) - ":\\([^ \t\n\r;,.]*\\)") + (string-match (concat "\\(\\`\\|[ \t]\\)" + (regexp-quote (nth 1 o)) + ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") options)) (setq p (plist-put p (car o) (car (read-from-string - (match-string 1 options)))))))))) + (match-string 2 options)))))))))) p) (defun org-export-add-subtree-options (p pos) @@ -873,13 +926,18 @@ to a file. For details see the docstring of `org-export-run-in-background'. The prefix argument ARG will be passed to the exporter. However, if ARG is a double universal prefix \\[universal-argument] \\[universal-argument], \ that means to inverse the -value of `org-export-run-in-background'." +value of `org-export-run-in-background'. + +If `org-export-initial-scope' is set to 'subtree, try to export +the current subtree, otherwise try to export the whole buffer. +Pressing `1' will switch between these two options." (interactive "P") (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background)) - subtree-p + (subtree-p (or (org-region-active-p) + (eq org-export-initial-scope 'subtree))) (help "[t] insert the export option template \[v] limit export to visible part of outline tree -\[1] only export the current subtree +\[1] switch buffer/subtree export \[SPC] publish enclosing subtree (with LaTeX_CLASS or EXPORT_FILE_NAME prop) \[a/n/u] export as ASCII/Latin-1/UTF-8 [A/N/U] to temporary buffer @@ -892,6 +950,8 @@ value of `org-export-run-in-background'." \[D] export as DocBook [V] export as DocBook, process to PDF, and open +\[o] export as OpenDocumentText [O] ... and open + \[j] export as TaskJuggler [J] ... and open \[m] export as Freemind mind map @@ -920,6 +980,8 @@ value of `org-export-run-in-background'." (?g org-export-generic t) (?D org-export-as-docbook t) (?V org-export-as-docbook-pdf-and-open t) + (?o org-export-as-odt t) + (?O org-export-as-odt-and-open t) (?j org-export-as-taskjuggler t) (?J org-export-as-taskjuggler-and-open t) (?m org-export-as-freemind t) @@ -938,30 +1000,37 @@ value of `org-export-run-in-background'." (cpos (point)) (cbuf (current-buffer)) bpos) (save-excursion (save-window-excursion + (if subtree-p + (message "Export subtree: ") + (message "Export buffer: ")) (delete-other-windows) (with-output-to-temp-buffer "*Org Export/Publishing Help*" (princ help)) (org-fit-window-to-buffer (get-buffer-window "*Org Export/Publishing Help*")) - (message "Select command: ") - (setq r1 (read-char-exclusive)) - (when (eq r1 ?1) - (setq subtree-p t) - (message "Select command (for subtree): ") - (setq r1 (read-char-exclusive))) + (while (eq (setq r1 (read-char-exclusive)) ?1) + (cond (subtree-p + (setq subtree-p nil) + (message "Export buffer: ")) + ((not subtree-p) + (setq subtree-p t) + (message "Export subtree: ")))) (when (eq r1 ?\ ) - (let ((case-fold-search t)) + (let ((case-fold-search t) + (end (save-excursion (while (org-up-heading-safe)) (point)))) + (outline-next-heading) (if (re-search-backward - "^[ \t]+\\(:latex_class:\\|:export_title:\\)[ \t]+\\S-" - nil t) + "^[ \t]+\\(:latex_class:\\|:export_title:\\|:export_file_name:\\)[ \t]+\\S-" + end t) (progn (org-back-to-heading t) (setq subtree-p t) (setq bpos (point)) (message "Select command (for subtree): ") (setq r1 (read-char-exclusive))) - (error "No enclosing node with LaTeX_CLASS or EXPORT_FILE_NAME") + (error "No enclosing node with LaTeX_CLASS or EXPORT_TITLE or EXPORT_FILE_NAME") ))))) + (redisplay) (and bpos (goto-char bpos)) (setq r2 (if (< r1 27) (+ r1 96) r1)) (unless (setq ass (assq r2 cmds)) @@ -983,7 +1052,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 (org-mark-subtree) (activate-mark))) + (if subtree-p (progn (org-mark-subtree) (org-activate-mark))) (call-interactively (nth 1 ass)) (when (and bpos (get-buffer-window cbuf)) (let ((cw (selected-window))) @@ -1009,24 +1078,18 @@ value of `org-export-run-in-background'." "Alist of code references and line numbers.") (defun org-export-preprocess-string (string &rest parameters) - "Cleanup STRING so that that the true exported has a more consistent source. + "Cleanup STRING so that the true exported has a more consistent source. This function takes STRING, which should be a buffer-string of an org-file to export. It then creates a temporary buffer where it does its job. The result is then again returned as a string, and the exporter works on this string to produce the exported version." (interactive) - (let* ((htmlp (plist-get parameters :for-html)) - (asciip (plist-get parameters :for-ascii)) - (latexp (plist-get parameters :for-LaTeX)) - (docbookp (plist-get parameters :for-docbook)) - (backend (cond (htmlp 'html) - (latexp 'latex) - (asciip 'ascii) - (docbookp 'docbook))) + (let* ((org-export-current-backend (or (plist-get parameters :for-backend) + org-export-current-backend)) (archived-trees (plist-get parameters :archived-trees)) (inhibit-read-only t) (drawers org-drawers) - (outline-regexp "\\*+ ") + (source-buffer (current-buffer)) target-alist rtn) (setq org-export-target-aliases nil @@ -1034,7 +1097,7 @@ on this string to produce the exported version." org-export-id-target-alist nil org-export-code-refs nil) - (with-current-buffer (get-buffer-create " org-mode-tmp") + (with-temp-buffer (erase-buffer) (insert string) (setq case-fold-search t) @@ -1050,15 +1113,12 @@ on this string to produce the exported version." (let ((org-inhibit-startup t)) (org-mode)) (setq case-fold-search t) + (org-clone-local-variables source-buffer "^\\(org-\\|orgtbl-\\)") (org-install-letbind) ;; Call the hook (run-hooks 'org-export-preprocess-hook) - ;; Process the macros - (org-export-preprocess-apply-macros) - (run-hooks 'org-export-preprocess-after-macros-hook) - (untabify (point-min) (point-max)) ;; Handle include files, and call a hook @@ -1076,24 +1136,53 @@ on this string to produce the exported version." (plist-get parameters :exclude-tags)) (run-hooks 'org-export-preprocess-after-tree-selection-hook) - ;; Mark end of lists - (org-export-mark-list-ending backend) + ;; Get rid of tasks, depending on configuration + (org-export-remove-tasks (plist-get parameters :tasks)) + + ;; Prepare footnotes for export. During that process, footnotes + ;; actually included in the exported part of the buffer go + ;; though some transformations: + + ;; 1. They have their label normalized (like "[N]"); + + ;; 2. They get moved at the same place in the buffer (usually at + ;; its end, but backends may define another place via + ;; `org-footnote-insert-pos-for-preprocessor'); + + ;; 3. The are stored in `org-export-footnotes-seen', while + ;; `org-export-preprocess-string' is applied to their + ;; definition. + + ;; Line-wise exporters ignore `org-export-footnotes-seen', as + ;; they interpret footnotes at the moment they see them in the + ;; buffer. Context-wise exporters grab all the info needed in + ;; that variable and delete moved definitions (as described in + ;; 2nd step). + (when (plist-get parameters :footnotes) + (org-footnote-normalize nil parameters)) + + ;; Change lists ending. Other parts of export may insert blank + ;; lines and lists' structure could be altered. + (org-export-mark-list-end) + + ;; Process the macros + (org-export-preprocess-apply-macros) + (run-hooks 'org-export-preprocess-after-macros-hook) ;; Export code blocks (org-export-blocks-preprocess) + ;; Mark lists with properties + (org-export-mark-list-properties) + ;; Handle source code snippets - (org-export-replace-src-segments-and-examples backend) + (org-export-replace-src-segments-and-examples) ;; 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)) + (org-export-convert-protected-spaces) ;; Find all headings and compute the targets for them (setq target-alist (org-export-define-heading-targets target-alist)) @@ -1105,7 +1194,7 @@ on this string to produce the exported version." ;; Get rid of drawers (org-export-remove-or-extract-drawers - drawers (plist-get parameters :drawers) backend) + drawers (plist-get parameters :drawers)) ;; Get the correct stuff before the first headline (when (plist-get parameters :skip-before-1st-heading) @@ -1128,7 +1217,7 @@ on this string to produce the exported version." ;; Select and protect backend specific stuff, throw away stuff ;; that is specific for other backends (run-hooks 'org-export-preprocess-before-selecting-backend-code-hook) - (org-export-select-backend-specific-text backend) + (org-export-select-backend-specific-text) ;; Protect quoted subtrees (org-export-protect-quoted-subtrees) @@ -1148,8 +1237,7 @@ on this string to produce the exported version." (org-export-remove-timestamps)) ;; Attach captions to the correct object - (setq target-alist (org-export-attach-captions-and-attributes - backend target-alist)) + (setq target-alist (org-export-attach-captions-and-attributes target-alist)) ;; Find matches for radio targets and turn them into internal links (org-export-mark-radio-links) @@ -1180,35 +1268,22 @@ on this string to produce the exported version." ;; Another hook (run-hooks 'org-export-preprocess-before-backend-specifics-hook) - ;; LaTeX-specific preprocessing - (when latexp - (require 'org-latex nil) - (org-export-latex-preprocess parameters)) - - ;; ASCII-specific preprocessing - (when asciip - (org-export-ascii-preprocess parameters)) - - ;; HTML-specific preprocessing - (when htmlp - (org-export-html-preprocess parameters)) - - ;; DocBook-specific preprocessing - (when docbookp - (require 'org-docbook nil) - (org-export-docbook-preprocess parameters)) + ;; Backend-specific preprocessing + (let* ((backend-name (symbol-name org-export-current-backend)) + (f (intern (format "org-export-%s-preprocess" backend-name)))) + (require (intern (concat "org-" backend-name)) nil) + (funcall f parameters)) ;; Remove or replace comments (org-export-handle-comments (plist-get parameters :comments)) ;; Remove #+TBLFM and #+TBLNAME lines (org-export-handle-table-metalines) - + ;; Run the final hook (run-hooks 'org-export-preprocess-final-hook) (setq rtn (buffer-string))) - (kill-buffer " org-mode-tmp") rtn)) (defun org-export-kill-licensed-text () @@ -1261,7 +1336,7 @@ Also find all ID and CUSTOM_ID properties and store them." (org-outline-level)))) (setq target (org-solidify-link-text (format "sec-%s" (replace-regexp-in-string - "\\." "_" + "\\." "-" (org-section-number level))))) (setq last-section-target target) (push (cons target target) target-alist) @@ -1305,7 +1380,8 @@ the current file." (goto-char (point-min)) (while (re-search-forward org-bracket-link-regexp nil t) (org-if-unprotected-at (1+ (match-beginning 0)) - (let* ((md (match-data)) + (let* ((org-link-search-must-match-exact-headline t) + (md (match-data)) (desc (match-end 2)) (link (org-link-unescape (match-string 1))) (slink (org-solidify-link-text link)) @@ -1368,17 +1444,16 @@ the current file." The function must accept three parameters: NAME the drawer name, like \"PROPERTIES\" CONTENT the content of the drawer. - BACKEND one of the symbols html, docbook, latex, ascii, xoxo +You can check the export backend through `org-export-current-backend'. The function should return the text to be inserted into the buffer. If this is nil, `org-export-format-drawer' is used as a default.") -(defun org-export-remove-or-extract-drawers (all-drawers exp-drawers backend) +(defun org-export-remove-or-extract-drawers (all-drawers exp-drawers) "Remove drawers, or extract and format the content. ALL-DRAWERS is a list of all drawer names valid in the current buffer. EXP-DRAWERS can be t to keep all drawer contents, or a list of drawers whose content to keep. Any drawers that are in ALL-DRAWERS but not in -EXP-DRAWERS will be removed. -BACKEND is the current export backend." +EXP-DRAWERS will be removed." (goto-char (point-min)) (let ((re (concat "^[ \t]*:\\(" (mapconcat 'identity all-drawers "\\|") @@ -1402,10 +1477,10 @@ BACKEND is the current export backend." (member name exp-drawers)) (setq content (funcall (or org-export-format-drawer-function 'org-export-format-drawer) - name content backend)) + name content)) (insert content))))))) -(defun org-export-format-drawer (name content backend) +(defun org-export-format-drawer (name content) "Format the content of a drawer as a colon example." (if (string-match "[ \t]+\\'" content) (setq content (substring content (match-beginning 0)))) @@ -1475,6 +1550,36 @@ removed as well." (point-max))) (delete-region beg end)))) +(defun org-export-remove-tasks (keep) + "Remove tasks depending on configuration. +When KEEP is nil, remove all tasks. +When KEEP is `todo', remove the tasks that are DONE. +When KEEP is `done', remove the tasks that are not yet done. +When it is a list of strings, keep only tasks with these TODO keywords." + (when (or (listp keep) (memq keep '(todo done nil))) + (let ((re (concat "^\\*+[ \t]+\\(" + (mapconcat + 'regexp-quote + (cond ((not keep) org-todo-keywords-1) + ((eq keep 'todo) org-done-keywords) + ((eq keep 'done) org-not-done-keywords) + ((listp keep) + (org-delete-all keep (copy-sequence + org-todo-keywords-1)))) + "\\|") + "\\)\\($\\|[ \t]\\)")) + (case-fold-search nil) + beg) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (org-if-unprotected + (setq beg (match-beginning 0)) + (org-end-of-subtree t t) + (if (looking-at "^\\*+[ \t]+END[ \t]*$") + ;; Kill the END line of the inline task + (goto-char (min (point-max) (1+ (match-end 0))))) + (delete-region beg (point))))))) + (defun org-export-remove-archived-trees (export-archived-trees) "Remove archived trees. When EXPORT-ARCHIVED-TREES is `headline;, only the headline will be exported. @@ -1501,6 +1606,7 @@ from the buffer." (tags (plist-get opts :tags)) (pri (plist-get opts :priority)) (elts '(1 2 3 4 5)) + (case-fold-search nil) rpl) (setq elts (delq nil (list 1 (if todo 2) (if pri 3) 4 (if tags 5)))) (when (or (not todo) (not tags) (not pri)) @@ -1533,15 +1639,15 @@ from the buffer." (defun org-export-protect-quoted-subtrees () "Mark quoted subtrees with the protection property." - (let ((re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>"))) + (let ((org-re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>"))) (goto-char (point-min)) - (while (re-search-forward re-quote nil t) + (while (re-search-forward org-re-quote nil t) (goto-char (match-beginning 0)) (end-of-line 1) (add-text-properties (point) (org-end-of-subtree t) '(org-protected t))))) -(defun org-export-convert-protected-spaces (backend) +(defun org-export-convert-protected-spaces () "Convert strings like \\____ to protected spaces in all backends." (goto-char (point-min)) (while (re-search-forward "\\\\__+" nil t) @@ -1549,13 +1655,13 @@ from the buffer." (replace-match (org-add-props (cond - ((eq backend 'latex) + ((eq org-export-current-backend 'latex) (format "\\hspace{%dex}" (- (match-end 0) (match-beginning 0)))) - ((eq backend 'html) + ((eq org-export-current-backend 'html) (org-add-props (match-string 0) nil 'org-whitespace (- (match-end 0) (match-beginning 0)))) - ;; ((eq backend 'docbook)) - ((eq backend 'ascii) + ;; ((eq org-export-current-backend 'docbook)) + ((eq org-export-current-backend 'ascii) (org-add-props (match-string 0) '(org-whitespace t))) (t (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) '(org-protected t)) @@ -1583,48 +1689,59 @@ from the buffer." (add-text-properties beg (if (bolp) (1- (point)) (point)) '(org-protected t))))) -(defun org-export-select-backend-specific-text (backend) - (let ((formatters - '((docbook "DOCBOOK" "BEGIN_DOCBOOK" "END_DOCBOOK") - (html "HTML" "BEGIN_HTML" "END_HTML") - (beamer "BEAMER" "BEGIN_BEAMER" "END_BEAMER") - (ascii "ASCII" "BEGIN_ASCII" "END_ASCII") - (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) +(defvar org-export-backends + '(docbook html beamer ascii latex) + "List of Org supported export backends.") + +(defun org-export-select-backend-specific-text () + (let ((formatters org-export-backends) (case-fold-search t) - fmt beg beg-content end end-content) + backend backend-name beg beg-content end end-content ind) (while formatters - (setq fmt (pop formatters)) - ;; Handle #+Backend: stuff + (setq backend (pop formatters) + backend-name (symbol-name backend)) + + ;; Handle #+BACKEND: stuff (goto-char (point-min)) - (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" (cadr fmt) + (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" backend-name ":[ \t]*\\(.*\\)") nil t) - (if (not (eq (car fmt) backend)) + (if (not (eq backend org-export-current-backend)) (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) (replace-match "\\1\\2" t) (add-text-properties (point-at-bol) (min (1+ (point-at-eol)) (point-max)) - '(org-protected t)))) - ;; Delete #+attr_Backend: stuff of another backend. Those + `(org-protected t original-indentation ,ind org-native-text t)))) + ;; Delete #+ATTR_BACKEND: stuff of another backend. Those ;; matching the current backend will be taken care of by ;; `org-export-attach-captions-and-attributes' (goto-char (point-min)) - (while (re-search-forward (concat "^\\([ \t]*\\)#\\+attr_" (cadr fmt) + (while (re-search-forward (concat "^\\([ \t]*\\)#\\+ATTR_" backend-name ":[ \t]*\\(.*\\)") nil t) - (when (not (eq (car fmt) backend)) + (setq ind (org-get-indentation)) + (when (not (eq backend org-export-current-backend)) (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) - ;; Handle #+begin_Backend and #+end_Backend stuff + ;; Handle #+BEGIN_BACKEND and #+END_BACKEND stuff (goto-char (point-min)) - (while (re-search-forward (concat "^[ \t]*#\\+" (caddr fmt) "\\>.*\n?") + (while (re-search-forward (concat "^[ \t]*#\\+BEGIN_" backend-name "\\>.*\n?") nil t) (setq beg (match-beginning 0) beg-content (match-end 0)) - (when (re-search-forward (concat "^[ \t]*#\\+" (cadddr fmt) "\\>.*\n?") + (setq ind (save-excursion (goto-char beg) (org-get-indentation))) + (when (re-search-forward (concat "^[ \t]*#\\+END_" backend-name "\\>.*\n?") nil t) (setq end (match-end 0) end-content (match-beginning 0)) - (if (eq (car fmt) backend) + (if (eq backend org-export-current-backend) ;; yes, keep this (progn - (add-text-properties beg-content end-content '(org-protected t)) + (add-text-properties + beg-content end-content + `(org-protected t original-indentation ,ind org-native-text t)) + ;; strip protective commas + (save-excursion + (save-match-data + (goto-char beg-content) + (while (re-search-forward "^[ \t]*\\(,\\)" end-content t) + (replace-match "" nil nil nil 1)))) (delete-region (match-beginning 0) (match-end 0)) (save-excursion (goto-char beg) @@ -1656,32 +1773,106 @@ These special cookies will later be interpreted by the backend." (delete-region beg end) (insert (org-add-props content nil 'original-indentation ind)))))) -(defun org-export-mark-list-ending (backend) - "Mark list endings with special cookies. -These special cookies will later be interpreted by the backend. -`org-list-end-re' is replaced by a blank line in the process." - (let ((process-buffer - (lambda (end-list-marker) - (goto-char (point-min)) - (while (org-search-forward-unenclosed org-item-beginning-re nil t) - (goto-char (org-list-bottom-point)) +(defun org-export-mark-list-end () + "Mark all list endings with a special string." + (unless (eq org-export-current-backend 'ascii) + (mapc + (lambda (e) + ;; For each type allowing list export, find every list, remove + ;; ending regexp if needed, and insert org-list-end. + (goto-char (point-min)) + (while (re-search-forward (org-item-beginning-re) nil t) + (when (eq (nth 2 (org-list-context)) e) + (let* ((struct (org-list-struct)) + (bottom (org-list-get-bottom-point struct)) + (top (point-at-bol)) + (top-ind (org-list-get-ind top struct))) + (goto-char bottom) (when (and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re))) - (replace-match "\n")) - (insert end-list-marker))))) - ;; We need to divide backends into 3 categories. - (cond - ;; 1. Backends using `org-list-parse-list' do not need markers. - ((memq backend '(latex)) - nil) - ;; 2. Line-processing backends need to be told where lists end. - ((memq backend '(html docbook)) - (funcall process-buffer "ORG-LIST-END\n")) - ;; 3. Others backends do not need to know this: clean list enders. - (t - (funcall process-buffer ""))))) - -(defun org-export-attach-captions-and-attributes (backend target-alist) + (not (looking-at "[ \t]*$")) + (looking-at org-list-end-re)) + (replace-match "")) + (unless (bolp) (insert "\n")) + ;; As org-list-end is inserted at column 0, it would end + ;; by indentation any list. It can be problematic when + ;; there are lists within lists: the inner list end would + ;; also become the outer list end. To avoid this, text + ;; property `original-indentation' is added, as + ;; `org-list-struct' pays attention to it when reading a + ;; list. + (insert (org-add-props + "ORG-LIST-END-MARKER\n" + (list 'original-indentation top-ind))))))) + (cons nil org-list-export-context)))) + +(defun org-export-mark-list-properties () + "Mark list with special properties. +These special properties will later be interpreted by the backend." + (let ((mark-list + (function + ;; Mark a list with 3 properties: `list-item' which is + ;; position at beginning of line, `list-struct' which is + ;; list structure, and `list-prevs' which is the alist of + ;; item and its predecessor. Leave point at list ending. + (lambda (ctxt) + (let* ((struct (org-list-struct)) + (top (org-list-get-top-point struct)) + (bottom (org-list-get-bottom-point struct)) + (prevs (org-list-prevs-alist struct)) + poi) + ;; Get every item and ending position, without dups and + ;; without bottom point of list. + (mapc (lambda (e) + (let ((pos (car e)) + (end (nth 6 e))) + (unless (memq pos poi) + (push pos poi)) + (unless (or (= end bottom) (memq end poi)) + (push end poi)))) + struct) + (setq poi (sort poi '<)) + ;; For every point of interest, mark the whole line with + ;; its position in list. + (mapc + (lambda (e) + (goto-char e) + (add-text-properties (point-at-bol) (point-at-eol) + (list 'list-item (point-at-bol) + 'list-struct struct + 'list-prevs prevs))) + poi) + ;; Take care of bottom point. As babel may have inserted + ;; a new list in buffer, list ending isn't always + ;; marked. Now mark every list ending and add properties + ;; useful to line processing exporters. + (goto-char bottom) + (when (or (looking-at "^ORG-LIST-END-MARKER\n") + (and (not (eq org-list-ending-method 'indent)) + (not (looking-at "[ \t]*$")) + (looking-at org-list-end-re))) + (replace-match "")) + (unless (bolp) (insert "\n")) + (insert + (org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom + 'list-struct struct + 'list-prevs prevs))) + ;; Following property is used by LaTeX exporter. + (add-text-properties top (point) (list 'list-context ctxt))))))) + ;; Mark lists except for backends not interpreting them. + (unless (eq org-export-current-backend 'ascii) + (let ((org-list-end-re "^ORG-LIST-END-MARKER\n")) + (mapc + (lambda (e) + (goto-char (point-min)) + (while (re-search-forward (org-item-beginning-re) nil t) + (let ((context (nth 2 (org-list-context)))) + (if (eq context e) + (funcall mark-list e) + (put-text-property (point-at-bol) (point-at-eol) + 'list-context context))))) + (cons nil org-list-export-context)))))) + +(defun org-export-attach-captions-and-attributes (target-alist) "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. If the next thing following is a table, add the text properties to the first table line. If it is a link, add it to the line containing the link." @@ -1691,7 +1882,7 @@ table line. If it is a link, add it to the line containing the link." (let ((case-fold-search t) (re (concat "^[ \t]*#\\+caption:[ \t]+\\(.*\\)" "\\|" - "^[ \t]*#\\+attr_" (symbol-name backend) ":[ \t]+\\(.*\\)" + "^[ \t]*#\\+attr_" (symbol-name org-export-current-backend) ":[ \t]+\\(.*\\)" "\\|" "^[ \t]*#\\+label:[ \t]+\\(.*\\)" "\\|" @@ -1701,6 +1892,7 @@ table line. If it is a link, add it to the line containing the link." cap shortn attr label end) (while (re-search-forward re nil t) (cond + ;; there is a caption ((match-end 1) (progn (setq cap (concat cap (if cap " " "") (org-trim (match-string 1)))) @@ -1708,10 +1900,12 @@ table line. If it is a link, add it to the line containing the link." (setq shortn (match-string 1 cap) cap (match-string 2 cap))) (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) + ;; there is an attribute ((match-end 2) (progn (setq attr (concat attr (if attr " " "") (org-trim (match-string 2)))) (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) + ;; there is a label ((match-end 3) (progn (setq label (org-trim (match-string 3))) @@ -1728,7 +1922,7 @@ table line. If it is a link, add it to the line containing the link." 'org-label label)) (if label (push (cons label label) target-alist)) (goto-char end) - (setq cap nil attr nil label nil))))) + (setq cap nil shortn nil attr nil label nil))))) target-alist) (defun org-export-remove-comment-blocks-and-subtrees () @@ -1739,7 +1933,7 @@ table line. If it is a link, add it to the line containing the link." (goto-char (point-min)) (setq case-fold-search t) (while (re-search-forward - "^#\\+begin_comment[ \t]*\n[^\000]*?^#\\+end_comment\\>.*" nil t) + "^#\\+begin_comment[ \t]*\n[^\000]*?\n#\\+end_comment\\>.*" nil t) (replace-match "" t t)) ;; Remove subtrees that are commented (goto-char (point-min)) @@ -1748,9 +1942,9 @@ table line. If it is a link, add it to the line containing the link." (goto-char (match-beginning 0)) (delete-region (point) (org-end-of-subtree t))))) -(defun org-export-handle-comments (commentsp) +(defun org-export-handle-comments (org-commentsp) "Remove comments, or convert to backend-specific format. -COMMENTSP can be a format string for publishing comments. +ORG-COMMENTSP can be a format string for publishing comments. When it is nil, all comments will be removed." (let ((re "^\\(#\\|[ \t]*#\\+ \\)\\(.*\n?\\)") pos) @@ -1760,11 +1954,14 @@ When it is nil, all comments will be removed." (setq pos (match-beginning 0)) (if (get-text-property pos 'org-protected) (goto-char (1+ pos)) - (if (and commentsp + (if (and org-commentsp (not (equal (char-before (match-end 1)) ?+))) (progn (add-text-properties (match-beginning 0) (match-end 0) '(org-protected t)) - (replace-match (format commentsp (match-string 2)) t t)) + (replace-match (org-add-props + (format org-commentsp (match-string 2)) + nil 'org-protected t) + t t)) (goto-char (1+ pos)) (replace-match "") (goto-char (max (point-min) (1- pos)))))))) @@ -1821,7 +2018,7 @@ When it is nil, all comments will be removed." (defun org-export-remove-special-table-lines () "Remove tables lines that are used for internal purposes. -Also, store forcedalignment information found in such lines." +Also, store forced alignment information found in such lines." (goto-char (point-min)) (while (re-search-forward "^[ \t]*|" nil t) (org-if-unprotected-at (1- (point)) @@ -1832,7 +2029,7 @@ Also, store forcedalignment information found in such lines." nil (mapcar (lambda (f) - (or (= (length f) 0) + (or (and org-export-table-remove-empty-lines (= (length f) 0)) (string-match "\\`<\\([0-9]\\|[lrc]\\|[lrc][0-9]+\\)>\\'" f))) (org-split-string ;; FIXME, can't we do without splitting??? @@ -1856,7 +2053,7 @@ Also, store forcedalignment information found in such lines." (goto-char (point-min)) (while (re-search-forward re-plain-link nil t) (unless (org-string-match-p - "\\[\\[\\S+:\\S-*?\\<" + "\\[\\[\\S-+:\\S-*?\\<" (buffer-substring (point-at-bol) (match-beginning 0))) (goto-char (1- (match-end 0))) (org-if-unprotected-at (1+ (match-beginning 0)) @@ -1945,7 +2142,8 @@ can work correctly." (defun org-export-get-title-from-subtree () "Return subtree title and exclude it from export." - (let (title (rbeg (region-beginning)) (rend (region-end))) + (let ((rbeg (region-beginning)) (rend (region-end)) + (inhibit-read-only t) title) (save-excursion (goto-char rbeg) (when (and (org-at-heading-p) @@ -1966,7 +2164,7 @@ can work correctly." (let* ((rtn (mapconcat 'identity - (org-split-string s "[ \t\r\n]+") "==")) + (org-split-string s "[^a-zA-Z0-9_\\.-]+") "-")) (a (assoc rtn alist))) (or (cdr a) rtn)))) @@ -2073,26 +2271,35 @@ TYPE must be a string, any of: (defun org-export-preprocess-apply-macros () "Replace macro references." (goto-char (point-min)) - (let (sy val key args args2 s n) + (let (sy val key args args2 ind-str s n) (while (re-search-forward "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" nil t) - (unless (save-match-data - (save-excursion - (goto-char (point-at-bol)) - (looking-at "[ \t]*#\\+macro"))) + (unless (save-match-data (save-excursion + (goto-char (point-at-bol)) + (looking-at "[ \t]*#\\+macro"))) + ;; Get macro name (KEY), arguments (ARGS), and indentation of + ;; current line (IND-STR) as strings. (setq key (downcase (match-string 1)) - args (match-string 3)) + args (match-string 3) + ind-str (save-match-data (save-excursion + (beginning-of-line) + (looking-at "^\\([ \t]*\\).*") + (match-string 1)))) + ;; When macro is defined, retrieve replacement text in VAL, + ;; and proceed with expansion. (when (setq val (or (plist-get org-export-opt-plist (intern (concat ":macro-" key))) (plist-get org-export-opt-plist (intern (concat ":" key))))) (save-match-data + ;; If arguments are provided, first retreive them properly + ;; (in ARGS, as a list), then replace them in VAL. (when args (setq args (org-split-string args ",") args2 nil) (while args (while (string-match "\\\\\\'" (car args)) - ;; repair bad splits + ;; Repair bad splits. (setcar (cdr args) (concat (substring (car args) 0 -1) "," (nth 1 args))) (pop args)) @@ -2104,13 +2311,22 @@ TYPE must be a string, any of: n (string-to-number (match-string 1 val))) (and (>= (length args) n) (setq val (replace-match (nth (1- n) args) t t val))))) + ;; VAL starts with "(eval": it is a sexp, `eval' it. (when (string-match "\\`(eval\\>" val) (setq val (eval (read val)))) - (if (and val (not (stringp val))) - (setq val (format "%s" val)))) - (and (stringp val) - (prog1 (replace-match val t t) - (goto-char (match-beginning 0))))))))) + ;; Ensure VAL is a string (or nil) and that each new line + ;; is indented as the first one. + (setq val (and val + (mapconcat 'identity + (org-split-string + (if (stringp val) val (format "%s" val)) + "\n") + (concat "\n" ind-str))))) + ;; Eventually do the replacement, if VAL isn't nil. Move + ;; point at beginning of macro for recursive expansions. + (when val + (replace-match val t t) + (goto-char (match-beginning 0)))))))) (defun org-export-apply-macros-in-string (s) "Apply the macros in string S." @@ -2125,18 +2341,19 @@ 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 minlevel) + params file markup lang start end prefix prefix1 switches all minlevel lines) (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) + lines (org-get-and-remove-property 'params :lines) file (org-symname-or-string (pop params)) markup (org-symname-or-string (pop params)) lang (and (member markup '("src" "SRC")) (org-symname-or-string (pop params))) - switches (mapconcat (lambda (x) (format "%s" x)) params " ") + switches (mapconcat #'(lambda (x) (format "%s" x)) params " ") start nil end nil) (delete-region (match-beginning 0) (match-end 0)) (if (or (not file) @@ -2154,7 +2371,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 minlevel)) + prefix prefix1 markup minlevel lines)) (or (bolp) (newline)) (insert (or end "")))) all)) @@ -2171,15 +2388,29 @@ TYPE must be a string, any of: (when intersection (error "Recursive #+INCLUDE: %S" intersection)))))) -(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel) +(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel lines) "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. If MARKUP, don't protect org-like lines, the exporter will -take care of the block they are in." +take care of the block they are in. If LINES is a string +specifying a range of lines, include only those lines ." (if (stringp markup) (setq markup (downcase markup))) (with-temp-buffer (insert-file-contents file) + (when lines + (let* ((lines (split-string lines "-")) + (lbeg (string-to-number (car lines))) + (lend (string-to-number (cadr lines))) + (beg (if (zerop lbeg) (point-min) + (goto-char (point-min)) + (forward-line (1- lbeg)) + (point))) + (end (if (zerop lend) (point-max) + (goto-char (point-min)) + (forward-line (1- lend)) + (point)))) + (narrow-to-region beg end))) (when (or prefix prefix1) (goto-char (point-min)) (while (not (eobp)) @@ -2221,7 +2452,7 @@ in the list) and remove property and value from the list in LISTVAR." (defvar org-export-last-code-line-counter-value 0) -(defun org-export-replace-src-segments-and-examples (backend) +(defun org-export-replace-src-segments-and-examples () "Replace source code segments with special code for export." (setq org-export-last-code-line-counter-value 0) (let ((case-fold-search t) @@ -2254,19 +2485,40 @@ in the list) and remove property and value from the list in LISTVAR." caption (get-text-property 0 'org-caption (match-string 0)))) (setq trans (org-export-format-source-code-or-example - backend lang code opts indent caption)) + lang code opts indent caption)) (replace-match trans t t)))) -(defvar htmlp) ;; dynamically scoped -(defvar latexp) ;; dynamically scoped (defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el (defvar org-export-latex-listings) ;; defined in org-latex.el (defvar org-export-latex-listings-langs) ;; defined in org-latex.el (defvar org-export-latex-listings-w-names) ;; defined in org-latex.el (defvar org-export-latex-minted-langs) ;; defined in org-latex.el +(defvar org-export-latex-custom-lang-environments) ;; defined in org-latex.el +(defvar org-export-latex-listings-options) ;; defined in org-latex.el +(defvar org-export-latex-minted-options) ;; defined in org-latex.el + +(defun org-remove-formatting-on-newlines-in-region (beg end) + "Remove formatting on newline characters" + (interactive "r") + (save-excursion + (goto-char beg) + (while (progn (end-of-line) (< (point) end)) + (put-text-property (point) (1+ (point)) 'face nil) + (forward-char 1)))) + (defun org-export-format-source-code-or-example - (backend lang code &optional opts indent caption) + (lang code &optional opts indent caption) "Format CODE from language LANG and return it formatted for export. +The CODE is marked up in `org-export-current-backend' format. + +Check if a function by name +\"org-<backend>-format-source-code-or-example\" is bound. If yes, +use it as the custom formatter. Otherwise, use the default +formatter. Default formatters are provided for docbook, html, +latex and ascii backends. For example, use +`org-html-format-source-code-or-example' to provide a custom +formatter for export to \"html\". + If LANG is nil, do not add any fontification. OPTS contains formatting options, like `-n' for triggering numbering lines, and `+n' for continuing previous numbering. @@ -2274,7 +2526,15 @@ Code formatting according to language currently only works for HTML. Numbering lines works for all three major backends (html, latex, and ascii). INDENT was the original indentation of the block." (save-match-data - (let (num cont rtn rpllbl keepp textareap preserve-indentp cols rows fmt) + (let* ((backend-name (symbol-name org-export-current-backend)) + (backend-formatter + (intern (format "org-%s-format-source-code-or-example" + backend-name))) + (backend-feature (intern (concat "org-" backend-name))) + (backend-formatter + (and (require (intern (concat "org-" backend-name)) nil) + (fboundp backend-formatter) backend-formatter)) + num cont rtn rpllbl keepp textareap preserve-indentp cols rows fmt) (setq opts (or opts "") num (string-match "[-+]n\\>" opts) cont (string-match "\\+n\\>" opts) @@ -2291,7 +2551,7 @@ INDENT was the original indentation of the block." (org-count-lines code)) fmt (if (string-match "-l[ \t]+\"\\([^\"\n]+\\)\"" opts) (match-string 1 opts))) - (when (and textareap (eq backend 'html)) + (when (and textareap (eq org-export-current-backend 'html)) ;; we cannot use numbering or highlighting. (setq num nil cont nil lang nil)) (if keepp (setq rpllbl 'keep)) @@ -2311,15 +2571,15 @@ INDENT was the original indentation of the block." ;; Now backend-specific coding (setq rtn (cond - ((eq backend 'docbook) - (setq rtn (org-export-number-lines rtn 'docbook 0 0 num cont rpllbl fmt)) - (concat "\n#+BEGIN_DOCBOOK\n" - (org-add-props (concat "<programlisting><![CDATA[" - rtn - "]]></programlisting>\n") - '(org-protected t org-example t)) - "#+END_DOCBOOK\n")) - ((eq backend 'html) + (backend-formatter + (funcall backend-formatter rtn lang caption textareap cols rows num + cont rpllbl fmt)) + ((eq org-export-current-backend 'docbook) + (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) + (concat "<programlisting><![CDATA[" + rtn + "]]></programlisting>\n")) + ((eq org-export-current-backend 'html) ;; We are exporting to HTML (when lang (if (featurep 'xemacs) @@ -2350,6 +2610,8 @@ INDENT was the original indentation of the block." (funcall mode) (fundamental-mode)) (font-lock-fontify-buffer) + ;; markup each line separately + (org-remove-formatting-on-newlines-in-region (point-min) (point-max)) (org-src-mode) (set-buffer-modified-p nil) (org-export-htmlize-region-for-paste @@ -2383,77 +2645,85 @@ INDENT was the original indentation of the block." (setq rtn (buffer-string))) (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n")))) (unless textareap - (setq rtn (org-export-number-lines rtn 'html 1 1 num - cont rpllbl fmt))) + (setq rtn (org-export-number-lines rtn 1 1 num cont rpllbl fmt))) (if (string-match "\\(\\`<[^>]*>\\)\n" rtn) (setq rtn (replace-match "\\1" t nil rtn))) - (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t org-example t)) "\n#+END_HTML\n\n")) - ((eq backend 'latex) - (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt)) - (concat "#+BEGIN_LaTeX\n" - (org-add-props - (cond - ((and org-export-latex-listings - (not (eq org-export-latex-listings 'minted))) - (concat - (if lang - (let* - ((lang-sym (intern lang)) - (lstlang - (or (cadr - (assq - lang-sym - org-export-latex-listings-langs)) - lang))) - (format "\\lstset{language=%s}\n" lstlang)) - "\n") - (when (and caption - org-export-latex-listings-w-names) - (format "\n%s $\\equiv$ \n" - (replace-regexp-in-string - "_" "\\\\_" caption))) - "\\begin{lstlisting}\n" - rtn "\\end{lstlisting}\n")) - ((eq org-export-latex-listings 'minted) - (if lang - (let* - ((lang-sym (intern lang)) - (minted-lang - (or (cadr - (assq - lang-sym - org-export-latex-minted-langs)) - (downcase lang)))) - (concat - (when (and caption - org-export-latex-listings-w-names) - (format "\n%s $\\equiv$ \n" - (replace-regexp-in-string - "_" "\\\\_" caption))) - (format "\\begin{minted}{%s}\n" minted-lang) - rtn "\\end{minted}\n")))) - (t (concat (car org-export-latex-verbatim-wrap) - rtn (cdr org-export-latex-verbatim-wrap)))) - '(org-protected t org-example t)) - "#+END_LaTeX\n")) - ((eq backend 'ascii) - ;; This is not HTML or LaTeX, so just make it an example. - (setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt)) - (concat caption "\n" - "#+BEGIN_ASCII\n" - (org-add-props - (concat - (mapconcat - (lambda (l) (concat " " l)) - (org-split-string rtn "\n") - "\n") - "\n") - '(org-protected t org-example t)) - "#+END_ASCII\n")))) + rtn) + ((eq org-export-current-backend 'latex) + (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) + (cond + ((and lang org-export-latex-listings) + (flet ((make-option-string + (pair) + (concat (first pair) + (if (> (length (second pair)) 0) + (concat "=" (second pair)))))) + (let* ((lang-sym (intern lang)) + (minted-p (eq org-export-latex-listings 'minted)) + (listings-p (not minted-p)) + (backend-lang + (or (cadr + (assq + lang-sym + (cond + (minted-p org-export-latex-minted-langs) + (listings-p org-export-latex-listings-langs)))) + lang)) + (custom-environment + (cadr + (assq + lang-sym + org-export-latex-custom-lang-environments)))) + (concat + (when (and listings-p (not custom-environment)) + (format + "\\lstset{%s}\n" + (mapconcat + #'make-option-string + (append org-export-latex-listings-options + `(("language" ,backend-lang))) ","))) + (when (and caption org-export-latex-listings-w-names) + (format + "\n%s $\\equiv$ \n" + (replace-regexp-in-string "_" "\\\\_" caption))) + (cond + (custom-environment + (format "\\begin{%s}\n%s\\end{%s}\n" + custom-environment rtn custom-environment)) + (listings-p + (format "\\begin{%s}\n%s\\end{%s}\n" + "lstlisting" rtn "lstlisting")) + (minted-p + (format + "\\begin{minted}[%s]{%s}\n%s\\end{minted}\n" + (mapconcat #'make-option-string + org-export-latex-minted-options ",") + backend-lang rtn))))))) + (t (concat (car org-export-latex-verbatim-wrap) + rtn (cdr org-export-latex-verbatim-wrap))))) + ((eq org-export-current-backend 'ascii) + ;; This is not HTML or LaTeX, so just make it an example. + (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) + (concat caption "\n" + (concat + (mapconcat + (lambda (l) (concat " " l)) + (org-split-string rtn "\n") + "\n") + "\n") + )) + (t + (error "Don't know how to markup source or example block in %s" + (upcase backend-name))))) + (setq rtn + (concat + "\n#+BEGIN_" backend-name "\n" + (org-add-props rtn + '(org-protected t org-example t org-native-text t)) + "\n#+END_" backend-name "\n\n")) (org-add-props rtn nil 'original-indentation indent)))) -(defun org-export-number-lines (text backend - &optional skip1 skip2 number cont +(defun org-export-number-lines (text &optional skip1 skip2 number cont replace-labels label-format) (setq skip1 (or skip1 0) skip2 (or skip2 0)) (if (not cont) (setq org-export-last-code-line-counter-value 0)) @@ -2469,11 +2739,11 @@ INDENT was the original indentation of the block." (fmt (format "%%%dd: " (length (number-to-string nmax)))) (fm (cond - ((eq backend 'html) (format "<span class=\"linenr\">%s</span>" + ((eq org-export-current-backend 'html) (format "<span class=\"linenr\">%s</span>" fmt)) - ((eq backend 'ascii) fmt) - ((eq backend 'latex) fmt) - ((eq backend 'docbook) fmt) + ((eq org-export-current-backend 'ascii) fmt) + ((eq org-export-current-backend 'latex) fmt) + ((eq org-export-current-backend 'docbook) fmt) (t ""))) (label-format (or label-format org-coderef-label-format)) (label-pre (if (string-match "%s" label-format) @@ -2518,7 +2788,7 @@ INDENT was the original indentation of the block." (delete-region (match-beginning 2) (match-end 2)) (insert "(" ref ")") (push (cons ref (concat "(" ref ")")) org-export-code-refs))) - (when (eq backend 'html) + (when (eq org-export-current-backend 'html) (save-excursion (beginning-of-line 1) (insert (format "<span id=\"coderef-%s\" class=\"coderef-off\">" @@ -2562,7 +2832,7 @@ command." (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]buffer with HTML [D]ocBook [l]atex [p]df [d]view pdf [L]atex buffer [x]OXO [ ]keep buffer") (read-char-exclusive)) current-prefix-arg)) - (if (not (member type '(?a ?n ?u ?\C-a ?b ?\C-b ?h ?D ?x ?\ ?l ?p ?d ?L))) + (if (not (member type '(?a ?n ?u ?\C-a ?b ?\C-b ?h ?D ?x ?\ ?l ?p ?d ?L ?H ?R))) (error "Invalid export key")) (let* ((binding (cdr (assoc type '( @@ -2595,7 +2865,7 @@ command." (goto-char (point-min)) (while (re-search-forward org-drawer-regexp nil t) (goto-char (match-beginning 1)) - (or (org-invisible-p) (org-flag-drawer nil)))) + (or (outline-invisible-p) (org-flag-drawer nil)))) (with-current-buffer buffer (erase-buffer)) (save-excursion (setq s (goto-char (point-min))) @@ -2657,7 +2927,7 @@ to the value of `temporary-file-directory'." (setq org-local-vars (org-get-local-variables))) (eval ;; convert to fmt -- mimicing `org-run-like-in-org-mode' (list 'let org-local-vars - (list (intern (concat "org-export-as-" fmt)) + (list (intern (format "org-export-as-%s" fmt)) nil nil nil ''string t)))) (delete-file tmp-file)))) @@ -2705,7 +2975,7 @@ directory." (region (buffer-string)) str-ret) (save-excursion - (switch-to-buffer buffer) + (org-pop-to-buffer-same-window buffer) (erase-buffer) (insert region) (let ((org-inhibit-startup t)) (org-mode)) @@ -2765,8 +3035,8 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+AUTHOR: %s #+EMAIL: %s #+DATE: %s -#+DESCRIPTION: -#+KEYWORDS: +#+DESCRIPTION: +#+KEYWORDS: #+LANGUAGE: %s #+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s #+OPTIONS: TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s @@ -2775,7 +3045,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+EXPORT_EXCLUDE_TAGS: %s #+LINK_UP: %s #+LINK_HOME: %s -#+XSLT: +#+XSLT: #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s @@ -2961,6 +3231,6 @@ The depends on the variable `org-export-copy-to-kill'." (provide 'org-exp) +;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95 ;;; org-exp.el ends here - diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index e5877768fe7..960eb615450 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -1,11 +1,12 @@ ;;; org-faces.el --- Face definitions for Org-mode. -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -50,6 +51,11 @@ :tag "Org Faces" :group 'org-appearance) +(defface org-default + (org-compatible-face 'default nil) + "Face used for default text." + :group 'org-faces) + (defface org-hide '((((background light)) (:foreground "white")) (((background dark)) (:foreground "black"))) @@ -136,7 +142,7 @@ color of the frame." :group 'org-faces) (defface org-special-keyword ;; originally copied from font-lock-string-face - (org-compatible-face nil + (org-compatible-face 'font-lock-keyword-face '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) (t (:italic t)))) @@ -246,7 +252,10 @@ column view defines special faces for each outline level. See the file :group 'org-faces) (defface org-link - '((t :inherit link)) + (org-compatible-face 'link + '((((class color) (background light)) (:foreground "Purple" :underline t)) + (((class color) (background dark)) (:foreground "Cyan" :underline t)) + (t (:underline t)))) "Face for links." :group 'org-faces) @@ -318,7 +327,7 @@ specific tags." (((class color) (min-colors 8)) (:foreground "green")) (t (:bold nil)))) "Face used in agenda, to indicate lines switched to DONE. -This face is used to de-emphasize items that where brightly colord in the +This face is used to de-emphasize items that where brightly colored in the agenda because they were things to do, or overdue. The DONE state itself is of course immediately visible, but for example a passed deadline is \(by default) very bright read. This face could be simply the default face @@ -507,6 +516,15 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword." :group 'org-faces :version "22.1") +(defface org-block-background '((t ())) + "Face used for the source block background.") + +(org-copy-face 'org-meta-line 'org-block-begin-line + "Face used for the line delimiting the begin of source blocks.") + +(org-copy-face 'org-meta-line 'org-block-end-line + "Face used for the line delimiting the end of source blocks.") + (defface org-verbatim (org-compatible-face 'shadow '((((class color grayscale) (min-colors 88) (background light)) @@ -664,6 +682,9 @@ month and 365.24 days for a year)." "Face used for time grids." :group 'org-faces) +(org-copy-face 'org-time-grid 'org-agenda-current-time + "Face used to show the current time in the time grid.") + (defface org-agenda-diary (org-compatible-face 'default nil) @@ -715,5 +736,6 @@ level org-n-level-faces" (provide 'org-faces) +;; arch-tag: 9dab5f91-c4b9-4d6f-bac3-1f6211ad0a04 ;;; org-faces.el ends here diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index 07558af462f..a05463a2875 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -1,11 +1,11 @@ ;;; org-feed.el --- Add RSS feed items to Org files ;; -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -436,7 +436,7 @@ it can be a list structured like an entry in `org-feed-alist'." (if (stringp feed) (setq feed (assoc feed org-feed-alist))) (unless feed (error "No such feed in `org-feed-alist")) - (switch-to-buffer + (org-pop-to-buffer-same-window (org-feed-update feed 'retrieve-only)) (goto-char (point-min))) @@ -674,4 +674,5 @@ formatted as a string, not the original XML data." (provide 'org-feed) +;; arch-tag: 0929b557-9bc4-47f4-9633-30a12dbb5ae2 ;;; org-feed.el ends here diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index c0ca570b7b7..9a92bd5db1d 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -1,11 +1,11 @@ ;;; org-footnote.el --- Footnote support in Org and elsewhere ;; -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -38,8 +38,11 @@ (require 'org-macs) (require 'org-compat) +(declare-function org-combine-plists "org" (&rest plists)) (declare-function org-in-commented-line "org" ()) +(declare-function org-in-indented-comment-line "org" ()) (declare-function org-in-regexp "org" (re &optional nlines visually)) +(declare-function org-in-block-p "org" (names)) (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function outline-next-heading "outline") (declare-function org-trim "org" (s)) @@ -48,24 +51,39 @@ (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-in-verbatim-emphasis "org" ()) (declare-function org-inside-latex-macro-p "org" ()) +(declare-function org-id-uuid "org" ()) +(declare-function org-fill-paragraph "org" (&optional justify)) +(declare-function org-export-preprocess-string "org-exp" + (string &rest parameters)) + +(defvar org-outline-regexp-bol) ; defined in org.el (defvar org-odd-levels-only) ;; defined in org.el +(defvar org-bracket-link-regexp) ; defined in org.el (defvar message-signature-separator) ;; defined in message.el (defconst org-footnote-re - (concat "[^][\n]" ; to make sure it is not at the beginning of a line - "\\[" - "\\(?:" - "\\([0-9]+\\)" - "\\|" - (org-re "\\(fn:\\([-_[:word:]]+?\\)?\\)\\(?::\\([^\]]*?\\)\\)?") - "\\)" - "\\]") + ;; Only [1]-like footnotes are closed in this regexp, as footnotes + ;; from other types might contain square brackets (i.e. links) in + ;; their definition. + ;; + ;; `org-re' is used for regexp compatibility with XEmacs. + (org-re (concat "\\[\\(?:" + ;; Match inline footnotes. + "fn:\\([-_[:word:]]+\\)?:\\|" + ;; Match other footnotes. + "\\(?:\\([0-9]+\\)\\]\\)\\|" + "\\(fn:[-_[:word:]]+\\)" + "\\)")) "Regular expression for matching footnotes.") (defconst org-footnote-definition-re (org-re "^\\(\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]\\)") "Regular expression matching the definition of a footnote.") +(defvar org-footnote-forbidden-blocks '("example" "verse" "src" "ascii" "beamer" + "docbook" "html" "latex" "odt") + "Names of blocks where footnotes are not allowed.") + (defgroup org-footnote nil "Footnotes in Org-mode." :tag "Org Footnote" @@ -113,12 +131,14 @@ t create unique labels of the form [fn:1], [fn:2], ... confirm like t, but let the user edit the created value. In particular, the label can be removed from the minibuffer, to create an anonymous footnote. +random Automatically generate a unique, random label. plain Automatically create plain number labels like [1]" :group 'org-footnote :type '(choice (const :tag "Prompt for label" nil) (const :tag "Create automatic [fn:N]" t) (const :tag "Offer automatic [fn:N] for editing" confirm) + (const :tag "Create a random label" random) (const :tag "Create automatic [N]" plain))) (defcustom org-footnote-auto-adjust nil @@ -146,45 +166,181 @@ extracted will be filled again." :group 'org-footnote :type 'boolean) +(defun org-footnote-in-valid-context-p () + "Is point in a context where footnotes are allowed?" + (save-match-data + (not (or (org-in-commented-line) + (org-in-indented-comment-line) + (org-in-verbatim-emphasis) + ;; Avoid literal example. + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*:[ \t]+")) + ;; Avoid cited text and headers in message-mode. + (and (derived-mode-p 'message-mode) + (or (save-excursion + (beginning-of-line) + (looking-at message-cite-prefix-regexp)) + (message-point-in-header-p))) + ;; Avoid forbidden blocks. + (org-in-block-p org-footnote-forbidden-blocks))))) + (defun org-footnote-at-reference-p () "Is the cursor at a footnote reference? -If yes, return the beginning position, the label, and the definition, if local." - (when (org-in-regexp org-footnote-re 15) - (list (match-beginning 0) - (or (match-string 1) - (if (equal (match-string 2) "fn:") nil (match-string 2))) - (match-string 4)))) + +If so, return a list containing its label, beginning and ending +positions, and the definition, when inlined." + (when (and (org-footnote-in-valid-context-p) + (or (looking-at org-footnote-re) + (org-in-regexp org-footnote-re) + (save-excursion (re-search-backward org-footnote-re nil t))) + ;; Only inline footnotes can start at bol. + (or (eq (char-before (match-end 0)) 58) + (/= (match-beginning 0) (point-at-bol)))) + (let* ((beg (match-beginning 0)) + (label (or (match-string 2) (match-string 3) + ;; Anonymous footnotes don't have labels + (and (match-string 1) (concat "fn:" (match-string 1))))) + ;; Inline footnotes don't end at (match-end 0) as + ;; `org-footnote-re' stops just after the second colon. + ;; Find the real ending with `scan-sexps', so Org doesn't + ;; get fooled by unrelated closing square brackets. + (end (ignore-errors (scan-sexps beg 1)))) + ;; Point is really at a reference if it's located before true + ;; ending of the footnote. + (when (and end (< (point) end) + ;; Verify match isn't a part of a link. + (not (save-excursion + (goto-char beg) + (let ((linkp + (save-match-data + (org-in-regexp org-bracket-link-regexp)))) + (and linkp (< (point) (cdr linkp)))))) + ;; Verify point doesn't belong to a LaTeX macro. + ;; Beware though, when two footnotes are side by + ;; side, once the first one is changed into LaTeX, + ;; the second one might then be considered as an + ;; optional argument of the command. Thus, check + ;; the `org-protected' property of that command. + (or (not (org-inside-latex-macro-p)) + (and (get-text-property (1- beg) 'org-protected) + (not (get-text-property beg 'org-protected))))) + (list label beg end + ;; Definition: ensure this is an inline footnote first. + (and (or (not label) (match-string 1)) + (org-trim (buffer-substring (match-end 0) (1- end))))))))) (defun org-footnote-at-definition-p () - "Is the cursor at a footnote definition. + "Is the cursor at a footnote definition? + This matches only pure definitions like [1] or [fn:name] at the beginning -of a line. It does not a references like [fn:name:definition], where the +of a line. It does not match references like [fn:name:definition], where the footnote text is included and defined locally. -The return value will be nil if not at a footnote definition, and a list -with start and label of the footnote if there is a definition at point." + +The return value will be nil if not at a footnote definition, and a list with +label, start, end and definition of the footnote otherwise." + (when (org-footnote-in-valid-context-p) + (save-excursion + (end-of-line) + (let ((lim (save-excursion (re-search-backward + (concat org-outline-regexp-bol + "\\|^[ \t]*$") nil t)))) + (when (re-search-backward org-footnote-definition-re lim t) + (end-of-line) + (list (match-string 2) + (match-beginning 0) + (save-match-data + ;; In a message, limit search to signature. + (let ((bound (and (derived-mode-p 'message-mode) + (save-excursion + (goto-char (point-max)) + (re-search-backward + message-signature-separator nil t))))) + (or (and (re-search-forward + (org-re + (concat "^[ \t]*$" "\\|" + org-outline-regexp-bol + "\\|" + "^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]")) + bound 'move) + (progn (skip-chars-forward " \t\n") (point-at-bol))) + (point)))) + (org-trim (buffer-substring (match-end 0) (point))))))))) + +(defun org-footnote-get-next-reference (&optional label backward limit) + "Return complete reference of the next footnote. + +If LABEL is provided, get the next reference of that footnote. If +BACKWARD is non-nil, find previous reference instead. LIMIT is +the buffer position bounding the search. + +Return value is a list like those provided by `org-footnote-at-reference-p'. +If no footnote is found, return nil." (save-excursion - (end-of-line 1) - (let ((lim (save-excursion (re-search-backward "^\\*+ \\|^[ \t]*$" nil t)))) - (when (re-search-backward org-footnote-definition-re lim t) - (list (match-beginning 0) (match-string 2)))))) + (let* ((label-fmt (if label (format "\\[%s[]:]" label) org-footnote-re))) + (catch 'exit + (while t + (unless (funcall (if backward #'re-search-backward #'re-search-forward) + label-fmt limit t) + (throw 'exit nil)) + (unless backward (backward-char)) + (let ((ref (org-footnote-at-reference-p))) + (when ref (throw 'exit ref)))))))) + +(defun org-footnote-next-reference-or-definition (limit) + "Move point to next footnote reference or definition. + +LIMIT is the buffer position bounding the search. + +Return value is a list like those provided by +`org-footnote-at-reference-p' or `org-footnote-at-definition-p'. +If no footnote is found, return nil." + (let* (ref) + (catch 'exit + (while t + (unless (re-search-forward org-footnote-re limit t) + (throw 'exit nil)) + ;; Beware: with [1]-like footnotes point will be just after + ;; the closing square bracket. + (backward-char) + (cond + ((setq ref (org-footnote-at-reference-p)) + (throw 'exit ref)) + ;; Definition: also grab the last square bracket, only + ;; matched in `org-footnote-re' for [1]-like footnotes. + ((save-match-data (org-footnote-at-definition-p)) + (let ((end (match-end 0))) + (throw 'exit + (list nil (match-beginning 0) + (if (eq (char-before end) 93) end (1+ end))))))))))) + +(defun org-footnote-get-definition (label) + "Return label, boundaries and definition of the footnote LABEL." + (let* ((label (regexp-quote (org-footnote-normalize-label label))) + (re (format "^\\[%s\\]\\|.\\[%s:" label label)) + pos) + (save-excursion + (when (or (re-search-forward re nil t) + (and (goto-char (point-min)) + (re-search-forward re nil t)) + (and (progn (widen) t) + (goto-char (point-min)) + (re-search-forward re nil t))) + (let ((refp (org-footnote-at-reference-p))) + (cond + ((and (nth 3 refp) refp)) + ((org-footnote-at-definition-p)))))))) (defun org-footnote-goto-definition (label) - "Find the definition of the footnote with label LABEL." + "Move point to the definition of the footnote LABEL." (interactive "sLabel: ") (org-mark-ring-push) - (setq label (org-footnote-normalize-label label)) - (let ((re (format "^\\[%s\\]\\|.\\[%s:" label label)) - pos) - (save-excursion - (setq pos (or (re-search-forward re nil t) - (and (goto-char (point-min)) - (re-search-forward re nil t)) - (and (progn (widen) t) - (goto-char (point-min)) - (re-search-forward re nil t))))) - (if (not pos) + (let ((def (org-footnote-get-definition label))) + (if (not def) (error "Cannot find definition of footnote %s" label) - (goto-char pos) + (goto-char (nth 1 def)) + (looking-at (format "\\[%s\\]\\|\\[%s:" label label)) + (goto-char (match-end 0)) (org-show-context 'link-search) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))) @@ -192,45 +348,60 @@ with start and label of the footnote if there is a definition at point." "Find the first closest (to point) reference of footnote with label LABEL." (interactive "sLabel: ") (org-mark-ring-push) - (setq label (org-footnote-normalize-label label)) - (let ((re (format ".\\[%s[]:]" label)) - (p0 (point)) pos) + (let* ((label (org-footnote-normalize-label label)) ref) (save-excursion - (setq pos (or (re-search-backward re nil t) - (and (goto-char (point-max)) - (re-search-backward re nil t)) - (and (progn (widen) t) - (goto-char p0) - (re-search-backward re nil t)) - (and (goto-char (point-max)) - (re-search-forward re nil t))))) - (if pos - (progn - (goto-char (match-end 0)) - (org-show-context 'link-search)) - (error "Cannot find reference of footnote %s" label)))) + (setq ref (or (org-footnote-get-next-reference label t) + (org-footnote-get-next-reference label) + (save-restriction + (widen) + (or + (org-footnote-get-next-reference label t) + (org-footnote-get-next-reference label)))))) + (if (not ref) + (error "Cannot find reference of footnote %s" label) + (goto-char (nth 1 ref)) + (org-show-context 'link-search)))) (defun org-footnote-normalize-label (label) - (if (numberp label) (setq label (number-to-string label))) - (if (not (string-match "^[0-9]+$\\|^$\\|^fn:" label)) - (setq label (concat "fn:" label))) - label) - -(defun org-footnote-all-labels () - "Return list with all defined foot labels used in the buffer." - (let (rtn l) + "Return LABEL as an appropriate string." + (cond + ((numberp label) (number-to-string label)) + ((equal "" label) nil) + ((not (string-match "^[0-9]+$\\|^fn:" label)) + (concat "fn:" label)) + (t label))) + +(defun org-footnote-all-labels (&optional with-defs) + "Return list with all defined foot labels used in the buffer. + +If WITH-DEFS is non-nil, also associate the definition to each +label. The function will then return an alist whose key is label +and value definition." + (let* (rtn + (push-to-rtn + (function + ;; Depending on WITH-DEFS, store label or (label . def) of + ;; footnote reference/definition given as argument in RTN. + (lambda (el) + (let ((lbl (car el))) + (push (if with-defs (cons lbl (nth 3 el)) lbl) rtn)))))) (save-excursion (save-restriction (widen) + ;; Find all labels found in definitions. (goto-char (point-min)) - (while (re-search-forward org-footnote-definition-re nil t) - (setq l (org-match-string-no-properties 2)) - (and l (add-to-list 'rtn l))) + (let (def) + (while (re-search-forward org-footnote-definition-re nil t) + (when (setq def (org-footnote-at-definition-p)) + (funcall push-to-rtn def)))) + ;; Find all labels found in references. (goto-char (point-min)) - (while (re-search-forward org-footnote-re nil t) - (setq l (or (org-match-string-no-properties 1) - (org-match-string-no-properties 2))) - (and l (not (equal l "fn:")) (add-to-list 'rtn l))))) + (let (ref) + (while (setq ref (org-footnote-get-next-reference)) + (goto-char (nth 2 ref)) + (and (car ref) ; ignore anonymous footnotes + (not (funcall (if with-defs #'assoc #'member) (car ref) rtn)) + (funcall push-to-rtn ref)))))) rtn)) (defun org-footnote-unique-label (&optional current) @@ -253,19 +424,27 @@ This command prompts for a label. If this is a label referencing an existing label, only insert the label. If the footnote label is empty or new, let the user edit the definition of the footnote." (interactive) - (let* ((labels (org-footnote-all-labels)) + (unless (and (not (bolp)) (org-footnote-in-valid-context-p)) + (error "Cannot insert a footnote here")) + (let* ((labels (and (not (equal org-footnote-auto-label 'random)) + (org-footnote-all-labels))) (propose (org-footnote-unique-label labels)) (label - (if (member org-footnote-auto-label '(t plain)) - propose - (completing-read - "Label (leave empty for anonymous): " - (mapcar 'list labels) nil nil - (if (eq org-footnote-auto-label 'confirm) propose nil) - 'org-footnote-label-history)))) - (setq label (org-footnote-normalize-label label)) + (org-footnote-normalize-label + (cond + ((member org-footnote-auto-label '(t plain)) + propose) + ((equal org-footnote-auto-label 'random) + (require 'org-id) + (substring (org-id-uuid) 0 8)) + (t + (completing-read + "Label (leave empty for anonymous): " + (mapcar 'list labels) nil nil + (if (eq org-footnote-auto-label 'confirm) propose nil) + 'org-footnote-label-history)))))) (cond - ((equal label "") + ((not label) (insert "[fn:: ]") (backward-char 1)) ((member label labels) @@ -283,47 +462,61 @@ or new, let the user edit the definition of the footnote." (defun org-footnote-create-definition (label) "Start the definition of a footnote with label LABEL." (interactive "sLabel: ") - (setq label (org-footnote-normalize-label label)) - (let (re) + (let ((label (org-footnote-normalize-label label))) (cond ((org-mode-p) - (if (not org-footnote-section) - ;; No section, put footnote into the current outline node - nil - ;; Try to find or make the special node - (setq re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$")) - (unless (or (re-search-forward re nil t) - (and (progn (widen) t) - (re-search-forward re nil t))) + ;; No section, put footnote into the current outline node Try to + ;; find or make the special node + (when org-footnote-section + (goto-char (point-min)) + (let ((re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$"))) + (unless (or (re-search-forward re nil t) + (and (progn (widen) t) + (re-search-forward re nil t))) (goto-char (point-max)) - (insert "\n\n* " org-footnote-section "\n"))) + (insert "\n\n* " org-footnote-section "\n")))) ;; Now go to the end of this entry and insert there. (org-footnote-goto-local-insertion-point) (org-show-context 'link-search)) (t - (setq re (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$")) - (unless (re-search-forward re nil t) - (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))))) + ;; In a non-Org file. Search for footnote tag, or create it if + ;; necessary (at the end of buffer, or before a signature if in + ;; Message mode). Set point after any definition already there. + (let ((tag (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$")) + (max (save-excursion + (if (and (derived-mode-p 'message-mode) + (re-search-forward + message-signature-separator nil t)) + (copy-marker (point-at-bol) t) + (copy-marker (point-max) t))))) + (goto-char max) + (unless (re-search-backward tag nil t) (skip-chars-backward " \t\r\n") (delete-region (point) max) - (insert "\n\n") - (insert org-footnote-tag-for-non-org-mode-files "\n"))))) - ;; Skip existing footnotes - (while (re-search-forward "^[[:space:]]*\\[[^]]+\\] " nil t) - (forward-line)) - (insert "[" label "] \n") - (goto-char (1- (point))) + (insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n")) + ;; Skip existing footnotes. + (while (re-search-forward org-footnote-definition-re max t)) + (let ((def (org-footnote-at-definition-p))) + (when def (goto-char (nth 2 def)))) + (set-marker max nil)))) + ;; Insert footnote label, position point and notify user. + (unless (bolp) (insert "\n")) + (insert "\n[" label "] \n") + (backward-char) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))) ;;;###autoload (defun org-footnote-action (&optional special) "Do the right thing for footnotes. -When at a footnote reference, jump to the definition. When at a definition, -jump to the references. When neither at definition or reference, -create a new footnote, interactively. + +When at a footnote reference, jump to the definition. + +When at a definition, jump to the references if they exist, offer +to create them otherwise. + +When neither at definition or reference, create a new footnote, +interactively. + With prefix arg SPECIAL, offer additional commands in a menu." (interactive "P") (let (tmp c) @@ -332,35 +525,66 @@ With prefix arg SPECIAL, offer additional commands in a menu." (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s |->[n]umeric | [d]elete") (setq c (read-char-exclusive)) (cond - ((equal c ?s) - (org-footnote-normalize 'sort)) - ((equal c ?r) - (org-footnote-renumber-fn:N)) - ((equal c ?S) + ((eq c ?s) (org-footnote-normalize 'sort)) + ((eq c ?r) (org-footnote-renumber-fn:N)) + ((eq c ?S) (org-footnote-renumber-fn:N) (org-footnote-normalize 'sort)) - ((equal c ?n) - (org-footnote-normalize)) - ((equal c ?d) - (org-footnote-delete)) + ((eq c ?n) (org-footnote-normalize)) + ((eq c ?d) (org-footnote-delete)) (t (error "No such footnote command %c" c)))) ((setq tmp (org-footnote-at-reference-p)) - (if (nth 1 tmp) - (org-footnote-goto-definition (nth 1 tmp)) - (goto-char (match-beginning 4)))) + (cond + ;; Anonymous footnote: move point at the beginning of its + ;; definition. + ((not (car tmp)) + (goto-char (nth 1 tmp)) + (forward-char 5)) + ;; A definition exists: move to it. + ((ignore-errors (org-footnote-goto-definition (car tmp)))) + ;; No definition exists: offer to create it. + ((yes-or-no-p (format "No definition for %s. Create one? " (car tmp))) + (org-footnote-create-definition (car tmp))))) ((setq tmp (org-footnote-at-definition-p)) - (org-footnote-goto-previous-reference (nth 1 tmp))) + (org-footnote-goto-previous-reference (car tmp))) (t (org-footnote-new))))) +(defvar org-footnote-insert-pos-for-preprocessor 'point-max + "See `org-footnote-normalize'.") + +(defvar org-export-footnotes-seen nil) ; silence byte-compiler +(defvar org-export-footnotes-data nil) ; silence byte-compiler + ;;;###autoload -(defun org-footnote-normalize (&optional sort-only for-preprocessor) +(defun org-footnote-normalize (&optional sort-only export-props) "Collect the footnotes in various formats and normalize them. + This finds the different sorts of footnotes allowed in Org, and normalizes them to the usual [N] format that is understood by the Org-mode exporters. + When SORT-ONLY is set, only sort the footnote definitions into the -referenced sequence." +referenced sequence. + +If Org is amidst an export process, EXPORT-PROPS will hold the +export properties of the buffer. + +When EXPORT-PROPS is non-nil, the default action is to insert +normalized footnotes towards the end of the pre-processing buffer. +Some exporters like docbook, odt, etc. expect that footnote +definitions be available before any references to them. Such +exporters can let bind `org-footnote-insert-pos-for-preprocessor' to +symbol 'point-min to achieve the desired behaviour. + +Additional note on `org-footnote-insert-pos-for-preprocessor': +1. This variable has not effect when FOR-PREPROCESSOR is nil. +2. This variable (potentially) obviates the need for extra scan + of pre-processor buffer as witnessed in + `org-export-docbook-get-footnotes'." ;; This is based on Paul's function, but rewritten. + ;; + ;; Re-create `org-with-limited-levels', but not limited to Org + ;; buffers. (let* ((limit-level (and (boundp 'org-inlinetask-min-level) org-inlinetask-min-level @@ -369,54 +593,71 @@ referenced sequence." (if org-odd-levels-only (and limit-level (1- (* limit-level 2))) limit-level))) - (outline-regexp + (org-outline-regexp (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))) - (count 0) - ref def idef ref-table beg beg1 marker a before ins-point) - (save-excursion - ;; Now find footnote references, and extract the definitions + ;; Determine the highest marker used so far. + (ref-table (when export-props org-export-footnotes-seen)) + (count (if (and export-props ref-table) + (apply 'max (mapcar (lambda (e) (nth 1 e)) ref-table)) + 0)) + ins-point ref) + (save-excursion + ;; 1. Find every footnote reference, extract the definition, and + ;; collect that data in REF-TABLE. If SORT-ONLY is nil, also + ;; normalize references. (goto-char (point-min)) - (while (re-search-forward org-footnote-re nil t) - (unless (or (org-in-commented-line) (org-in-verbatim-emphasis) - (org-inside-latex-macro-p)) - (org-if-unprotected - (setq def (match-string 4) - idef def - ref (or (match-string 1) (match-string 2)) - before (char-to-string (char-after (match-beginning 0)))) - (if (equal ref "fn:") (setq ref nil)) - (if (and ref (setq a (assoc ref ref-table))) - (progn - (setq marker (nth 1 a)) - (unless (nth 2 a) (setf (caddr a) def))) - (setq marker (number-to-string (incf count)))) - (save-match-data - (if def - (setq def (org-trim def)) - (save-excursion - (goto-char (point-min)) - (if (not (re-search-forward (concat "^\\[" (regexp-quote ref) - "\\]") nil t)) - (setq def nil) - (setq beg (match-beginning 0)) - (setq beg1 (match-end 0)) - (re-search-forward - (org-re "^[ \t]*$\\|^\\*+ \\|^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]") - nil 'move) - (setq def (buffer-substring beg1 (or (match-beginning 0) - (point-max)))) - (goto-char beg) - (skip-chars-backward " \t\n\t") - (delete-region (1+ (point)) (match-beginning 0)))))) - (unless sort-only - (replace-match (concat before "[" marker "]") t t) - (and idef - org-footnote-fill-after-inline-note-extraction - (fill-paragraph))) - (if (not a) (push (list ref marker def (if idef t nil)) - ref-table))))) - - ;; First find and remove the footnote section + (while (setq ref (org-footnote-get-next-reference)) + (let* ((lbl (car ref)) + ;; When footnote isn't anonymous, check if it's label + ;; (REF) is already stored in REF-TABLE. In that case, + ;; extract number used to identify it (MARKER). If + ;; footnote is unknown, increment the global counter + ;; (COUNT) to create an unused identifier. + (a (and lbl (assoc lbl ref-table))) + (marker (or (nth 1 a) (incf count))) + ;; Is the reference inline or pointing to an inline + ;; footnote? + (inlinep (or (stringp (nth 3 ref)) (nth 3 a)))) + ;; Replace footnote reference with [MARKER]. Maybe fill + ;; paragraph once done. If SORT-ONLY is non-nil, only move + ;; to the end of reference found to avoid matching it twice. + ;; If EXPORT-PROPS isn't nil, also add `org-footnote' + ;; property to it, so it can be easily recognized by + ;; exporters. + (if sort-only + (goto-char (nth 2 ref)) + (delete-region (nth 1 ref) (nth 2 ref)) + (goto-char (nth 1 ref)) + (let ((new-ref (format "[%d]" marker))) + (when export-props (org-add-props new-ref '(org-footnote t))) + (insert new-ref)) + (and inlinep + org-footnote-fill-after-inline-note-extraction + (org-fill-paragraph))) + ;; Add label (REF), identifier (MARKER) and definition (DEF) + ;; to REF-TABLE if data was unknown. + (unless a + (let ((def (or (nth 3 ref) ; inline + (and export-props + (cdr (assoc lbl org-export-footnotes-data))) + (nth 3 (org-footnote-get-definition lbl))))) + (push (list lbl marker + ;; When exporting, each definition goes + ;; through `org-export-preprocess-string' so + ;; it is ready to insert in the + ;; backend-specific buffer. + (if export-props + (let ((parameters + (org-combine-plists + export-props + '(:todo-keywords t :tags t :priority t)))) + (org-export-preprocess-string def parameters)) + def) + inlinep) ref-table))) + ;; Remove definition of non-inlined footnotes. + (unless inlinep (org-footnote-delete-definitions lbl)))) + ;; 2. Find and remove the footnote section, if any. Also + ;; determine where footnotes shall be inserted (INS-POINT). (goto-char (point-min)) (cond ((org-mode-p) @@ -425,82 +666,97 @@ referenced sequence." (concat "^\\*[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$") nil t)) - (if (or for-preprocessor (not org-footnote-section)) - (replace-match "") - (org-back-to-heading t) - (forward-line 1) - (setq ins-point (point)) - (delete-region (point) (org-end-of-subtree t))) - (goto-char (point-max)) - (unless for-preprocessor - (when org-footnote-section - (or (bolp) (insert "\n")) - (insert "* " org-footnote-section "\n") - (setq ins-point (point)))))) + (progn + (setq ins-point (match-beginning 0)) + (delete-region (match-beginning 0) (org-end-of-subtree t))) + (setq ins-point (point-max)))) (t - (if (re-search-forward - (concat "^" - (regexp-quote org-footnote-tag-for-non-org-mode-files) - "[ \t]*$") - nil t) - (replace-match "")) - (goto-char (point-max)) - (skip-chars-backward " \t\n\r") - (delete-region (point) (point-max)) - (insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n") + (when (re-search-forward + (concat "^" + (regexp-quote org-footnote-tag-for-non-org-mode-files) + "[ \t]*$") + nil t) + (replace-match "")) + ;; In message-mode, ensure footnotes are inserted before the + ;; signature. + (let ((pt-max + (or (and (derived-mode-p 'message-mode) + (save-excursion + (goto-char (point-max)) + (re-search-backward + message-signature-separator nil t) + (1- (point)))) + (point-max)))) + (goto-char pt-max) + (skip-chars-backward " \t\n\r") + (forward-line) + (delete-region (point) pt-max)) (setq ins-point (point)))) - - ;; Insert the footnotes again - (goto-char (or ins-point (point-max))) - (setq ref-table (reverse ref-table)) - (when sort-only - ;; remove anonymous and inline footnotes from the list - (setq ref-table - (delq nil (mapcar - (lambda (x) (and (car x) - (not (equal (car x) "fn:")) - (not (nth 3 x)) - x)) - ref-table)))) - ;; Make sure each footnote has a description, or an error message. + ;; 3. Clean-up REF-TABLE. (setq ref-table - (mapcar - (lambda (x) - (if (not (nth 2 x)) - (setcar (cddr x) - (format "FOOTNOTE DEFINITION NOT FOUND: %s" (car x))) - (setcar (cddr x) (org-trim (nth 2 x)))) - x) - ref-table)) - - (if (or (not (org-mode-p)) ; not an Org file - org-footnote-section ; we do not use a footnote section - (not sort-only) ; this is normalization - for-preprocessor) ; the is the preprocessor - ;; Insert the footnotes together in one place - (progn - (setq def - (mapconcat + (delq nil + (mapcar (lambda (x) - (format "[%s] %s" (nth (if sort-only 0 1) x) - (org-trim (nth 2 x)))) - ref-table "\n\n")) - (if ref-table (insert "\n" def "\n\n"))) - ;; Insert each footnote near the first reference - ;; Happens only in Org files with no special footnote section, - ;; and only when doing sorting - (mapc 'org-insert-footnote-reference-near-definition - ref-table))))) + (cond + ;; When only sorting, ignore inline footnotes. + ((and sort-only (nth 3 x)) nil) + ;; No definition available: provide one. + ((not (nth 2 x)) + (append (butlast x 2) + (list (format "DEFINITION NOT FOUND: %s" (car x)) + (nth 3 x)))) + (t x))) + ref-table))) + (setq ref-table (nreverse ref-table)) + ;; 4. Insert the footnotes again in the buffer, at the + ;; appropriate spot. + (goto-char (or + (and export-props + (eq org-footnote-insert-pos-for-preprocessor 'point-min) + (point-min)) + ins-point + (point-max))) + (cond + ;; No footnote: exit. + ((not ref-table)) + ;; Cases when footnotes should be inserted in one place. + ((or (not (org-mode-p)) + org-footnote-section + (not sort-only)) + ;; Insert again the section title. + (cond + ((not (org-mode-p)) + (insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n")) + ((and org-footnote-section (not export-props)) + (or (bolp) (insert "\n")) + (insert "* " org-footnote-section "\n"))) + ;; Insert the footnotes. + (insert "\n" + (mapconcat (lambda (x) (format "[%s] %s" + (nth (if sort-only 0 1) x) (nth 2 x))) + ref-table "\n\n") + "\n\n") + ;; When exporting, add newly inserted markers along with their + ;; associated definition to `org-export-footnotes-seen'. + (when export-props + (setq org-export-footnotes-seen ref-table))) + ;; Else, insert each definition at the end of the section + ;; containing their first reference. Happens only in Org files + ;; with no special footnote section, and only when doing + ;; sorting. + (t (mapc 'org-insert-footnote-reference-near-definition + ref-table)))))) (defun org-insert-footnote-reference-near-definition (entry) "Find first reference of footnote ENTRY and insert the definition there. ENTRY is (fn-label num-mark definition)." (when (car entry) (goto-char (point-min)) - (when (re-search-forward (format ".\\[%s[]:]" (regexp-quote (car entry))) - nil t) - (org-footnote-goto-local-insertion-point) - (insert (format "\n\n[%s] %s" (car entry) (nth 2 entry)))))) + (let ((ref (org-footnote-get-next-reference (car entry)))) + (when ref + (goto-char (nth 2 ref)) + (org-footnote-goto-local-insertion-point) + (insert (format "\n[%s] %s\n" (car entry) (nth 2 entry))))))) (defun org-footnote-goto-local-insertion-point () "Find insertion point for footnote, just before next outline heading." @@ -514,39 +770,60 @@ ENTRY is (fn-label num-mark definition)." (skip-chars-backward "\n\r\t ") (forward-line)) +(defun org-footnote-delete-references (label) + "Delete every reference to footnote LABEL. +Return the number of footnotes removed." + (save-excursion + (goto-char (point-min)) + (let (ref (nref 0)) + (while (setq ref (org-footnote-get-next-reference label)) + (goto-char (nth 1 ref)) + (delete-region (nth 1 ref) (nth 2 ref)) + (incf nref)) + nref))) + +(defun org-footnote-delete-definitions (label) + "Delete every definition of the footnote LABEL. +Return the number of footnotes removed." + (save-excursion + (goto-char (point-min)) + (let ((def-re (concat "^\\[" (regexp-quote label) "\\]")) + (ndef 0)) + (while (re-search-forward def-re nil t) + (let ((full-def (org-footnote-at-definition-p))) + (delete-region (nth 1 full-def) (nth 2 full-def))) + (incf ndef)) + ndef))) + (defun org-footnote-delete (&optional label) "Delete the footnote at point. This will remove the definition (even multiple definitions if they exist) -and all references of a footnote label." +and all references of a footnote label. + +If LABEL is non-nil, delete that footnote instead." (catch 'done - (let (x label l beg def-re (nref 0) (ndef 0)) - (unless label - (when (setq x (org-footnote-at-reference-p)) - (setq label (nth 1 x)) - (when (or (not label) (equal "fn:" label)) - (delete-region (1+ (match-beginning 0)) (match-end 0)) - (message "Anonymous footnote removed") - (throw 'done t))) - (when (and (not label) (setq x (org-footnote-at-definition-p))) - (setq label (nth 1 x))) - (unless label (error "Don't know which footnote to remove"))) - (save-excursion - (save-restriction - (goto-char (point-min)) - (while (re-search-forward org-footnote-re nil t) - (setq l (or (match-string 1) (match-string 2))) - (when (equal l label) - (delete-region (1+ (match-beginning 0)) (match-end 0)) - (incf nref))) - (goto-char (point-min)) - (setq def-re (concat "^\\[" (regexp-quote label) "\\]")) - (while (re-search-forward def-re nil t) - (setq beg (match-beginning 0)) - (if (re-search-forward "^\\[\\|^[ \t]*$\\|^\\*+ " nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max))) - (delete-region beg (point)) - (incf ndef)))) + (let* ((nref 0) (ndef 0) x + ;; 1. Determine LABEL of footnote at point. + (label (cond + ;; LABEL is provided as argument. + (label) + ;; Footnote reference at point. If the footnote is + ;; anonymous, delete it and exit instead. + ((setq x (org-footnote-at-reference-p)) + (or (car x) + (progn + (delete-region (nth 1 x) (nth 2 x)) + (message "Anonymous footnote removed") + (throw 'done t)))) + ;; Footnote definition at point. + ((setq x (org-footnote-at-definition-p)) + (car x)) + (t (error "Don't know which footnote to remove"))))) + ;; 2. Now that LABEL is non-nil, find every reference and every + ;; definition, and delete them. + (setq nref (org-footnote-delete-references label) + ndef (org-footnote-delete-definitions label)) + ;; 3. Verify consistency of footnotes and notify user. (org-footnote-auto-adjust-maybe) (message "%d definition(s) of and %d reference(s) of footnote %s removed" ndef nref label)))) @@ -574,7 +851,7 @@ and all references of a footnote label." (when (memq org-footnote-auto-adjust '(t renumber)) (org-footnote-renumber-fn:N)) (when (memq org-footnote-auto-adjust '(t sort)) - (let ((label (nth 1 (org-footnote-at-definition-p)))) + (let ((label (car (org-footnote-at-definition-p)))) (org-footnote-normalize 'sort) (when label (goto-char (point-min)) @@ -585,5 +862,6 @@ and all references of a footnote label." (provide 'org-footnote) +;; arch-tag: 1b5954df-fb5d-4da5-8709-78d944dbfc37 ;;; org-footnote.el ends here diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el index dccdf449296..6664bf1f4f2 100644 --- a/lisp/org/org-freemind.el +++ b/lisp/org/org-freemind.el @@ -1,11 +1,11 @@ ;;; org-freemind.el --- Export Org files to freemind -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Lennart Borgman (lennart O borgman A gmail O com) ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -308,7 +308,7 @@ MATCHED is the link just matched." (let* ((link (match-string 1 matched)) (text (match-string 2 matched)) (ext (file-name-extension link)) - (col-pos (string-match-p ":" link)) + (col-pos (org-string-match-p ":" link)) (is-img (and (image-type-from-file-name link) (let ((url-type (substring link 0 col-pos))) (member url-type '("file" "http" "https"))))) @@ -414,7 +414,7 @@ MATCHED is the link just matched." (defun org-freemind-convert-text-p (text) "Convert TEXT to html with <p> paragraphs." ;; (string-match-p "[^ ]" " a") - (setq org-freemind-bol-helper-base-indent (string-match-p "[^ ]" text)) + (setq org-freemind-bol-helper-base-indent (org-string-match-p "[^ ]" text)) (setq text (org-freemind-escape-str-from-org text)) (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text)) @@ -658,7 +658,7 @@ Otherwise give an error say the file exists." (defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line) (with-current-buffer org-buffer (dolist (node-style org-freemind-node-styles) - (when (string-match-p (car node-style) buffer-file-name) + (when (org-string-match-p (car node-style) buffer-file-name) (setq org-freemind-node-style (cadr node-style)))) ;;(message "org-freemind-node-style =%s" org-freemind-node-style) (save-match-data @@ -835,7 +835,7 @@ Otherwise give an error say the file exists." (dolist (style-list org-freemind-node-style) (let ((node-regexp (car style-list))) (message "node-regexp=%s node-name=%s" node-regexp node-name) - (when (string-match-p node-regexp node-name) + (when (org-string-match-p node-regexp node-name) ;;(setq node-style (org-freemind-do-apply-node-style style-list)) (setq node-style (cadr style-list)) (when node-style @@ -1172,8 +1172,8 @@ PATH should be a list of steps, where each step has the form (when (< 0 (- level skip-levels)) (dolist (attrib attributes) (case (car attrib) - (TEXT (setq text (cdr attrib))) - (text (setq text (cdr attrib))))) + ('TEXT (setq text (cdr attrib))) + ('text (setq text (cdr attrib))))) (unless text ;; There should be a richcontent node holding the text: (setq text (org-freemind-get-richcontent-node-text node))) @@ -1193,7 +1193,7 @@ PATH should be a list of steps, where each step has the form (setq text (replace-regexp-in-string "\n $" "" text)) (insert text)) (case qname - (node + ('node (insert (make-string (- level skip-levels) ?*) " " text "\n") (when note (insert ":COMMENT:\n" note "\n:END:\n")) @@ -1237,6 +1237,7 @@ PATH should be a list of steps, where each step has the form (provide 'org-freemind) +;; arch-tag: e7b0d776-94fd-404a-b35e-0f855fae3627 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; org-freemind.el ends here diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index e8424a1e5cd..da0712b9249 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -1,12 +1,13 @@ ;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Tassilo Horn <tassilo at member dot fsf dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -150,12 +151,17 @@ If `org-store-link' was called with a prefix arg the meaning of (gnus-summary-article-header))) (from (mail-header-from header)) (message-id (org-remove-angle-brackets (mail-header-id header))) - (date (mail-header-date header)) - (date-ts (and date (format-time-string - (org-time-stamp-format t) (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) + (date (org-trim (mail-header-date header))) + (date-ts (and date + (ignore-errors + (format-time-string + (org-time-stamp-format t) + (date-to-time date))))) + (date-ts-ia (and date + (ignore-errors + (format-time-string + (org-time-stamp-format t t) + (date-to-time date))))) (subject (copy-sequence (mail-header-subject header))) (to (cdr (assq 'To (mail-header-extra header)))) newsgroups x-no-archive desc link) @@ -180,7 +186,35 @@ If `org-store-link' was called with a prefix arg the meaning of link (org-gnus-article-link group newsgroups message-id x-no-archive)) (org-add-link-props :link link :description desc) - link)))) + link)) + ((eq major-mode 'message-mode) + (setq org-store-link-plist nil) ; reset + (save-excursion + (save-restriction + (message-narrow-to-headers) + (and (not (message-fetch-field "Message-ID")) + (message-generate-headers '(Message-ID))) + (goto-char (point-min)) + (re-search-forward "^Message-ID: *.*$" nil t) + (put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil) + (let ((gcc (car (last + (message-unquote-tokens + (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,"))))) + (id (org-remove-angle-brackets (mail-fetch-field "Message-ID"))) + (to (mail-fetch-field "To")) + (from (mail-fetch-field "From")) + (subject (mail-fetch-field "Subject")) + desc link + newsgroup xarchive) ; those are always nil for gcc + (and (not gcc) + (error "Can not create link: No Gcc header found.")) + (org-store-link-props :type "gnus" :from from :subject subject + :message-id id :group gcc :to to) + (setq desc (org-email-link-description) + link (org-gnus-article-link + gcc newsgroup id xarchive)) + (org-add-link-props :link link :description desc) + link)))))) (defun org-gnus-open-nntp (path) "Follow the nntp: link specified by PATH." @@ -215,7 +249,7 @@ If `org-store-link' was called with a prefix arg the meaning of (when article (setq article (org-substring-no-properties article))) (cond ((and group article) - (gnus-activate-group group t) + (gnus-activate-group group) (condition-case nil (let* ((method (gnus-find-method-for-group group)) (backend (car method)) @@ -257,5 +291,6 @@ If `org-store-link' was called with a prefix arg the meaning of (provide 'org-gnus) +;; arch-tag: 512e0840-58fa-45b3-b456-71e10fa2376d ;;; org-gnus.el ends here diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 33c55cf46d1..ebdfa0c773c 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -1,11 +1,11 @@ ;;; org-habit.el --- The habit tracking code for Org-mode -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw at gnu dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -170,10 +170,18 @@ This list represents a \"habit\" for the rest of this module." habit-entry scheduled-repeat)) (setq deadline (+ scheduled (- dr-days sr-days)))) (org-back-to-heading t) - (while (re-search-forward "- State \"DONE\".*\\[\\([^]]+\\)\\]" end t) - (push (time-to-days - (org-time-string-to-time (match-string-no-properties 1))) - closed-dates)) + (let* ((maxdays (+ org-habit-preceding-days org-habit-following-days)) + (reversed org-log-states-order-reversed) + (search (if reversed 're-search-forward 're-search-backward)) + (limit (if reversed end (point))) + (count 0)) + (unless reversed (goto-char end)) + (while (and (< count maxdays) + (funcall search "- State \"DONE\".*\\[\\([^]]+\\)\\]" limit t)) + (push (time-to-days + (org-time-string-to-time (match-string-no-properties 1))) + closed-dates) + (setq count (1+ count)))) (list scheduled sr-days deadline dr-days closed-dates)))) (defsubst org-habit-scheduled (habit) @@ -350,5 +358,6 @@ current time." (provide 'org-habit) +;; arch-tag: 64e070d9-bd09-4917-bd44-44465f5ed348 ;;; org-habit.el ends here diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el index 8ccca0ca987..c150b3d8dd2 100644 --- a/lisp/org/org-html.el +++ b/lisp/org/org-html.el @@ -1,11 +1,12 @@ ;;; org-html.el --- HTML export for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -28,11 +29,14 @@ ;;; Code: (require 'org-exp) +(require 'format-spec) (eval-when-compile (require 'cl)) (declare-function org-id-find-id-file "org-id" (id)) (declare-function htmlize-region "ext:htmlize" (beg end)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) (defgroup org-export-html nil "Options specific for HTML export of Org-mode files." @@ -58,6 +62,12 @@ by the footnotes themselves." :group 'org-export-html :type 'string) + +(defcustom org-export-html-footnote-separator "<sup>, </sup>" + "Text used to separate footnotes." + :group 'org-export-html + :type 'string) + (defcustom org-export-html-coding-system nil "Coding system for HTML export, defaults to `buffer-file-coding-system'." :group 'org-export-html @@ -194,7 +204,7 @@ For example, a valid value would be: ]]> </style> -If you'd like to refer to en external style file, use something like +If you'd like to refer to an external style file, use something like <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> @@ -289,7 +299,7 @@ You can also customize this for each buffer, using something like \"TeX/noUndefined.js\"], tex2jax: { inlineMath: [ [\"\\\\(\",\"\\\\)\"] ], - displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"] ], + displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ], skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"], ignoreClass: \"tex2jax_ignore\", processEscapes: false, @@ -341,8 +351,74 @@ CSS classes, then this prefix can be very useful." :group 'org-export-html :type 'string) -(defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n" - "Format for typesetting the document title in HTML export." +(defcustom org-export-html-preamble t + "Non-nil means insert a preamble in HTML export. + +When `t', insert a string as defined by one of the formatting +strings in `org-export-html-preamble-format'. When set to a +string, this string overrides `org-export-html-preamble-format'. +When set to a function, apply this function and insert the +returned string. The function takes the property list of export +options as its only argument. + +Setting :html-preamble in publishing projects will take +precedence over this variable." + :group 'org-export-html + :type '(choice (const :tag "No preamble" nil) + (const :tag "Default preamble" t) + (string :tag "Custom formatting string") + (function :tag "Function (must return a string)"))) + +(defcustom org-export-html-preamble-format '(("en" "")) + "The format for the HTML preamble. + +%t stands for the title. +%a stands for the author's name. +%e stands for the author's email. +%d stands for the date. + +If you need to use a \"%\" character, you need to escape it +like that: \"%%\"." + :group 'org-export-html + :type 'string) + +(defcustom org-export-html-postamble 'auto + "Non-nil means insert a postamble in HTML export. + +When `t', insert a string as defined by the formatting string in +`org-export-html-postamble-format'. When set to a string, this +string overrides `org-export-html-postamble-format'. When set to +'auto, discard `org-export-html-postamble-format' and honor +`org-export-author/email/creator-info' variables. When set to a +function, apply this function and insert the returned string. +The function takes the property list of export options as its +only argument. + +Setting :html-postamble in publishing projects will take +precedence over this variable." + :group 'org-export-html + :type '(choice (const :tag "No postamble" nil) + (const :tag "Auto preamble" 'auto) + (const :tag "Default formatting string" t) + (string :tag "Custom formatting string") + (function :tag "Function (must return a string)"))) + +(defcustom org-export-html-postamble-format + '(("en" "<p class=\"author\">Author: %a (%e)</p> +<p class=\"date\">Date: %d</p> +<p class=\"creator\">Generated by %c</p> +<p class=\"xhtml-validation\">%v</p> +")) + "The format for the HTML postamble. + +%a stands for the author's name. +%e stands for the author's email. +%d stands for the date. +%c will be replaced by information about Org/Emacs versions. +%v will be replaced by `org-export-html-validation-link'. + +If you need to use a \"%\" character, you need to escape it +like that: \"%%\"." :group 'org-export-html :type 'string) @@ -468,28 +544,30 @@ When nil, also column one will use data tags." :group 'org-export-tables :type 'boolean) -(defcustom org-export-html-validation-link nil - "Non-nil means add validation link to postamble of HTML exported files." - :group 'org-export-html - :type '(choice - (const :tag "Nothing" nil) - (const :tag "XHTML 1.0" "<p class=\"xhtml-validation\"><a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a></p>") - (string :tag "Specify full HTML"))) - - -(defcustom org-export-html-with-timestamp nil - "If non-nil, write timestamp into the exported HTML text. -If non-nil Write `org-export-html-html-helper-timestamp' into the -exported HTML text. Otherwise, the buffer will just be saved to -a file." +(defcustom org-export-html-validation-link + "<a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a>" + "Link to HTML validation service." :group 'org-export-html - :type 'boolean) + :type 'string) -(defcustom org-export-html-html-helper-timestamp - "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n" - "The HTML tag used as timestamp delimiter for HTML-helper-mode." +;; FIXME Obsolete since Org 7.7 +;; Use the :timestamp option or `org-export-time-stamp-file' instead +(defvar org-export-html-with-timestamp nil + "If non-nil, write container for HTML-helper-mode timestamp.") + +;; FIXME Obsolete since Org 7.7 +(defvar org-export-html-html-helper-timestamp + "\n<p><br/><br/>\n<!-- hhmts start --> <!-- hhmts end --></p>\n" + "The HTML tag used as timestamp delimiter for HTML-helper-mode.") + +(defcustom org-export-html-protect-char-alist + '(("&" . "&") + ("<" . "<") + (">" . ">")) + "Alist of characters to be converted by `org-html-protect'." :group 'org-export-html - :type 'string) + :type '(repeat (cons (string :tag "Character") + (string :tag "HTML equivalent")))) (defgroup org-export-htmlize nil "Options for processing examples with htmlize.el." @@ -498,8 +576,10 @@ a file." (defcustom org-export-htmlize-output-type 'inline-css "Output type to be used by htmlize when formatting code snippets. -We use as default `inline-css', in order to make the resulting -HTML self-containing. +Choices are `css', to export the CSS selectors only, or `inline-css', to +export the CSS attribute values inline in the HTML. We use as default +`inline-css', in order to make the resulting HTML self-containing. + However, this will fail when using Emacs in batch mode for export, because then no rich font definitions are in place. It will also not be good if people with different Emacs setup contribute HTML files to a website, @@ -532,18 +612,22 @@ with a link to this URL." (const :tag "Keep internal css" nil) (string :tag "URL or local href"))) -;;; Variables, constants, and parameter plists +;; FIXME: The following variable is obsolete since Org 7.7 but is +;; still declared and checked within code for compatibility reasons. +;; Use the custom variables `org-export-html-divs' instead. +(defvar org-export-html-content-div "content" + "The name of the container DIV that holds all the page contents. + +This variable is obsolete since Org version 7.7. +Please set `org-export-html-divs' instead.") -(defvar org-export-html-preamble nil - "Preamble, to be inserted just after <body>. Set by publishing functions. -This may also be a function, building and inserting the preamble.") -(defvar org-export-html-postamble nil - "Postamble, to be inserted just before </body>. Set by publishing functions. -This may also be a function, building and inserting the postamble.") -(defvar org-export-html-auto-preamble t - "Should default preamble be inserted? Set by publishing functions.") -(defvar org-export-html-auto-postamble t - "Should default postamble be inserted? Set by publishing functions.") +(defcustom org-export-html-divs '("preamble" "content" "postamble") + "The name of the main divs for HTML export." + :group 'org-export-html + :type '(list + (string :tag " Div for the preamble:") + (string :tag " Div for the content:") + (string :tag "Div for the postamble:"))) ;;; Hooks @@ -653,7 +737,7 @@ a Lisp program could call this function in the following way: When called interactively, the output buffer is selected, and shown in a window. A non-interactive call will only return the buffer." (interactive "r\nP") - (when (interactive-p) + (when (org-called-interactively-p 'any) (setq buffer "*Org HTML Export*")) (let ((transient-mark-mode t) (zmacs-regions t) ext-plist rtn) @@ -665,7 +749,7 @@ in a window. A non-interactive call will only return the buffer." nil nil ext-plist buffer body-only)) (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (interactive-p) (bufferp rtn)) + (if (and (org-called-interactively-p 'any) (bufferp rtn)) (switch-to-buffer-other-window rtn) rtn))) @@ -766,7 +850,8 @@ MAY-INLINE-P allows inlining it as an image." (not type) (string= type "http") (string= type "https") - (string= type "file")) + (string= type "file") + (string= type "coderef")) (if fragment (setq thefile (concat thefile "#" fragment)))) @@ -776,7 +861,8 @@ MAY-INLINE-P allows inlining it as an image." (setq thefile (let ((str (org-export-html-format-href thefile))) - (if (and type (not (string= "file" type))) + (if (and type (not (or (string= "file" type) + (string= "coderef" type)))) (concat type ":" str) str))) @@ -788,10 +874,178 @@ MAY-INLINE-P allows inlining it as an image." (message "image %s %s" thefile org-par-open) (org-export-html-format-image thefile org-par-open)) (concat - "<a href=\"" thefile "\"" attr ">" + "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">" (org-export-html-format-desc desc) "</a>"))))) +(defun org-html-handle-links (line opt-plist) + "Return LINE with markup of Org mode links. +OPT-PLIST is the export options list." + (let ((start 0) + (current-dir (if buffer-file-name + (file-name-directory buffer-file-name) + default-directory)) + (link-validate (plist-get opt-plist :link-validation-function)) + type id-file fnc + rpl path attr desc descp desc1 desc2 link) + (while (string-match org-bracket-link-analytic-regexp++ line start) + (setq start (match-beginning 0)) + (setq path (save-match-data (org-link-unescape + (match-string 3 line)))) + (setq type (cond + ((match-end 2) (match-string 2 line)) + ((save-match-data + (or (file-name-absolute-p path) + (string-match "^\\.\\.?/" path))) + "file") + (t "internal"))) + (setq path (org-extract-attributes (org-link-unescape path))) + (setq attr (get-text-property 0 'org-attributes path)) + (setq desc1 (if (match-end 5) (match-string 5 line)) + desc2 (if (match-end 2) (concat type ":" path) path) + descp (and desc1 (not (equal desc1 desc2))) + desc (or desc1 desc2)) + ;; Make an image out of the description if that is so wanted + (when (and descp (org-file-image-p + desc org-export-html-inline-image-extensions)) + (save-match-data + (if (string-match "^file:" desc) + (setq desc (substring desc (match-end 0))))) + (setq desc (org-add-props + (concat "<img src=\"" desc "\" alt=\"" + (file-name-nondirectory desc) "\"/>") + '(org-protected t)))) + (cond + ((equal type "internal") + (let + ((frag-0 + (if (= (string-to-char path) ?#) + (substring path 1) + path))) + (setq rpl + (org-html-make-link + opt-plist + "" + "" + (org-solidify-link-text + (save-match-data (org-link-unescape frag-0)) + nil) + desc attr nil)))) + ((and (equal type "id") + (setq id-file (org-id-find-id-file path))) + ;; This is an id: link to another file (if it was the same file, + ;; it would have become an internal link...) + (save-match-data + (setq id-file (file-relative-name + id-file + (file-name-directory org-current-export-file))) + (setq rpl + (org-html-make-link opt-plist + "file" id-file + (concat (if (org-uuidgen-p path) "ID-") path) + desc + attr + nil)))) + ((member type '("http" "https")) + ;; standard URL, can inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + (org-html-should-inline-p path descp)))) + ((member type '("ftp" "mailto" "news")) + ;; standard URL, can't inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + nil))) + + ((string= type "coderef") + (let* + ((coderef-str (format "coderef-%s" path)) + (attr-1 + (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" + coderef-str coderef-str))) + (setq rpl + (org-html-make-link opt-plist + type "" coderef-str + (format + (org-export-get-coderef-format + path + (and descp desc)) + (cdr (assoc path org-export-code-refs))) + attr-1 + nil)))) + + ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) + ;; The link protocol has a function for format the link + (setq rpl + (save-match-data + (funcall fnc (org-link-unescape path) desc1 'html)))) + + ((string= type "file") + ;; FILE link + (save-match-data + (let* + ((components + (if + (string-match "::\\(.*\\)" path) + (list + (replace-match "" t nil path) + (match-string 1 path)) + (list path nil))) + + ;;The proper path, without a fragment + (path-1 + (first components)) + + ;;The raw fragment + (fragment-0 + (second components)) + + ;;Check the fragment. If it can't be used as + ;;target fragment we'll pass nil instead. + (fragment-1 + (if + (and fragment-0 + (not (string-match "^[0-9]*$" fragment-0)) + (not (string-match "^\\*" fragment-0)) + (not (string-match "^/.*/$" fragment-0))) + (org-solidify-link-text + (org-link-unescape fragment-0)) + nil)) + (desc-2 + ;;Description minus "file:" and ".org" + (if (string-match "^file:" desc) + (let + ((desc-1 (replace-match "" t t desc))) + (if (string-match "\\.org$" desc-1) + (replace-match "" t t desc-1) + desc-1)) + desc))) + + (setq rpl + (if + (and + (functionp link-validate) + (not (funcall link-validate path-1 current-dir))) + desc + (org-html-make-link opt-plist + "file" path-1 fragment-1 desc-2 attr + (org-html-should-inline-p path-1 descp))))))) + + (t + ;; just publish the path, as default + (setq rpl (concat "@<i><" type ":" + (save-match-data (org-link-unescape path)) + ">@</i>")))) + (setq line (replace-match rpl t t line) + start (+ start (length rpl)))) + line)) + ;;; org-export-as-html ;;;###autoload (defun org-export-as-html (arg &optional hidden ext-plist @@ -841,7 +1095,6 @@ PUB-DIR is set, use this as the publishing directory." (if (plist-get opt-plist :style-include-scripts) org-export-html-scripts))) (html-extension (plist-get opt-plist :html-extension)) - (link-validate (plist-get opt-plist :link-validation-function)) valid thetoc have-headings first-heading-pos (odd org-odd-levels-only) (region-p (org-region-active-p)) @@ -895,16 +1148,18 @@ PUB-DIR is set, use this as the publishing directory." (org-levels-open (make-vector org-level-max nil)) (date (plist-get opt-plist :date)) (author (plist-get opt-plist :author)) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not body-only) - (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED")) + (html-validation-link (or org-export-html-validation-link "")) + (title (org-html-expand + (or (and subtree-p (org-export-get-title-from-subtree)) + (plist-get opt-plist :title) + (and (not body-only) + (not + (plist-get opt-plist :skip-before-1st-heading)) + (org-export-grab-title-from-buffer)) + (and buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name))) + "UNTITLED"))) (link-up (and (plist-get opt-plist :link-up) (string-match "\\S-" (plist-get opt-plist :link-up)) (plist-get opt-plist :link-up))) @@ -918,14 +1173,11 @@ PUB-DIR is set, use this as the publishing directory." (inquote nil) (infixed nil) (inverse nil) - (in-local-list nil) - (local-list-type nil) - (local-list-indent nil) - (llt org-plain-list-ordered-item-terminator) (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) (keywords (plist-get opt-plist :keywords)) (description (plist-get opt-plist :description)) + (num (plist-get opt-plist :section-numbers)) (lang-words nil) (head-count 0) cnt (start 0) @@ -944,16 +1196,19 @@ PUB-DIR is set, use this as the publishing directory." (if region-p (region-beginning) (point-min)) (if region-p (region-end) (point-max)))) (org-export-have-math nil) + (org-export-footnotes-seen nil) + (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) (lines (org-split-string (org-export-preprocess-string region :emph-multiline t - :for-html t + :for-backend 'html :skip-before-1st-heading (plist-get opt-plist :skip-before-1st-heading) :drawers (plist-get opt-plist :drawers) :todo-keywords (plist-get opt-plist :todo-keywords) + :tasks (plist-get opt-plist :tasks) :tags (plist-get opt-plist :tags) :priority (plist-get opt-plist :priority) :footnotes (plist-get opt-plist :footnotes) @@ -977,13 +1232,13 @@ PUB-DIR is set, use this as the publishing directory." org-export-html-mathjax-options (or (plist-get opt-plist :mathjax) "")) "")) - table-open type + table-open table-buffer table-orig-buffer - ind item-type starter + ind rpl path attr desc descp desc1 desc2 link - snumber fnc item-tag item-number + snumber fnc footnotes footref-seen - id-file href + href ) (let ((inhibit-read-only t)) @@ -1049,7 +1304,6 @@ lang=\"%s\" xml:lang=\"%s\"> %s </head> <body> -<div id=\"content\"> %s " (format @@ -1074,12 +1328,36 @@ lang=\"%s\" xml:lang=\"%s\"> "\n") ""))) - (org-export-html-insert-plist-item opt-plist :preamble opt-plist) - - (when (plist-get opt-plist :auto-preamble) - (if title (insert (format org-export-html-title-format - (org-html-expand title)))))) - + ;; insert html preamble + (when (plist-get opt-plist :html-preamble) + (let ((html-pre (plist-get opt-plist :html-preamble))) + (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n") + (cond ((stringp html-pre) + (insert + (format-spec html-pre `((?t . ,title) (?a . ,author) + (?d . ,date) (?e . ,email))))) + ((functionp html-pre) + (funcall html-pre)) + (t + (insert + (format-spec + (or (cadr (assoc (nth 0 lang-words) + org-export-html-preamble-format)) + (cadr (assoc "en" org-export-html-preamble-format))) + `((?t . ,title) (?a . ,author) + (?d . ,date) (?e . ,email)))))) + (insert "\n</div>\n"))) + + ;; begin wrap around body + (insert (format "\n<div id=\"%s\">" + ;; FIXME org-export-html-content-div is obsolete since 7.7 + (or org-export-html-content-div + (nth 1 org-export-html-divs))) + ;; FIXME this should go in the preamble but is here so + ;; that org-infojs can still find it + "\n<h1 class=\"title\">" title "</h1>\n")) + + ;; insert body (if (and org-export-with-toc (not body-only)) (progn (push (format "<h%d>%s</h%d>\n" @@ -1090,91 +1368,97 @@ lang=\"%s\" xml:lang=\"%s\"> (push "<div id=\"text-table-of-contents\">\n" thetoc) (push "<ul>\n<li>" thetoc) (setq lines - (mapcar (lambda (line) - (if (and (string-match org-todo-line-regexp line) - (not (get-text-property 0 'org-protected line))) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (save-match-data - (org-html-expand - (org-export-cleanup-toc-line - (match-string 3 line)))) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) + (mapcar + #'(lambda (line) + (if (and (string-match org-todo-line-regexp line) + (not (get-text-property 0 'org-protected line))) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (save-match-data + (org-html-expand + (org-export-cleanup-toc-line + (match-string 3 line)))) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (setq snumber (org-section-number level)) - (if org-export-with-section-numbers - (setq txt (concat snumber " " txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (if (<= level umax-toc) - (progn - (if (> level org-last-level) - (progn - (setq cnt (- level org-last-level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "\n<ul>\n<li>" thetoc)) - (push "\n" thetoc))) - (if (< level org-last-level) - (progn - (setq cnt (- org-last-level level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "</li>\n</ul>" thetoc)) - (push "\n" thetoc))) - ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line (replace-match - (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") - t t line))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (setq href - (replace-regexp-in-string - "\\." "_" (format "sec-%s" snumber))) - (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href)) - (push - (format - (if todo - "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" - "</li>\n<li><a href=\"#%s\">%s</a>") - href txt) thetoc) - - (setq org-last-level level)) - ))) - line) - lines)) + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (if (string-match + (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) + (setq txt (replace-match + " <span class=\"tag\"> \\1</span>" t nil txt))) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + (setq snumber (org-section-number level)) + (if (and num (if (integerp num) + (>= num level) + num)) + (setq txt (concat snumber " " txt))) + (if (<= level (max umax umax-toc)) + (setq head-count (+ head-count 1))) + (if (<= level umax-toc) + (progn + (if (> level org-last-level) + (progn + (setq cnt (- level org-last-level)) + (while (>= (setq cnt (1- cnt)) 0) + (push "\n<ul>\n<li>" thetoc)) + (push "\n" thetoc))) + (if (< level org-last-level) + (progn + (setq cnt (- org-last-level level)) + (while (>= (setq cnt (1- cnt)) 0) + (push "</li>\n</ul>" thetoc)) + (push "\n" thetoc))) + ;; Check for targets + (while (string-match org-any-target-regexp line) + (setq line (replace-match + (concat "@<span class=\"target\">" + (match-string 1 line) "@</span> ") + t t line))) + (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) + (setq txt (replace-match "" t t txt))) + (setq href + (replace-regexp-in-string + "\\." "-" (format "sec-%s" snumber))) + (setq href (org-solidify-link-text + (or (cdr (assoc href + org-export-preferred-target-alist)) href))) + (push + (format + (if todo + "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" + "</li>\n<li><a href=\"#%s\">%s</a>") + href txt) thetoc) + + (setq org-last-level level))))) + line) + lines)) (while (> org-last-level (1- org-min-level)) (setq org-last-level (1- org-last-level)) (push "</li>\n</ul>\n" thetoc)) (push "</div>\n" thetoc) (setq thetoc (if have-headings (nreverse thetoc) nil)))) - + (setq head-count 0) (org-init-section-numbers) - + (org-open-par) - + (while (setq line (pop lines) origline line) (catch 'nextline - + ;; end of quote section? - (when (and inquote (string-match "^\\*+ " line)) + (when (and inquote (string-match org-outline-regexp-bol line)) (insert "</pre>\n") (org-open-par) (setq inquote nil)) @@ -1200,17 +1484,6 @@ lang=\"%s\" xml:lang=\"%s\"> (org-open-par)) (throw 'nextline nil)) - ;; Explicit list closure - (when (equal "ORG-LIST-END" line) - (while local-list-indent - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) - (pop local-list-indent)) - (setq in-local-list nil) - (org-open-par) - (throw 'nextline nil)) - ;; Protected HTML (when (and (get-text-property 0 'org-protected line) ;; Make sure it is the entire line that is protected @@ -1311,165 +1584,11 @@ lang=\"%s\" xml:lang=\"%s\"> ;; handle @<..> HTML tags (replace "@>..<" by "<..>") ;; Also handle sub_superscripts and checkboxes (or (string-match org-table-hline-regexp line) + (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line) (setq line (org-html-expand line))) ;; Format the links - (setq start 0) - (while (string-match org-bracket-link-analytic-regexp++ line start) - (setq start (match-beginning 0)) - (setq path (save-match-data (org-link-unescape - (match-string 3 line)))) - (setq type (cond - ((match-end 2) (match-string 2 line)) - ((save-match-data - (or (file-name-absolute-p path) - (string-match "^\\.\\.?/" path))) - "file") - (t "internal"))) - (setq path (org-extract-attributes (org-link-unescape path))) - (setq attr (get-text-property 0 'org-attributes path)) - (setq desc1 (if (match-end 5) (match-string 5 line)) - desc2 (if (match-end 2) (concat type ":" path) path) - descp (and desc1 (not (equal desc1 desc2))) - desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted - (when (and descp (org-file-image-p - desc org-export-html-inline-image-extensions)) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0))))) - (setq desc (org-add-props - (concat "<img src=\"" desc "\"/>") - '(org-protected t)))) - (cond - ((equal type "internal") - (let - ((frag-0 - (if (= (string-to-char path) ?#) - (substring path 1) - path))) - (setq rpl - (org-html-make-link - opt-plist - "" - "" - (org-solidify-link-text - (save-match-data (org-link-unescape frag-0)) - nil) - desc attr nil)))) - ((and (equal type "id") - (setq id-file (org-id-find-id-file path))) - ;; This is an id: link to another file (if it was the same file, - ;; it would have become an internal link...) - (save-match-data - (setq id-file (file-relative-name - id-file - (file-name-directory org-current-export-file))) - (setq rpl - (org-html-make-link opt-plist - "file" id-file - (concat (if (org-uuidgen-p path) "ID-") path) - desc - attr - nil)))) - ((member type '("http" "https")) - ;; standard URL, can inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - (org-html-should-inline-p path descp)))) - ((member type '("ftp" "mailto" "news")) - ;; standard URL, can't inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - nil))) - - ((string= type "coderef") - (let* - ((coderef-str (format "coderef-%s" path)) - (attr-1 - (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" - coderef-str coderef-str))) - (setq rpl - (org-html-make-link opt-plist - type "" coderef-str - (format - (org-export-get-coderef-format - path - (and descp desc)) - (cdr (assoc path org-export-code-refs))) - attr-1 - nil)))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for format the link - (setq rpl - (save-match-data - (funcall fnc (org-link-unescape path) desc1 'html)))) - - ((string= type "file") - ;; FILE link - (save-match-data - (let* - ((components - (if - (string-match "::\\(.*\\)" path) - (list - (replace-match "" t nil path) - (match-string 1 path)) - (list path nil))) - - ;;The proper path, without a fragment - (path-1 - (first components)) - - ;;The raw fragment - (fragment-0 - (second components)) - - ;;Check the fragment. If it can't be used as - ;;target fragment we'll pass nil instead. - (fragment-1 - (if - (and fragment-0 - (not (string-match "^[0-9]*$" fragment-0)) - (not (string-match "^\\*" fragment-0)) - (not (string-match "^/.*/$" fragment-0))) - (org-solidify-link-text - (org-link-unescape fragment-0)) - nil)) - (desc-2 - ;;Description minus "file:" and ".org" - (if (string-match "^file:" desc) - (let - ((desc-1 (replace-match "" t t desc))) - (if (string-match "\\.org$" desc-1) - (replace-match "" t t desc-1) - desc-1)) - desc))) - - (setq rpl - (if - (and - (functionp link-validate) - (not (funcall link-validate path-1 current-dir))) - desc - (org-html-make-link opt-plist - "file" path-1 fragment-1 desc-2 attr - (org-html-should-inline-p path-1 descp))))))) - - (t - ;; just publish the path, as default - (setq rpl (concat "<i><" type ":" - (save-match-data (org-link-unescape path)) - "></i>")))) - (setq line (replace-match rpl t t line) - start (+ start (length rpl)))) + (setq line (org-html-handle-links line opt-plist)) ;; TODO items (if (and (string-match org-todo-line-regexp line) @@ -1490,7 +1609,10 @@ lang=\"%s\" xml:lang=\"%s\"> (when org-export-with-footnotes (setq start 0) (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start) - (if (get-text-property (match-beginning 2) 'org-protected line) + ;; Discard protected matches not clearly identified as + ;; footnote markers. + (if (or (get-text-property (match-beginning 2) 'org-protected line) + (not (get-text-property (match-beginning 2) 'org-footnote line))) (setq start (match-end 2)) (let ((n (match-string 2 line)) extra a) (if (setq a (assoc n footref-seen)) @@ -1501,11 +1623,19 @@ lang=\"%s\" xml:lang=\"%s\"> (push (cons n 1) footref-seen)) (setq line (replace-match - (format - (concat "%s" - (format org-export-html-footnote-format - "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>")) - (or (match-string 1 line) "") n extra n n) + (concat + (format + (concat "%s" + (format org-export-html-footnote-format + (concat "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>"))) + (or (match-string 1 line) "") n extra n n) + ;; If another footnote is following the + ;; current one, add a separator. + (if (save-match-data + (string-match "\\`\\[[0-9]+\\]" + (substring line (match-end 0)))) + org-export-html-footnote-separator + "")) t t line)))))) (cond @@ -1521,7 +1651,7 @@ lang=\"%s\" xml:lang=\"%s\"> (setq first-heading-pos (or first-heading-pos (point))) (org-html-level-start level txt umax (and org-export-with-toc (<= level umax)) - head-count) + head-count opt-plist) ;; QUOTES (when (string-match quote-re line) @@ -1546,72 +1676,17 @@ lang=\"%s\" xml:lang=\"%s\"> table-orig-buffer (nreverse table-orig-buffer)) (org-close-par-maybe) (insert (org-format-table-html table-buffer table-orig-buffer)))) + + ;; Normal lines + (t - ;; Normal lines - (when (string-match - (cond - ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) - line) - (setq ind (or (get-text-property 0 'original-indentation line) - (org-get-string-indentation line)) - item-type (if (match-beginning 4) "o" "u") - starter (if (match-beginning 2) - (substring (match-string 2 line) 0 -1)) - line (substring line (match-beginning 5)) - item-number nil - item-tag nil) - (if (string-match "\\[@\\(?:start:\\)?\\([0-9]+\\)\\][ \t]?" line) - (setq item-number (match-string 1 line) - line (replace-match "" t t line))) - (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) - (setq item-type "d" - item-tag (match-string 1 line) - line (substring line (match-end 0)))) - (cond - ((and starter - (or (not in-local-list) - (> ind (car local-list-indent)))) - ;; Start new (level of) list - (org-close-par-maybe) - (insert (cond - ((equal item-type "u") "<ul>\n<li>\n") - ((and (equal item-type "o") item-number) - (format "<ol>\n<li value=\"%s\">\n" item-number)) - ((equal item-type "o") "<ol>\n<li>\n") - ((equal item-type "d") - (format "<dl>\n<dt>%s</dt><dd>\n" item-tag)))) - (push item-type local-list-type) - (push ind local-list-indent) - (setq in-local-list t)) - ;; Continue list - (starter - ;; terminate any previous sublist but first ensure - ;; list is not ill-formed. - (let ((min-ind (apply 'min local-list-indent))) - (when (< ind min-ind) (setq ind min-ind))) - (while (< ind (car local-list-indent)) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) - ;; insert new item - (org-close-li (car local-list-type)) - (insert (cond - ((equal (car local-list-type) "d") - (format "<dt>%s</dt><dd>\n" (or item-tag "???"))) - ((and (equal item-type "o") item-number) - (format "<li value=\"%s\">\n" item-number)) - (t "<li>\n"))))) - (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) - (setq line - (replace-match - (if (equal (match-string 1 line) "X") - "<b>[X]</b>" - "<b>[<span style=\"visibility:hidden;\">X</span>]</b>") - t t line)))) + ;; This line either is list item or end a list. + (when (get-text-property 0 'list-item line) + (setq line (org-html-export-list-line + line + (get-text-property 0 'list-item line) + (get-text-property 0 'list-struct line) + (get-text-property 0 'list-prevs line)))) ;; Horizontal line (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) @@ -1669,15 +1744,18 @@ lang=\"%s\" xml:lang=\"%s\"> (org-html-level-start 1 nil umax (and org-export-with-toc (<= level umax)) - head-count) + head-count opt-plist) ;; the </div> to close the last text-... div. (when (and (> umax 0) first-heading-pos) (insert "</div>\n")) (save-excursion (goto-char (point-min)) - (while (re-search-forward "<p class=\"footnote\">[^\000]*?\\(</p>\\|\\'\\)" nil t) - (push (match-string 0) footnotes) - (replace-match "" t t))) + (while (re-search-forward + "\\(\\(<p class=\"footnote\">\\)[^\000]*?\\)\\(\\(\\2\\)\\|\\'\\)" + nil t) + (push (match-string 1) footnotes) + (replace-match "\\4" t nil) + (goto-char (match-beginning 0)))) (when footnotes (insert (format org-export-html-footnotes-section (nth 4 lang-words) @@ -1686,36 +1764,60 @@ lang=\"%s\" xml:lang=\"%s\"> (let ((bib (org-export-html-get-bibliography))) (when bib (insert "\n" bib "\n"))) + (unless body-only - (when (plist-get opt-plist :auto-postamble) - (insert "<div id=\"postamble\">\n") - (when (and org-export-author-info author) - (insert "<p class=\"author\"> " - (nth 1 lang-words) ": " author "\n") - (when (and org-export-email-info email (string-match "\\S-" email)) - (if (listp (split-string email ",+ *")) - (mapc (lambda(e) - (insert "<a href=\"mailto:" e "\"><" - e "></a>\n")) - (split-string email ",+ *")) - (insert "<a href=\"mailto:" email "\"><" - email "></a>\n"))) - (insert "</p>\n")) - (when (and date org-export-time-stamp-file) - (insert "<p class=\"date\"> " - (nth 2 lang-words) ": " - date "</p>\n")) - (when org-export-creator-info - (insert (format "<p class=\"creator\">HTML generated by org-mode %s in emacs %s</p>\n" - org-version emacs-major-version))) - (when org-export-html-validation-link - (insert org-export-html-validation-link "\n")) - (insert "</div>")) - - (if org-export-html-with-timestamp - (insert org-export-html-html-helper-timestamp)) - (org-export-html-insert-plist-item opt-plist :postamble opt-plist) - (insert "\n</div>\n</body>\n</html>\n")) + ;; end wrap around body + (insert "</div>\n") + + ;; export html postamble + (let ((html-post (plist-get opt-plist :html-postamble)) + (email + (mapconcat (lambda(e) + (format "<a href=\"mailto:%s\">%s</a>" e e)) + (split-string email ",+ *") + ", ")) + (creator-info + (concat "Org version " org-version " with Emacs version " + (number-to-string emacs-major-version)))) + + (when (plist-get opt-plist :html-postamble) + (insert "\n<div id=\"" (nth 2 org-export-html-divs) "\">\n") + (cond ((stringp html-post) + (insert (format-spec html-post + `((?a . ,author) (?e . ,email) + (?d . ,date) (?c . ,creator-info) + (?v . ,html-validation-link))))) + ((functionp html-post) + (funcall html-post)) + ((eq html-post 'auto) + ;; fall back on default postamble + (when (plist-get opt-plist :time-stamp-file) + (insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n")) + (when (and (plist-get opt-plist :author-info) author) + (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n")) + (when (and (plist-get opt-plist :email-info) email) + (insert "<p class=\"email\">" email "</p>\n")) + (when (plist-get opt-plist :creator-info) + (insert "<p class=\"creator\">" + (concat "Org version " org-version " with Emacs version " + (number-to-string emacs-major-version) "</p>\n"))) + (insert html-validation-link "\n")) + (t + (insert (format-spec + (or (cadr (assoc (nth 0 lang-words) + org-export-html-postamble-format)) + (cadr (assoc "en" org-export-html-postamble-format))) + `((?a . ,author) (?e . ,email) + (?d . ,date) (?c . ,creator-info) + (?v . ,html-validation-link)))))) + (insert "\n</div>")))) + + ;; FIXME `org-export-html-with-timestamp' has been declared + ;; obsolete since Org 7.7 -- don't forget to remove this. + (if org-export-html-with-timestamp + (insert org-export-html-html-helper-timestamp)) + + (unless body-only (insert "\n</body>\n</html>\n")) (unless (plist-get opt-plist :buffer-will-be-killed) (normal-mode) @@ -1737,16 +1839,16 @@ lang=\"%s\" xml:lang=\"%s\"> (goto-char (match-end 0)) (insert "\n"))) (insert "<div id=\"table-of-contents\">\n") - (mapc 'insert thetoc) - (insert "</div>\n")) - ;; remove empty paragraphs and lists + (let ((beg (point))) + (mapc 'insert thetoc) + (insert "</div>\n") + (while (re-search-backward "<li>[ \r\n\t]*</li>\n?" beg t) + (replace-match "")))) + ;; remove empty paragraphs (goto-char (point-min)) (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t) (replace-match "")) (goto-char (point-min)) - (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) - (replace-match "")) - (goto-char (point-min)) ;; Convert whitespace place holders (goto-char (point-min)) (let (beg end n) @@ -1773,13 +1875,6 @@ lang=\"%s\" xml:lang=\"%s\"> (kill-buffer (current-buffer))) (current-buffer))))) -(defun org-export-html-insert-plist-item (plist key &rest args) - (let ((item (plist-get plist key))) - (cond ((functionp item) - (apply item args)) - (item - (insert item))))) - (defun org-export-html-format-href (s) "Make sure the S is valid as a href reference in an XHTML document." (save-match-data @@ -1811,7 +1906,7 @@ lang=\"%s\" xml:lang=\"%s\"> (format "%s<div %sclass=\"figure\"> <p>" (if org-par-open "</p>\n" "") - (if label (format "id=\"%s\" " label) ""))) + (if label (format "id=\"%s\" " (org-solidify-link-text label)) ""))) (format "<img src=\"%s\"%s />" src (if (string-match "\\<alt=" (or attr "")) @@ -1849,24 +1944,13 @@ NO-CSS is passed to the exporter." (if (string-match "^[ \t]*|" (car lines)) ;; A normal org table (org-format-org-table-html lines nil no-css) - ;; Table made by table.el - test for spanning - (let* ((hlines (delq nil (mapcar - (lambda (x) - (if (string-match "^[ \t]*\\+-" x) x - nil)) - lines))) - (first (car hlines)) - (ll (and (string-match "\\S-+" first) - (match-string 0 first))) - (re (concat "^[ \t]*" (regexp-quote ll))) - (spanning (delq nil (mapcar (lambda (x) (not (string-match re x))) - hlines)))) - (if (and (not spanning) - (not org-export-prefer-native-exporter-for-tables)) - ;; We can use my own converter with HTML conversions - (org-format-table-table-html lines) - ;; Need to use the code generator in table.el, with the original text. - (org-format-table-table-html-using-table-generate-source olines))))) + ;; Table made by table.el + (or (org-format-table-table-html-using-table-generate-source + olines (not org-export-prefer-native-exporter-for-tables)) + ;; We are here only when table.el table has NO col or row + ;; spanning and the user prefers using org's own converter for + ;; exporting of such simple table.el tables. + (org-format-table-table-html lines)))) (defvar org-table-number-fraction) ; defined in org-table.el (defun org-format-org-table-html (lines &optional splice no-css) @@ -1996,8 +2080,8 @@ for formatting. This is required for the DocBook exporter." ;; DocBook document, we want to always include the caption to make ;; DocBook XML file valid. (push (format "<caption>%s</caption>" (or caption "")) html) - (when label (push (format "<a name=\"%s\" id=\"%s\"></a>" label label) - html)) + (when label + (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label))))) (push html-table-tag html)) (setq html (mapcar (lambda (x) @@ -2077,10 +2161,20 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." (setq html (concat html "</table>\n")) html)) -(defun org-format-table-table-html-using-table-generate-source (lines) +(defun org-format-table-table-html-using-table-generate-source (lines + &optional + spanned-only) "Format a table into html, using `table-generate-source' from table.el. -This has the advantage that cell- or row-spanning is allowed. -But it has the disadvantage, that Org-mode's HTML conversions cannot be used." +Use SPANNED-ONLY to suppress exporting of simple table.el tables. + +When SPANNED-ONLY is nil, all table.el tables are exported. When +SPANNED-ONLY is non-nil, only tables with either row or column +spans are exported. + +This routine returns the generated source or nil as appropriate. + +Refer docstring of `org-export-prefer-native-exporter-for-tables' +for further information." (require 'table) (with-current-buffer (get-buffer-create " org-tmp1 ") (erase-buffer) @@ -2089,10 +2183,14 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used." (if (not (re-search-forward "|[^+]" nil t)) (error "Error processing table")) (table-recognize-table) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (table-generate-source 'html " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max)))) + (when (or (not spanned-only) + (let* ((dim (table-query-dimension)) + (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim))) + (not (= (* c r) cells)))) + (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) + (table-generate-source 'html " org-tmp2 ") + (set-buffer " org-tmp2 ") + (buffer-substring (point-min) (point-max))))) (defun org-export-splice-style (style extra) "Splice EXTRA into STYLE, just before \"</style>\"." @@ -2168,7 +2266,7 @@ that uses these same face definitions." (when (and (symbolp f) (or (not i) (not (listp i)))) (insert (org-add-props (copy-sequence "1") nil 'face f)))) (htmlize-region (point-min) (point-max)))) - (switch-to-buffer "*html*") + (org-pop-to-buffer-same-window "*html*") (goto-char (point-min)) (if (re-search-forward "<style" nil t) (delete-region (point-min) (match-beginning 0))) @@ -2179,19 +2277,15 @@ that uses these same face definitions." (goto-char (point-min))) (defun org-html-protect (s) - "convert & to &, < to < and > to >" - (let ((start 0)) - (while (string-match "&" s start) - (setq s (replace-match "&" t t s) - start (1+ (match-beginning 0)))) - (while (string-match "<" s) - (setq s (replace-match "<" t t s))) - (while (string-match ">" s) - (setq s (replace-match ">" t t s))) -; (while (string-match "\"" s) -; (setq s (replace-match """ t t s))) - ) - s) + "Convert characters to HTML equivalent. +Possible conversions are set in `org-export-html-protect-char-alist'." + (let ((cl org-export-html-protect-char-alist) c) + (while (setq c (pop cl)) + (let ((start 0)) + (while (string-match (car c) s start) + (setq s (replace-match (cdr c) t t s) + start (1+ (match-beginning 0)))))) + s)) (defun org-html-expand (string) "Prepare STRING for HTML export. Apply all active conversions. @@ -2199,16 +2293,14 @@ If there are links in the string, don't modify these." (let* ((re (concat org-bracket-link-regexp "\\|" (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) m s l res) - (if (string-match "^[ \t]*\\+-[-+]*\\+[ \t]*$" string) - string - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-html-do-expand s) res) - (push l res)) - (push (org-html-do-expand string) res) - (apply 'concat (nreverse res))))) + (while (setq m (string-match re string)) + (setq s (substring string 0 m) + l (match-string 0 string) + string (substring string (match-end 0))) + (push (org-html-do-expand s) res) + (push l res)) + (push (org-html-do-expand string) res) + (apply 'concat (nreverse res)))) (defun org-html-do-expand (s) "Apply all active conversions to translate special ASCII to HTML." @@ -2304,12 +2396,8 @@ If there are links in the string, don't modify these." (org-close-par-maybe) (insert (if (equal type "d") "</dd>\n" "</li>\n"))) -(defvar in-local-list) -(defvar local-list-indent) -(defvar local-list-type) - (defvar body-only) ; dynamically scoped into this. -(defun org-html-level-start (level title umax with-toc head-count) +(defun org-html-level-start (level title umax with-toc head-count &optional opt-plist) "Insert a new level in HTML export. When TITLE is nil, just close all open levels." (org-close-par-maybe) @@ -2320,11 +2408,13 @@ When TITLE is nil, just close all open levels." (preferred (and target (cdr (assoc target org-export-preferred-target-alist)))) (l org-level-max) + (num (plist-get opt-plist :section-numbers)) snumber snu href suffix) (setq extra-targets (remove (or preferred target) extra-targets)) (setq extra-targets (mapconcat (lambda (x) - (if (org-uuidgen-p x) (setq x (concat "ID-" x))) + (setq x (org-solidify-link-text + (if (org-uuidgen-p x) (concat "ID-" x) x))) (format "<a name=\"%s\" id=\"%s\"></a>" x x)) extra-targets @@ -2360,28 +2450,38 @@ When TITLE is nil, just close all open levels." (progn (org-close-li) (if target - (insert (format "<li id=\"%s\">" (or preferred target)) + (insert (format "<li id=\"%s\">" (org-solidify-link-text (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\">" (or preferred target)) + (insert (format "<ul>\n<li id=\"%s\">" (org-solidify-link-text (or preferred target))) extra-targets title "<br/>\n") (insert "<ul>\n<li>" title "<br/>\n")))) (aset org-levels-open (1- level) t) (setq snumber (org-section-number level) - snu (replace-regexp-in-string "\\." "_" snumber)) + snu (replace-regexp-in-string "\\." "-" snumber)) (setq level (+ level org-export-html-toplevel-hlevel -1)) - (if (and org-export-with-section-numbers (not body-only)) + (if (and num (not body-only)) (setq title (concat (format "<span class=\"section-number-%d\">%s</span>" - level snumber) + level + (if (and num + (if (integerp num) + ;; fix up num to take into + ;; account the top-level + ;; heading value + (>= (+ num org-export-html-toplevel-hlevel -1) + level) + num)) + snumber + "")) " " title))) (unless (= head-count 1) (insert "\n</div>\n")) (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist))) - (setq suffix (or href snu)) - (setq href (or href (concat "sec-" snu))) + (setq suffix (org-solidify-link-text (or href snu))) + (setq href (org-solidify-link-text (or href (concat "sec-" snu)))) (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d%s\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n" suffix level (if extra-class (concat " " extra-class) "") level href @@ -2412,6 +2512,100 @@ Replaces invalid characters with \"_\" and then prepends a prefix." (org-close-li) (insert "</ul>\n"))) +(defun org-html-export-list-line (line pos struct prevs) + "Insert list syntax in export buffer. Return LINE, maybe modified. + +POS is the item position or line position the line had before +modifications to buffer. STRUCT is the list structure. PREVS is +the alist of previous items." + (let* ((get-type + (function + ;; Translate type of list containing POS to "d", "o" or + ;; "u". + (lambda (pos struct prevs) + (let ((type (org-list-get-list-type pos struct prevs))) + (cond + ((eq 'ordered type) "o") + ((eq 'descriptive type) "d") + (t "u")))))) + (get-closings + (function + ;; Return list of all items and sublists ending at POS, in + ;; reverse order. + (lambda (pos) + (let (out) + (catch 'exit + (mapc (lambda (e) + (let ((end (nth 6 e)) + (item (car e))) + (cond + ((= end pos) (push item out)) + ((>= item pos) (throw 'exit nil))))) + struct)) + out))))) + ;; First close any previous item, or list, ending at POS. + (mapc (lambda (e) + (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) + (first-item (org-list-get-list-begin e struct prevs)) + (type (funcall get-type first-item struct prevs))) + (org-close-par-maybe) + ;; Ending for every item + (org-close-li type) + ;; We're ending last item of the list: end list. + (when lastp + (insert (format "</%sl>\n" type)) + (org-open-par)))) + (funcall get-closings pos)) + (cond + ;; At an item: insert appropriate tags in export buffer. + ((assq pos struct) + (string-match + (concat "[ \t]*\\(\\S-+[ \t]*\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" + "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" + "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" + "\\(.*\\)") line) + (let* ((checkbox (match-string 3 line)) + (desc-tag (or (match-string 4 line) "???")) + (body (or (match-string 5 line) "")) + (list-beg (org-list-get-list-begin pos struct prevs)) + (firstp (= list-beg pos)) + ;; Always refer to first item to determine list type, in + ;; case list is ill-formed. + (type (funcall get-type list-beg struct prevs)) + (counter (let ((count-tmp (org-list-get-counter pos struct))) + (cond + ((not count-tmp) nil) + ((string-match "[A-Za-z]" count-tmp) + (- (string-to-char (upcase count-tmp)) 64)) + ((string-match "[0-9]+" count-tmp) + count-tmp))))) + (when firstp + (org-close-par-maybe) + (insert (format "<%sl>\n" type))) + (insert (cond + ((equal type "d") + (format "<dt>%s</dt><dd>" desc-tag)) + ((and (equal type "o") counter) + (format "<li value=\"%s\">" counter)) + (t "<li>"))) + ;; If line had a checkbox, some additional modification is required. + (when checkbox + (setq body + (concat + (cond + ((string-match "X" checkbox) "<code>[X]</code> ") + ((string-match " " checkbox) "<code>[ ]</code> ") + (t "<code>[-]</code> ")) + body))) + ;; Return modified line + body)) + ;; At a list ender: go to next line (side-effects only). + ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil)) + ;; Not at an item: return line unchanged (side-effects only). + (t line)))) + (provide 'org-html) +;; arch-tag: 8109d84d-eb8f-460b-b1a8-f45f3a6c7ea1 ;;; org-html.el ends here diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el index e0ea20a4bb8..bc0efce6a81 100644 --- a/lisp/org/org-icalendar.el +++ b/lisp/org/org-icalendar.el @@ -1,11 +1,12 @@ ;;; org-icalendar.el --- iCalendar export for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -72,6 +73,11 @@ for timed events. If non-zero, alarms are created. :group 'org-export-icalendar :type 'boolean) +(defcustom org-icalendar-honor-noexport-tag nil + "Non-nil means don't export entries with a tag in `org-export-exclude-tags'." + :group 'org-export-icalendar + :type 'boolean) + (defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) "Contexts where iCalendar export should use a deadline time stamp. This is a list with several symbols in it. Valid symbol are: @@ -193,12 +199,31 @@ When nil of the empty string, use the abbreviation retrieved from Emacs." (const :tag "Unspecified" nil) (string :tag "Time zone"))) -(defcustom org-icalendar-use-UTC-date-time () - "Non-nil force the use of the universal time for iCalendar DATE-TIME. -The iCalendar DATE-TIME can be expressed with local time or universal Time, -universal time could be more compatible with some external tools." +;; Backward compatibility with previous variable +(defvar org-icalendar-use-UTC-date-time nil) +(defcustom org-icalendar-date-time-format + (if org-icalendar-use-UTC-date-time + ":%Y%m%dT%H%M%SZ" + ":%Y%m%dT%H%M%S") + "Format-string for exporting icalendar DATE-TIME. +See `format-time-string' for a full documentation. The only +difference is that `org-icalendar-timezone' is used for %Z. + +Interesting value are: + - \":%Y%m%dT%H%M%S\" for local time + - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone + - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time" + :group 'org-export-icalendar - :type 'boolean) + :type '(choice + (const :tag "Local time" ":%Y%m%dT%H%M%S") + (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S") + (const :tag "Universal time" ":%Y%m%dT%H%M%SZ") + (string :tag "Explicit format"))) + +(defun org-icalendar-use-UTC-date-timep () + (char-equal (elt org-icalendar-date-time-format + (1- (length org-icalendar-date-time-format))) ?Z)) ;;; iCalendar export @@ -298,7 +323,7 @@ When COMBINE is non nil, add the category to each line." (format-time-string (cdr org-time-stamp-formats) (current-time)) "DTSTART")) hd ts ts2 state status (inc t) pos b sexp rrule - scheduledp deadlinep todo prefix due start + scheduledp deadlinep todo prefix due start tags tmp pri categories location summary desc uid alarm (sexp-buffer (get-buffer-create "*ical-tmp*"))) (org-refresh-category-properties) @@ -314,6 +339,7 @@ When COMBINE is non nil, add the category to each line." (throw :skip nil))) (setq pos (match-beginning 0) ts (match-string 0) + tags (org-get-tags-at) inc t hd (condition-case nil (org-icalendar-cleanup-string @@ -354,6 +380,11 @@ When COMBINE is non nil, add the category to each line." (when (and (not org-icalendar-use-plain-timestamp) (not deadlinep) (not scheduledp)) (throw :skip t)) + ;; don't export entries with a :noexport: tag + (when (and org-icalendar-honor-noexport-tag + (delq nil (mapcar (lambda(x) + (member x org-export-exclude-tags)) tags))) + (throw :skip t)) (when (and deadlinep (if todo @@ -386,7 +417,7 @@ When COMBINE is non nil, add the category to each line." ;; (c) only a DISPLAY action is defined. ;; [ESF] (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault)))) - (if (and (> org-icalendar-alarm-time 0) + (if (and (> org-icalendar-alarm-time 0) (car t1) (nth 1 t1) (nth 2 t1)) (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0D0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time)) (setq alarm "")) @@ -401,7 +432,10 @@ When COMBINE is non nil, add the category to each line." (if scheduledp (setq summary (concat "S: " summary))) (if (string-match "\\`<%%" ts) (with-current-buffer sexp-buffer - (insert (substring ts 1 -1) " " summary "\n")) + (let ((entry (substring ts 1 -1))) + (put-text-property 0 1 'uid + (concat " " prefix uid) entry) + (insert entry " " summary "\n"))) (princ (format "BEGIN:VEVENT UID: %s %s @@ -640,14 +674,16 @@ a time), or the day by one (if it does not contain a time)." (setq h (+ 2 h))) (setq d (1+ d)))) (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time (if org-icalendar-use-UTC-date-time - ":%Y%m%dT%H%M%SZ" - ":%Y%m%dT%H%M%S") + (setq fmt (if have-time + (replace-regexp-in-string "%Z" + org-icalendar-timezone + org-icalendar-date-time-format) ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time - (and org-icalendar-use-UTC-date-time + (concat keyword (format-time-string fmt time + (and (org-icalendar-use-UTC-date-timep) have-time)))))) (provide 'org-icalendar) +;; arch-tag: 2dee2b6e-9211-4aee-8a47-a3c7e5bc30cf ;;; org-icalendar.el ends here diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index b979097dee3..d724dff3060 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -1,11 +1,11 @@ ;;; org-id.el --- Global identifiers for Org-mode entries ;; -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -74,6 +74,8 @@ (require 'org) (declare-function message-make-fqdn "message" ()) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) ;;; Customization @@ -151,9 +153,7 @@ This variable is only relevant when `org-id-track-globally' is set." :type 'file) (defvar org-id-locations nil - "List of files with IDs in those files. -Depending on `org-id-use-hash' this can also be a hash table mapping IDs -to files.") + "List of files with IDs in those files.") (defvar org-id-files nil "List of files that contain IDs.") @@ -231,7 +231,7 @@ It returns the ID of the entry. If necessary, the ID is created." (org-refile-use-outline-path (if (caar org-refile-targets) 'file t)) (org-refile-target-verify-function nil) - (spos (org-refile-get-location "Entry: ")) + (spos (org-refile-get-location "Entry")) (pom (and spos (move-marker (make-marker) (nth 3 spos) (get-file-buffer (nth 1 spos)))))) (prog1 (org-id-get pom 'create) @@ -255,7 +255,7 @@ Move the cursor to that entry in that buffer." (let ((m (org-id-find id 'marker))) (unless m (error "Cannot find entry with ID \"%s\"" id)) - (switch-to-buffer (marker-buffer m)) + (org-pop-to-buffer-same-window (marker-buffer m)) (goto-char m) (move-marker m nil) (org-show-context))) @@ -643,5 +643,6 @@ optional argument MARKERP, return the position as a new marker." ;;; org-id.el ends here +;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712 diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 50dd6ac027a..68821a4f772 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -1,10 +1,10 @@ ;;; org-indent.el --- Dynamic indentation for Org-mode -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -212,12 +212,12 @@ useful to make it ever so slightly different." (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))) (defun org-indent-remove-properties-from-string (string) - "Remove indentations between BEG and END." + "Remove indentation properties from STRING." (remove-text-properties 0 (length string) '(line-prefix nil wrap-prefix nil) string) string) -(defvar org-indent-outline-re (concat "^" org-outline-regexp) +(defvar org-indent-outline-re org-outline-regexp-bol "Outline heading regexp.") (defun org-indent-add-properties (beg end) @@ -273,7 +273,7 @@ Point is assumed to be at the beginning of a headline." (when org-indent-mode (let (beg end) (save-excursion - (when (ignore-errors (let ((outline-regexp (format "\\*\\{1,%s\\}[ \t]+" + (when (ignore-errors (let ((org-outline-regexp (format "\\*\\{1,%s\\}[ \t]+" (if (featurep 'org-inlinetask) (1- org-inlinetask-min-level) "")))) @@ -290,7 +290,7 @@ 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 (let ((outline-regexp (format "\\*\\{1,%s\\}[ \t]+" + (and (ignore-errors (let ((org-outline-regexp (format "\\*\\{1,%s\\}[ \t]+" (if (featurep 'org-inlinetask) (1- org-inlinetask-min-level) "")))) @@ -322,4 +322,5 @@ Point is assumed to be at the beginning of a headline." (provide 'org-indent) +;; arch-tag: b76736bc-9f4a-43cd-977c-ecfd6689846a ;;; org-indent.el ends here diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index edbf4268954..d1bfc53e5e3 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -1,11 +1,12 @@ ;;; org-info.el --- Support for links to Info nodes from within Org-Mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -51,9 +52,9 @@ (let (link desc) (setq link (org-make-link "info:" (file-name-nondirectory Info-current-file) - ":" Info-current-node)) + "#" Info-current-node)) (setq desc (concat (file-name-nondirectory Info-current-file) - ":" Info-current-node)) + "#" Info-current-node)) (org-store-link-props :type "info" :file Info-current-file :node Info-current-node :link link :desc desc) @@ -66,7 +67,7 @@ (defun org-info-follow-link (name) "Follow an Info file and node link specified by NAME." - (if (or (string-match "\\(.*\\)::?\\(.*\\)" name) + (if (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" name) (string-match "\\(.*\\)" name)) (progn (require 'info) @@ -77,5 +78,6 @@ (provide 'org-info) +;; arch-tag: 1e289f54-7176-487f-b575-dd4854bab15e ;;; org-info.el ends here diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 53e3f782b98..7a52d6b6b40 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -1,11 +1,11 @@ ;;; org-inlinetask.el --- Tasks independent of outline hierarchy -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -42,7 +42,9 @@ ;; ;; Export commands do not treat these nodes as part of the sectioning ;; structure, but as a special inline text that is either removed, or -;; formatted in some special way. +;; formatted in some special way. This in handled by +;; `org-inlinetask-export' and `org-inlinetask-export-templates' +;; variables. ;; ;; Special fontification of inline tasks, so that they can be immediately ;; recognized. From the stars of the headline, only the first and the @@ -52,14 +54,18 @@ ;; An inline task is identified solely by a minimum outline level, given ;; by the variable `org-inlinetask-min-level', default 15. ;; -;; Inline tasks are normally assumed to contain at most a time planning -;; line (DEADLINE etc) after it, and then any number of drawers, for -;; example LOGBOOK of PROPERTIES. No empty lines are allowed. -;; If you need to have normal text as part of an inline task, you -;; can do so by adding an "END" headline with the same number of stars, -;; for example +;; If you need to have a time planning line (DEADLINE etc), drawers, +;; for example LOGBOOK of PROPERTIES, or even normal text as part of +;; the inline task, you must add an "END" headline with the same +;; number of stars. ;; -;; **************** TODO some small task +;; As an example, here are two valid inline tasks: +;; +;; **************** TODO a small task +;; +;; and +;; +;; **************** TODO another small task ;; DEADLINE: <2009-03-30 Mon> ;; :PROPERTIES: ;; :SOMETHING: or other @@ -101,12 +107,12 @@ When nil, they will not be exported." :type 'boolean) (defvar org-inlinetask-export-templates - '((html "<pre class=\"inlinetask\"><b>%s%s</b><br>%s</pre>" + '((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\}" + (latex "\\begin\{description\}\n\\item[%s%s]~%s\\end\{description\}" '((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority)) heading content)) (ascii " -- %s%s%s" @@ -193,38 +199,50 @@ The number of levels is controlled by `org-inlinetask-min-level'." org-inlinetask-min-level))) (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars))) +(defun org-inlinetask-at-task-p () + "Return true if point is at beginning of an inline task." + (save-excursion + (beginning-of-line) + (and (looking-at (concat (org-inlinetask-outline-regexp) "\\(.*\\)")) + (not (string-match "^end[ \t]*$" (downcase (match-string 2))))))) + (defun org-inlinetask-in-task-p () "Return true if point is inside an inline task." (save-excursion - (let* ((stars-re (org-inlinetask-outline-regexp)) + (beginning-of-line) + (let* ((case-fold-search t) + (stars-re (org-inlinetask-outline-regexp)) (task-beg-re (concat stars-re "\\(?:.*\\)")) - (task-end-re (concat stars-re "\\(?:END\\|end\\)[ \t]*$"))) - (beginning-of-line) - (or (looking-at task-beg-re) + (task-end-re (concat stars-re "END[ \t]*$"))) + (or (org-looking-at-p task-beg-re) (and (re-search-forward "^\\*+[ \t]+" nil t) - (progn (beginning-of-line) (looking-at task-end-re))))))) + (progn (beginning-of-line) (org-looking-at-p task-end-re))))))) (defun org-inlinetask-goto-beginning () "Go to the beginning of the inline task at point." (end-of-line) - (re-search-backward (org-inlinetask-outline-regexp) nil t) - (when (org-looking-at-p (concat (org-inlinetask-outline-regexp) "END[ \t]*$")) - (re-search-backward (org-inlinetask-outline-regexp) nil t))) + (let ((case-fold-search t) + (inlinetask-re (org-inlinetask-outline-regexp))) + (re-search-backward inlinetask-re nil t) + (when (org-looking-at-p (concat inlinetask-re "END[ \t]*$")) + (re-search-backward inlinetask-re 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)))) + (let ((case-fold-search t) + (inlinetask-re (org-inlinetask-outline-regexp))) + (cond + ((org-looking-at-p (concat inlinetask-re "END[ \t]*$")) + (forward-line 1)) + ((org-looking-at-p inlinetask-re) + (forward-line 1) + (when (org-inlinetask-in-task-p) + (re-search-forward inlinetask-re nil t) + (forward-line 1))) + (t + (re-search-forward inlinetask-re nil t) + (forward-line 1))))) (defun org-inlinetask-get-task-level () "Get the level of the inline task around. @@ -234,65 +252,128 @@ This assumes the point is inside an inline task." (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-promote () + "Promote the inline task at point. +If the task has an end part, promote it. Also, prevents level from +going below `org-inlinetask-min-level'." + (interactive) + (if (not (org-inlinetask-in-task-p)) + (error "Not in an inline task") + (save-excursion + (let* ((lvl (org-inlinetask-get-task-level)) + (next-lvl (org-get-valid-level lvl -1)) + (diff (- next-lvl lvl)) + (down-task (concat (make-string next-lvl ?*))) + beg) + (if (< next-lvl org-inlinetask-min-level) + (error "Cannot promote an inline task at minimum level") + (org-inlinetask-goto-beginning) + (setq beg (point)) + (replace-match down-task nil t nil 1) + (org-inlinetask-goto-end) + (if (eobp) (beginning-of-line) (forward-line -1)) + (unless (= (point) beg) + (replace-match down-task nil t nil 1) + (when org-adapt-indentation + (goto-char beg) + (org-fixup-indentation diff)))))))) + +(defun org-inlinetask-demote () + "Demote the inline task at point. +If the task has an end part, also demote it." + (interactive) + (if (not (org-inlinetask-in-task-p)) + (error "Not in an inline task") + (save-excursion + (let* ((lvl (org-inlinetask-get-task-level)) + (next-lvl (org-get-valid-level lvl 1)) + (diff (- next-lvl lvl)) + (down-task (concat (make-string next-lvl ?*))) + beg) + (org-inlinetask-goto-beginning) + (setq beg (point)) + (replace-match down-task nil t nil 1) + (org-inlinetask-goto-end) + (if (eobp) (beginning-of-line) (forward-line -1)) + (unless (= (point) beg) + (replace-match down-task nil t nil 1) + (when org-adapt-indentation + (goto-char beg) + (org-fixup-indentation diff))))))) + +(defvar org-export-current-backend) ; dynamically bound in org-exp.el (defun org-inlinetask-export-handler () "Handle headlines with level larger or equal to `org-inlinetask-min-level'. Either remove headline and meta data, or do special formatting." (goto-char (point-min)) - (let* ((nstars (if org-odd-levels-only - (1- (* 2 (or org-inlinetask-min-level 200))) - (or org-inlinetask-min-level 200))) - (re1 (format "^\\(\\*\\{%d,\\}\\) .*\n" nstars)) - (re2 (concat "^[ \t]*" org-keyword-time-regexp)) - headline beg end stars content) - (while (re-search-forward re1 nil t) - (setq headline (match-string 0) - stars (match-string 1) - content nil) - (replace-match "") - (while (looking-at re2) - (delete-region (point) (1+ (point-at-eol)))) - (while (looking-at org-drawer-regexp) - (setq beg (point)) - (if (re-search-forward org-property-end-re nil t) - (delete-region beg (1+ (match-end 0))))) - (setq beg (point)) - (when (and (re-search-forward "^\\(\\*+\\) " nil t) - (= (length (match-string 1)) (length stars)) - (progn (goto-char (match-end 0)) - (looking-at "END[ \t]*$"))) - (setq content (buffer-substring beg (1- (point-at-bol)))) - (delete-region beg (1+ (match-end 0)))) + (let* ((keywords-re (concat "^[ \t]*" org-keyword-time-regexp)) + (inline-re (concat (org-inlinetask-outline-regexp) ".*"))) + (while (re-search-forward inline-re nil t) + (let ((headline (match-string 0)) + (beg (point-at-bol)) + (end (copy-marker (save-excursion + (org-inlinetask-goto-end) (point)))) + content) + ;; Delete SCHEDULED, DEADLINE... + (while (re-search-forward keywords-re end t) + (delete-region (point-at-bol) (1+ (point-at-eol)))) (goto-char beg) + ;; Delete drawers + (while (re-search-forward org-drawer-regexp end t) + (when (save-excursion (re-search-forward org-property-end-re nil t)) + (delete-region beg (1+ (match-end 0))))) + ;; Get CONTENT, if any. + (goto-char beg) + (forward-line 1) + (unless (= (point) end) + (setq content (buffer-substring (point) + (save-excursion (goto-char end) + (forward-line -1) + (point))))) + ;; Remove the task. + (goto-char beg) + (delete-region beg end) (when org-inlinetask-export - ;; content formatting - (when content - (if (not (string-match "\\S-" content)) - (setq content nil) - (if (string-match "[ \t\n]+\\'" content) + ;; Format CONTENT, if appropriate. + (setq content + (if (not (and content (string-match "\\S-" content))) + "" + ;; Ensure CONTENT has minimal indentation, a single + ;; newline character at its boundaries, and isn't + ;; protected. + (when (string-match "`\\([ \t]*\n\\)+" content) + (setq content (substring content (match-end 0)))) + (when (string-match "[ \t\n]+\\'" content) (setq content (substring content 0 (match-beginning 0)))) - (setq content (org-remove-indentation content)))) - (setq content (or content "")) - ;; grab elements to export + (org-add-props (concat "\n" (org-remove-indentation content) "\n") + '(org-protected nil)))) (when (string-match org-complex-heading-regexp headline) - (let* ((todo (or (match-string 2 headline) "")) + (let* ((nil-to-str + (function + ;; Change nil arguments into empty strings. + (lambda (el) (or (eval el) "")))) + ;; Set up keywords provided to templates. + (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)) + ;; Read `org-inlinetask-export-templates'. + (backend-spec (assq org-export-current-backend + org-inlinetask-export-templates)) + (format-str (org-add-props (nth 1 backend-spec) + '(org-protected t))) (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 + ;; Build export string. Ensure it won't break + ;; surrounding lists by giving it arbitrary high + ;; indentation. (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"))))))) + '(original-indentation 1000)))) + (insert export-str) + (unless (bolp) (insert "\n"))))))))) (defun org-inlinetask-get-current-indentation () "Get the indentation of the last non-while line above this one." @@ -321,6 +402,22 @@ Either remove headline and meta data, or do special formatting." (add-text-properties (match-beginning 3) (match-end 3) '(face shadow font-lock-fontified t))))) +(defun org-inlinetask-toggle-visibility () + "Toggle visibility of inline task at point." + (let ((end (save-excursion + (org-inlinetask-goto-end) + (if (bolp) (1- (point)) (point)))) + (start (save-excursion + (org-inlinetask-goto-beginning) + (point-at-eol)))) + (cond + ;; Nothing to show/hide. + ((= end start)) + ;; Inlinetask was folded: expand it. + ((get-char-property (1+ start) 'invisible) + (outline-flag-region start end nil)) + (t (outline-flag-region start end t))))) + (defun org-inlinetask-remove-END-maybe () "Remove an END line when present." (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$" @@ -328,7 +425,7 @@ Either remove headline and meta data, or do special formatting." (replace-match ""))) (eval-after-load "org-exp" - '(add-hook 'org-export-preprocess-after-tree-selection-hook + '(add-hook 'org-export-preprocess-before-backend-specifics-hook 'org-inlinetask-export-handler)) (eval-after-load "org" '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)) diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 8339a5640d2..bc0e94450b7 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -1,10 +1,10 @@ ;;; org-irc.el --- Store links to IRC sessions ;; -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Philip Jackson <emacs@shellarchive.co.uk> ;; Keywords: erc, irc, link, org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -60,6 +60,8 @@ (declare-function erc-server-buffer "erc" ()) (declare-function erc-get-server-nickname-list "erc" ()) (declare-function erc-cmd-JOIN "erc" (channel &optional key)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) (defvar org-irc-client 'erc "The IRC client to act on.") @@ -232,7 +234,7 @@ default." (throw 'found x)))))) (if chan-buf (progn - (switch-to-buffer chan-buf) + (org-pop-to-buffer-same-window chan-buf) ;; if we got a nick, and they're in the chan, ;; then start a chat with them (let ((nick (pop link))) @@ -243,13 +245,14 @@ default." (insert (concat nick ": "))) (error "%s not found in %s" nick chan-name))))) (progn - (switch-to-buffer server-buffer) + (org-pop-to-buffer-same-window server-buffer) (erc-cmd-JOIN chan-name)))) - (switch-to-buffer server-buffer))) + (org-pop-to-buffer-same-window server-buffer))) ;; no server match, make new connection (erc-select :server server :port port)))) (provide 'org-irc) +;; arch-tag: 018d7dda-53b8-4a35-ba92-6670939e525a ;;; org-irc.el ends here diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el index 1db4860b20d..cdefef8428c 100644 --- a/lisp/org/org-jsinfo.el +++ b/lisp/org/org-jsinfo.el @@ -1,11 +1,12 @@ ;;; org-jsinfo.el --- Support for org-info.js Javascript in Org HTML export -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -204,5 +205,6 @@ Option settings will replace the %MANAGER-OPTIONS cookie." (provide 'org-infojs) (provide 'org-jsinfo) +;; arch-tag: c71d1d85-3337-4817-a066-725e74ac9eac ;;; org-jsinfo.el ends here diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el index 3f4c1dcb7cf..bd9c1138c7f 100644 --- a/lisp/org/org-latex.el +++ b/lisp/org/org-latex.el @@ -1,10 +1,10 @@ ;;; org-latex.el --- LaTeX exporter for org-mode ;; -;; Copyright (C) 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; ;; Emacs Lisp Archive Entry ;; Filename: org-latex.el -;; Version: 7.4 +;; Version: 7.7 ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -65,6 +65,8 @@ (defvar org-export-latex-display-custom-times nil) (defvar org-export-latex-all-targets-re nil) (defvar org-export-latex-add-level 0) +(defvar org-export-latex-footmark-seen nil + "List of footnotes markers seen so far by exporter.") (defvar org-export-latex-sectioning "") (defvar org-export-latex-sectioning-depth 0) (defvar org-export-latex-special-keyword-regexp @@ -73,9 +75,8 @@ org-closed-string"\\)") "Regexp matching special time planning keywords plus the time after it.") -(defvar latexp) ; dynamically scoped from org.el -(defvar re-quote) ; dynamically scoped from org.el -(defvar commentsp) ; dynamically scoped from org.el +(defvar org-re-quote) ; dynamically scoped from org.el +(defvar org-commentsp) ; dynamically scoped from org.el ;;; User variables: @@ -230,14 +231,15 @@ are written as utf8 files." ("/" "\\emph{%s}" nil) ("_" "\\underline{%s}" nil) ("+" "\\st{%s}" nil) - ("=" "\\verb" t) + ("=" "\\protectedtexttt" t) ("~" "\\verb" t)) "Alist of LaTeX expressions to convert emphasis fontifiers. Each element of the list is a list of three elements. The first element is the character used as a marker for fontification. The second element is a formatting string to wrap fontified text with. If it is \"\\verb\", Org will automatically select a delimiter -character that is not in the string. +character that is not in the string. \"\\protectedtexttt\" will use \\texttt +to typeset and try to protect special characters. The third element decides whether to protect converted text from other conversions." :group 'org-export-latex @@ -258,7 +260,7 @@ For example \orgTITLE for #+TITLE." :type 'boolean) (defcustom org-export-latex-date-format - "%d %B %Y" + "\\today" "Format string for \\date{...}." :group 'org-export-latex :type 'string) @@ -290,6 +292,11 @@ markup defined, the first one in the association list will be used." :group 'org-export-latex :type 'string) +(defcustom org-export-latex-timestamp-inactive-markup "\\textit{%s}" + "A printf format string to be applied to inactive time stamps." + :group 'org-export-latex + :type 'string) + (defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}" "A printf format string to be applied to time stamps." :group 'org-export-latex @@ -297,18 +304,51 @@ markup defined, the first one in the association list will be used." (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." +The format must contain either two %s instances or just one. +If it contains two %s instances, the first will be filled with +the link, the second with the link description. If it contains +only one, the %s will be filled with the link." :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." +The format must contain one or two %s instances. The first one +will be filled with the link, the second with its description." :group 'org-export-latex :type 'string) +(defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\," + "Text used to separate footnotes." + :group 'org-export-latex + :type 'string) + +(defcustom org-export-latex-quotes + '(("fr" ("\\(\\s-\\|[[(]\\)\"" . "«~") ("\\(\\S-\\)\"" . "~»") ("\\(\\s-\\|(\\)'" . "'")) + ("en" ("\\(\\s-\\|[[(]\\)\"" . "``") ("\\(\\S-\\)\"" . "''") ("\\(\\s-\\|(\\)'" . "`"))) + "Alist for quotes to use when converting english double-quotes. + +The CAR of each item in this alist is the language code. +The CDR of each item in this alist is a list of three CONS: +- the first CONS defines the opening quote; +- the second CONS defines the closing quote; +- the last CONS defines single quotes. + +For each item in a CONS, the first string is a regexp +for allowed characters before/after the quote, the second +string defines the replacement string for this quote." + :group 'org-export-latex + :type '(list + (cons :tag "Opening quote" + (string :tag "Regexp for char before") + (string :tag "Replacement quote ")) + (cons :tag "Closing quote" + (string :tag "Regexp for char after ") + (string :tag "Replacement quote ")) + (cons :tag "Single quote" + (string :tag "Regexp for char before") + (string :tag "Replacement quote ")))) + (defcustom org-export-latex-tables-verbatim nil "When non-nil, tables are exported verbatim." :group 'org-export-latex @@ -353,7 +393,7 @@ string should be like \"\\end{itemize\"." (string :tag "Use a section string" :value "\\subparagraph{%s}"))) (defcustom org-export-latex-list-parameters - '(:cbon "$\\boxtimes$" :cboff "$\\Box$") + '(:cbon "$\\boxtimes$" :cboff "$\\Box$" :cbtrans "$\\boxminus$") "Parameters for the LaTeX list exporter. These parameters will be passed on to `org-list-to-latex', which in turn will pass them (combined with the LaTeX default list parameters) to @@ -390,15 +430,15 @@ Alternatively, (setq org-export-latex-listings 'minted) causes source code to be exported using the minted package as -opposed to listings. If you want to use minted, you need to add +opposed to listings. If you want to use minted, you need to add the minted package to `org-export-latex-packages-alist', for example using customize, or with (require 'org-latex) (add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\")) -In addition, it is neccessary to install -pygments (http://pygments.org), and to configure +In addition, it is necessary to install +pygments (http://pygments.org), and to configure the variable `org-latex-to-pdf-process' so that the -shell-escape option is passed to pdflatex. " @@ -460,6 +500,67 @@ pygmentize -L lexers (symbol :tag "Major mode ") (string :tag "Listings language")))) +(defcustom org-export-latex-listings-options nil + "Association list of options for the latex listings package. + +These options are supplied as a comma-separated list to the +\\lstset command. Each element of the association list should be +a list containing two strings: the name of the option, and the +value. For example, + + (setq org-export-latex-listings-options + '((\"basicstyle\" \"\\small\") + (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\"))) + +will typeset the code in a small size font with underlined, bold +black keywords. + +Note that the same options will be applied to blocks of all +languages." + :group 'org-export-latex + :type '(repeat + (list + (string :tag "Listings option name ") + (string :tag "Listings option value")))) + +(defcustom org-export-latex-minted-options nil + "Association list of options for the latex minted package. + +These options are supplied within square brackets in +\\begin{minted} environments. Each element of the alist should be +a list containing two strings: the name of the option, and the +value. For example, + + (setq org-export-latex-minted-options + '((\"bgcolor\" \"bg\") (\"frame\" \"lines\"))) + +will result in src blocks being exported with + +\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>} + +as the start of the minted environment. Note that the same +options will be applied to blocks of all languages." + :group 'org-export-latex + :type '(repeat + (list + (string :tag "Minted option name ") + (string :tag "Minted option value")))) + +(defvar org-export-latex-custom-lang-environments nil + "Association list mapping languages to language-specific latex + environments used during export of src blocks by the listings + and minted latex packages. For example, + + (setq org-export-latex-custom-lang-environments + '((python \"pythoncode\"))) + + would have the effect that if org encounters begin_src python + during latex export it will output + + \\begin{pythoncode} + <src block body> + \\end{pythoncode}") + (defcustom org-export-latex-remove-from-headlines '(:todo nil :priority nil :tags nil) "A plist of keywords to remove from headlines. OBSOLETE. @@ -473,11 +574,16 @@ and `org-export-with-tags' instead." :type 'plist :group 'org-export-latex) -(defcustom org-export-latex-image-default-option "width=10em" +(defcustom org-export-latex-image-default-option "width=.9\\linewidth" "Default option for images." :group 'org-export-latex :type 'string) +(defcustom org-latex-default-figure-position "htb" + "Default position for latex figures." + :group 'org-export-latex + :type 'string) + (defcustom org-export-latex-tabular-environment "tabular" "Default environment used to build tables." :group 'org-export-latex @@ -644,7 +750,7 @@ a Lisp program could call this function in the following way: When called interactively, the output buffer is selected, and shown in a window. A non-interactive call will only return the buffer." (interactive "r\nP") - (when (interactive-p) + (when (org-called-interactively-p 'any) (setq buffer "*Org LaTeX Export*")) (let ((transient-mark-mode t) (zmacs-regions t) ext-plist rtn) @@ -656,7 +762,7 @@ in a window. A non-interactive call will only return the buffer." nil nil ext-plist buffer body-only)) (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (interactive-p) (bufferp rtn)) + (if (and (org-called-interactively-p 'any) (bufferp rtn)) (switch-to-buffer-other-window rtn) rtn))) @@ -700,11 +806,15 @@ when PUB-DIR is set, use this as the publishing directory." '(:org-license-to-kill nil)))) (org-update-radio-target-regexp) (org-export-latex-set-initial-vars ext-plist arg) - (setq org-export-opt-plist org-export-latex-options-plist) + (setq org-export-opt-plist org-export-latex-options-plist + org-export-footnotes-data (org-footnote-all-labels 'with-defs) + org-export-footnotes-seen nil + org-export-latex-footmark-seen nil) (org-install-letbind) (run-hooks 'org-export-latex-after-initial-vars-hook) (let* ((wcf (current-window-configuration)) - (opt-plist org-export-latex-options-plist) + (opt-plist + (org-export-process-option-filters org-export-latex-options-plist)) (region-p (org-region-active-p)) (rbeg (and region-p (region-beginning))) (rend (and region-p (region-end))) @@ -794,7 +904,7 @@ when PUB-DIR is set, use this as the publishing directory." (org-export-preprocess-string text :emph-multiline t - :for-LaTeX t + :for-backend 'latex :comments nil :tags (plist-get opt-plist :tags) :priority (plist-get opt-plist :priority) @@ -802,6 +912,7 @@ when PUB-DIR is set, use this as the publishing directory." :drawers (plist-get opt-plist :drawers) :timestamps (plist-get opt-plist :timestamps) :todo-keywords (plist-get opt-plist :todo-keywords) + :tasks (plist-get opt-plist :tasks) :add-text nil :skip-before-1st-heading skip :select-tags nil @@ -811,7 +922,7 @@ when PUB-DIR is set, use this as the publishing directory." (org-export-preprocess-string region :emph-multiline t - :for-LaTeX t + :for-backend 'latex :comments nil :tags (plist-get opt-plist :tags) :priority (plist-get opt-plist :priority) @@ -819,6 +930,7 @@ when PUB-DIR is set, use this as the publishing directory." :drawers (plist-get opt-plist :drawers) :timestamps (plist-get opt-plist :timestamps) :todo-keywords (plist-get opt-plist :todo-keywords) + :tasks (plist-get opt-plist :tasks) :add-text (if (eq to-buffer 'string) nil text) :skip-before-1st-heading skip :select-tags (plist-get opt-plist :select-tags) @@ -843,7 +955,7 @@ when PUB-DIR is set, use this as the publishing directory." "\n\n")) ;; insert lines before the first headline - (unless skip + (unless (or skip (string-match "^\\*" first-lines)) (insert first-lines)) ;; export the content of headlines @@ -917,7 +1029,13 @@ when PUB-DIR is set, use this as the publishing directory." (file (buffer-file-name lbuf)) (base (file-name-sans-extension (buffer-file-name lbuf))) (pdffile (concat base ".pdf")) - (cmds org-latex-to-pdf-process) + (cmds (if (eq org-export-latex-listings 'minted) + ;; automatically add -shell-escape when needed + (mapcar (lambda (cmd) + (replace-regexp-in-string + "pdflatex " "pdflatex -shell-escape " cmd)) + org-latex-to-pdf-process) + org-latex-to-pdf-process)) (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) (bibtex-p (with-current-buffer lbuf (save-excursion @@ -927,26 +1045,28 @@ when PUB-DIR is set, use this as the publishing directory." (with-current-buffer outbuf (erase-buffer)) (message (concat "Processing LaTeX file " file "...")) (setq output-dir (file-name-directory file)) - (if (and cmds (symbolp cmds)) - (funcall cmds (shell-quote-argument file)) - (while cmds - (setq cmd (pop cmds)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument base)) - t t cmd))) - (while (string-match "%f" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument file)) - t t cmd))) - (while (string-match "%o" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument output-dir)) - t t cmd))) - (shell-command cmd outbuf))) + (with-current-buffer lbuf + (save-excursion + (if (and cmds (symbolp cmds)) + (funcall cmds (shell-quote-argument file)) + (while cmds + (setq cmd (pop cmds)) + (while (string-match "%b" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument base)) + t t cmd))) + (while (string-match "%f" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument file)) + t t cmd))) + (while (string-match "%o" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument output-dir)) + t t cmd))) + (shell-command cmd outbuf))))) (message (concat "Processing LaTeX file " file "...done")) (setq errors (org-export-latex-get-error outbuf)) (if (not (file-exists-p pdffile)) @@ -1084,7 +1204,9 @@ and its content." (defun org-export-latex-subcontent (subcontent num) "Export each cell of SUBCONTENT to LaTeX. -If NUM, export sections as numerical sections." +If NUM is non-nil export numbered sections, otherwise use unnumbered +sections. If NUM is an integer, export the highest NUM levels as +numbered sections and lower levels as unnumbered sections." (let* ((heading (cdr (assoc 'heading subcontent))) (level (- (cdr (assoc 'level subcontent)) org-export-latex-add-level)) @@ -1120,6 +1242,9 @@ If NUM, export sections as numerical sections." ;; Normal conversion ((<= level depth) (let* ((sec (nth (1- level) sectioning)) + (num (if (integerp num) + (>= num level) + num)) start end) (if (consp (cdr sec)) (setq start (nth (if num 0 2) sec) @@ -1266,7 +1391,11 @@ TITLE is the current title from the buffer or region. OPT-PLIST is the options plist for current buffer." (let ((toc (plist-get opt-plist :table-of-contents)) (author (org-export-apply-macros-in-string - (plist-get opt-plist :author)))) + (plist-get opt-plist :author))) + (email (replace-regexp-in-string + "_" "\\\\_" + (org-export-apply-macros-in-string + (plist-get opt-plist :email))))) (concat (if (plist-get opt-plist :time-stamp-file) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) @@ -1281,17 +1410,18 @@ 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-fontify-headline title)) ;; insert author info (if (plist-get opt-plist :author-info) - (format "\\author{%s}\n" - (org-export-latex-fontify-headline (or author user-full-name))) + (format "\\author{%s%s}\n" + (org-export-latex-fontify-headline (or author user-full-name)) + (if (and (plist-get opt-plist :email-info) email + (string-match "\\S-" email)) + (format "\\thanks{%s}" email) + "")) (format "%%\\author{%s}\n" (org-export-latex-fontify-headline (or author user-full-name)))) ;; insert the date @@ -1299,6 +1429,8 @@ 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,14 +1457,15 @@ 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 (org-get-limited-outline-regexp) end t) + (end (if (re-search-forward + (concat "^" (org-get-limited-outline-regexp)) end t) (goto-char (match-beginning 0)) (goto-char (or end (point-max)))))) (prog1 (org-export-latex-content (org-export-preprocess-string (buffer-substring pt end) - :for-LaTeX t + :for-backend 'latex :emph-multiline t :add-text nil :comments nil @@ -1354,12 +1487,10 @@ If END is non-nil, it is the end of the region." (match-string 0)) (remove-text-properties (match-beginning 0) (match-end 0) '(:org-license-to-kill t)))))))))))) - + (defvar org-export-latex-header-defs nil "The header definitions that might be used in the LaTeX body.") -(defvar org-export-latex-header-defs-re nil - "The header definitions that might be used in the LaTeX body.") (defun org-export-latex-content (content &optional exclude-list) "Convert CONTENT string to LaTeX. @@ -1367,31 +1498,32 @@ Don't perform conversions that are in EXCLUDE-LIST. Recognized conversion types are: quotation-marks, emphasis, sub-superscript, links, keywords, lists, tables, fixed-width" (with-temp-buffer - (insert content) - (unless (memq 'timestamps exclude-list) - (org-export-latex-time-stamps)) - (unless (memq 'quotation-marks exclude-list) - (org-export-latex-quotation-marks)) - (unless (memq 'emphasis exclude-list) - (when (plist-get org-export-latex-options-plist :emphasize) - (org-export-latex-fontify))) - (unless (memq 'sub-superscript exclude-list) - (org-export-latex-special-chars - (plist-get org-export-latex-options-plist :sub-superscript))) - (unless (memq 'links exclude-list) - (org-export-latex-links)) - (unless (memq 'keywords exclude-list) - (org-export-latex-keywords)) - (unless (memq 'lists exclude-list) - (org-export-latex-lists)) - (unless (memq 'tables exclude-list) - (org-export-latex-tables - (plist-get org-export-latex-options-plist :tables))) - (unless (memq 'fixed-width exclude-list) - (org-export-latex-fixed-width - (plist-get org-export-latex-options-plist :fixed-width))) + (org-install-letbind) + (insert content) + (unless (memq 'timestamps exclude-list) + (org-export-latex-time-stamps)) + (unless (memq 'quotation-marks exclude-list) + (org-export-latex-quotation-marks)) + (unless (memq 'emphasis exclude-list) + (when (plist-get org-export-latex-options-plist :emphasize) + (org-export-latex-fontify))) + (unless (memq 'sub-superscript exclude-list) + (org-export-latex-special-chars + (plist-get org-export-latex-options-plist :sub-superscript))) + (unless (memq 'links exclude-list) + (org-export-latex-links)) + (unless (memq 'keywords exclude-list) + (org-export-latex-keywords)) + (unless (memq 'lists exclude-list) + (org-export-latex-lists)) + (unless (memq 'tables exclude-list) + (org-export-latex-tables + (plist-get org-export-latex-options-plist :tables))) + (unless (memq 'fixed-width exclude-list) + (org-export-latex-fixed-width + (plist-get org-export-latex-options-plist :fixed-width))) ;; return string - (buffer-substring (point-min) (point-max)))) + (buffer-substring (point-min) (point-max)))) (defun org-export-latex-protect-string (s) "Add the org-protected property to string S." @@ -1443,7 +1575,7 @@ links, keywords, lists, tables, fixed-width" (format org-export-latex-tag-markup (save-match-data (replace-regexp-in-string - "_" "\\\\_" (match-string 0))))) + "\\([_#]\\)" "\\\\\\1" (match-string 0))))) t t))))) (defun org-export-latex-fontify-headline (string) @@ -1454,7 +1586,7 @@ links, keywords, lists, tables, fixed-width" (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) @@ -1498,6 +1630,8 @@ links, keywords, lists, tables, fixed-width" '(org-protected t))))) (when (plist-get org-export-latex-options-plist :emphasize) (org-export-latex-fontify)) + (org-export-latex-time-stamps) + (org-export-latex-quotation-marks) (org-export-latex-keywords-maybe) (org-export-latex-special-chars (plist-get org-export-latex-options-plist :sub-superscript)) @@ -1512,27 +1646,26 @@ links, keywords, lists, tables, fixed-width" (org-if-unprotected-at (1- (point)) (replace-match (org-export-latex-protect-string - (format org-export-latex-timestamp-markup + (format (if (string= "<" (substring (match-string 0) 0 1)) + org-export-latex-timestamp-markup + org-export-latex-timestamp-inactive-markup) (substring (org-translate-time (match-string 0)) 1 -1))) t t))))) (defun org-export-latex-quotation-marks () "Export quotation marks depending on language conventions." - (let* ((lang (plist-get org-export-latex-options-plist :language)) - (quote-rpl (if (equal lang "fr") - '(("\\(\\s-\\)\"" "«~") - ("\\(\\S-\\)\"" "~»") - ("\\(\\s-\\)'" "`")) - '(("\\(\\s-\\|[[(]\\)\"" "``") - ("\\(\\S-\\)\"" "''") - ("\\(\\s-\\|(\\)'" "`"))))) - (mapc (lambda(l) (goto-char (point-min)) - (while (re-search-forward (car l) nil t) - (let ((rpl (concat (match-string 1) - (org-export-latex-protect-string - (copy-sequence (cadr l)))))) - (org-if-unprotected-1 - (replace-match rpl t t))))) quote-rpl))) + (mapc (lambda(l) + (goto-char (point-min)) + (while (re-search-forward (car l) nil t) + (let ((rpl (concat (match-string 1) + (org-export-latex-protect-string + (copy-sequence (cdr l)))))) + (org-if-unprotected-1 + (replace-match rpl t t))))) + (cdr (or (assoc (plist-get org-export-latex-options-plist :language) + org-export-latex-quotes) + ;; falls back on english + (assoc "en" org-export-latex-quotes))))) (defun org-export-latex-special-chars (sub-superscript) "Export special characters to LaTeX. @@ -1543,7 +1676,8 @@ See the `org-export-latex.el' code for a complete conversion table." (goto-char (point-min)) (while (re-search-forward c nil t) ;; Put the point where to check for org-protected - (unless (get-text-property (match-beginning 2) 'org-protected) + (unless (or (get-text-property (match-beginning 2) 'org-protected) + (save-match-data (org-at-table.el-p))) (cond ((member (match-string 2) '("\\$" "$")) (if (equal (match-string 2) "\\$") nil @@ -1602,13 +1736,7 @@ See the `org-export-latex.el' code for a complete conversion table." "\\(\\(\\\\?\\$\\)\\)" "\\([a-zA-Z0-9()]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-zA-Z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-zA-Z0-9]+}\\|([a-zA-Z0-9]+)\\)" "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)" - "\\(.\\|^\\)\\(&\\)" - "\\(.\\|^\\)\\(#\\)" - "\\(.\\|^\\)\\(%\\)" - "\\(.\\|^\\)\\({\\)" - "\\(.\\|^\\)\\(}\\)" - "\\(.\\|^\\)\\(~\\)" - "\\(.\\|^\\)\\(\\.\\.\\.\\)" + "\\(^\\|.\\)\\([&#%{}~]\\|\\.\\.\\.\\)" ;; (?\< . "\\textless{}") ;; (?\> . "\\textgreater{}") ))) @@ -1740,7 +1868,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (org-table-last-column-widths (copy-sequence org-table-last-column-widths)) fnum fields line lines olines gr colgropen line-fmt align - caption shortn label attr floatp placement longtblp) + caption width shortn label attr floatp placement + longtblp tblenv tabular-env) (if org-export-latex-tables-verbatim (let* ((tbl (concat "\\begin{verbatim}\n" raw-table "\\end{verbatim}\n"))) @@ -1757,15 +1886,28 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." 'org-label raw-table) longtblp (and attr (stringp attr) (string-match "\\<longtable\\>" attr)) + tblenv (if (and attr (stringp attr) + (or (string-match (regexp-quote "table*") attr) + (string-match "\\<multicolumn\\>" attr))) + "table*" "table") + tabular-env + (if (and attr (stringp attr) + (string-match "\\(tabular.\\)" attr)) + (match-string 1 attr) + org-export-latex-tabular-environment) + width (and attr (stringp attr) + (string-match "\\<width=\\([^ \t\n\r]+\\)" attr) + (match-string 1 attr)) align (and attr (stringp attr) (string-match "\\<align=\\([^ \t\n\r]+\\)" attr) (match-string 1 attr)) - floatp (or caption label) - placement (if (and attr + floatp (or caption label (string= "table*" tblenv)) + placement (if (and attr (stringp attr) (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr)) (match-string 1 attr) - "[htb]")) + (concat + "[" org-latex-default-figure-position "]"))) (setq caption (and caption (org-export-latex-fontify-headline caption))) (setq lines (org-split-string raw-table "\n")) (apply 'delete-region (list beg end)) @@ -1813,14 +1955,17 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (mapcar (lambda(elem) (or (and (string-match "[ \t]*|-+" elem) 'hline) - (org-split-string (org-trim elem) "|"))) + (org-split-string + (progn (set-text-properties 0 (length elem) nil elem) + (org-trim elem)) "|"))) lines)) (when insert (insert (org-export-latex-protect-string (concat (if longtblp (concat "\\begin{longtable}{" align "}\n") - (if floatp (format "\\begin{table}%s\n" placement))) + (if floatp + (format "\\begin{%s}%s\n" tblenv placement))) (if floatp (format "\\caption%s{%s} %s" @@ -1831,8 +1976,10 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (if (and org-export-latex-tables-centered (not longtblp)) "\\begin{center}\n") (if (not longtblp) - (format "\\begin{%s}{%s}\n" - org-export-latex-tabular-environment align)) + (format "\\begin{%s}%s{%s}\n" + tabular-env + (if width (format "{%s}" width) "") + align)) (orgtbl-to-latex lines `(:tstart nil :tend nil @@ -1844,14 +1991,12 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." \\endfoot \\endlastfoot" (length org-table-last-alignment)) nil))) - (if (not longtblp) - (format "\n\\end{%s}" - org-export-latex-tabular-environment)) + (if (not longtblp) (format "\n\\end{%s}" tabular-env)) (if longtblp "\n" (if org-export-latex-tables-centered "\n\\end{center}\n" "\n")) (if longtblp "\\end{longtable}" - (if floatp "\\end{table}")))) + (if floatp (format "\\end{%s}" tblenv))))) "\n\n")))))))) (defun org-export-latex-convert-table.el-table () @@ -1898,7 +2043,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}"))) (when floatp (setq tbl (concat "\\begin{table}\n" - (format "\\caption%s{%s}%s\n" + (format "\\caption%s{%s%s}\n" (if shortn (format "[%s]" shortn) "") (if label (format "\\label{%s}" label) "") (or caption "")) @@ -1950,12 +2095,11 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (replace-match rpl t t))) (backward-char))) -(defvar org-export-latex-use-verb nil) (defun org-export-latex-emph-format (format string) "Format an emphasis string and handle the \\verb special case." - (when (equal format "\\verb") + (when (member format '("\\verb" "\\protectedtexttt")) (save-match-data - (if org-export-latex-use-verb + (if (equal format "\\verb") (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) (catch 'exit (loop for i from 0 to (1- (length ll)) do @@ -1978,7 +2122,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (setq string (substring string (1+ (match-beginning 0)))) (setq char (or (cdr (assoc char trans)) (concat "\\" char)) rtn (concat rtn char))) - (setq string (concat rtn string) format "\\texttt{%s}"))))) + (setq string (concat rtn string) format "\\texttt{%s}") + (while (string-match "--" string) + (setq string (replace-match "-{}-" t t string))))))) (format format string)) (defun org-export-latex-links () @@ -2057,7 +2203,10 @@ 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-href-format path desc))) + (insert + (if (string-match "%s.*%s" org-export-latex-href-format) + (format org-export-latex-href-format path desc) + (format org-export-latex-href-format path)))) ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) ;; The link protocol has a function for formatting the link @@ -2084,7 +2233,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (setq placement (cond (wrapp "{l}{0.5\\textwidth}") - (floatp "[htb]") + (floatp (concat "[" org-latex-default-figure-position "]")) (t ""))) (when (and attr (stringp attr) @@ -2106,12 +2255,12 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (multicolumnp "\\begin{figure*}%placement \\centering \\includegraphics[%attr]{%path} -\\caption{%labelcmd%caption} +\\caption%shortn{%labelcmd%caption} \\end{figure*}") (floatp "\\begin{figure}%placement \\centering \\includegraphics[%attr]{%path} -\\caption{%labelcmd%caption} +\\caption%shortn{%labelcmd%caption} \\end{figure}") (t "\\includegraphics[%attr]{%path}"))) @@ -2154,6 +2303,68 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defun org-export-latex-preprocess (parameters) "Clean stuff in the LaTeX export." + ;; Replace footnotes. + (when (plist-get parameters :footnotes) + (goto-char (point-min)) + (let (ref) + (while (setq ref (org-footnote-get-next-reference)) + (let* ((beg (nth 1 ref)) + (lbl (car ref)) + (def (nth 1 (assoc (string-to-number lbl) + (mapcar (lambda (e) (cdr e)) + org-export-footnotes-seen))))) + ;; Fix body for footnotes ending on a link or a list and + ;; remove definition from buffer. + (setq def + (concat def + (if (string-match "ORG-LIST-END-MARKER\\'" def) + "\n" " "))) + (org-footnote-delete-definitions lbl) + ;; Compute string to insert (FNOTE), and protect the outside + ;; macro from further transformation. When footnote at + ;; point is referring to a previously defined footnote, use + ;; \footnotemark. Otherwise, use \footnote. + (let ((fnote (if (member lbl org-export-latex-footmark-seen) + (org-export-latex-protect-string + (format "\\footnotemark[%s]" lbl)) + (push lbl org-export-latex-footmark-seen) + (concat (org-export-latex-protect-string "\\footnote{") + def + (org-export-latex-protect-string "}")))) + ;; Check if another footnote is immediately following. + ;; If so, add a separator in-between. + (sep (org-export-latex-protect-string + (if (save-excursion (goto-char (1- (nth 2 ref))) + (let ((next (org-footnote-get-next-reference))) + (and next (= (nth 1 next) (nth 2 ref))))) + org-export-latex-footnote-separator "")))) + (when (org-on-heading-p) + (setq fnote (concat (org-export-latex-protect-string "\\protect") + fnote))) + ;; Ensure a footnote at column 0 cannot end a list + ;; containing it. + (put-text-property 0 (length fnote) 'original-indentation 1000 fnote) + ;; Replace footnote reference with FNOTE and, maybe, SEP. + ;; `save-excursion' is required if there are two footnotes + ;; in a row. In that case, point would be left at the + ;; beginning of the second one, and + ;; `org-footnote-get-next-reference' would then skip it. + (goto-char beg) + (delete-region beg (nth 2 ref)) + (save-excursion (insert fnote sep))))))) + + ;; Remove footnote section tag for LaTeX + (goto-char (point-min)) + (while (re-search-forward + (concat "^" footnote-section-tag-regexp) nil t) + (org-if-unprotected + (replace-match ""))) + ;; Remove any left-over footnote definition. + (mapc (lambda (fn) (org-footnote-delete-definitions (car fn))) + org-export-footnotes-data) + (mapc (lambda (fn) (org-footnote-delete-definitions fn)) + org-export-latex-footmark-seen) + ;; Preserve line breaks (goto-char (point-min)) (while (re-search-forward "\\\\\\\\" nil t) @@ -2165,17 +2376,16 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t) (org-if-unprotected (let* ((start (progn (beginning-of-line) (point))) - (end (and (re-search-forward - (concat "^[ \t]*\\\\end{" - (regexp-quote (match-string 1)) - "}") nil t) - (point-at-eol)))) - (if end - (add-text-properties start end '(org-protected t)) - (goto-char (point-at-eol)))))) + (end (and (re-search-forward + (concat "^[ \t]*\\\\end{" + (regexp-quote (match-string 1)) + "}") nil t) + (point-at-eol)))) + (if end + (add-text-properties start end '(org-protected t)) + (goto-char (point-at-eol)))))) ;; Preserve math snippets - (let* ((matchers (plist-get org-format-latex-options :matchers)) (re-list org-latex-regexps) beg end re e m n block off) @@ -2229,6 +2439,18 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (and (looking-at "[ \t]*ORG-VERSE-END.*") (org-replace-match-keep-properties "\\end{verse}" t t))) + ;; Convert #+INDEX to LaTeX \\index. + (goto-char (point-min)) + (let ((case-fold-search t) entry) + (while (re-search-forward + "^[ \t]*#\\+index:[ \t]*\\([^ \t\r\n].*?\\)[ \t]*$" + nil t) + (setq entry + (save-match-data + (org-export-latex-protect-string + (org-export-latex-fontify-headline (match-string 1))))) + (replace-match (format "\\index{%s}" entry) t t))) + ;; Convert center (goto-char (point-min)) (while (search-forward "ORG-CENTER-START" nil t) @@ -2241,26 +2463,31 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ;; Convert horizontal rules (goto-char (point-min)) - (while (re-search-forward "^----+.$" nil t) + (while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t) (org-if-unprotected (replace-match (org-export-latex-protect-string "\\hrule") t t))) ;; Protect LaTeX commands like \command[...]{...} or \command{...} (goto-char (point-min)) (let ((re (concat - "\\\\\\([a-zA-Z]+\\)" + "\\\\\\([a-zA-Z]+\\*?\\)" "\\(?:<[^<>\n]*>\\)*" "\\(?:\\[[^][\n]*?\\]\\)*" "\\(?:<[^<>\n]*>\\)*" "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}"))) (while (re-search-forward re nil t) (unless (or - ;; check for comment line + ;; Check for comment line. (save-excursion (goto-char (match-beginning 0)) (org-in-indented-comment-line)) - ;; Check if this is a defined entity, so that is may need conversion + ;; Check if this is a defined entity, so that is may + ;; need conversion. (org-entity-get (match-string 1)) - ) + ;; Do not protect interior of footnotes. Those have + ;; already been taken care of earlier in the function. + ;; Yet, keep looking inside them for more commands. + (and (equal (match-string 1) "footnote") + (goto-char (match-end 1)))) (add-text-properties (match-beginning 0) (match-end 0) '(org-protected t))))) @@ -2283,68 +2510,20 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (concat "<<<?" org-export-latex-all-targets-re ">>>?\\((INVISIBLE)\\)?") nil t) (org-if-unprotected-at (+ (match-beginning 0) 2) - (replace-match - (concat - (org-export-latex-protect-string - (format "\\label{%s}" (save-match-data (org-solidify-link-text - (match-string 1))))) - (if (match-string 2) "" (match-string 1))) - t t))) + (replace-match + (concat + (org-export-latex-protect-string + (format "\\label{%s}" (save-match-data (org-solidify-link-text + (match-string 1))))) + (if (match-string 2) "" (match-string 1))) + t t))) ;; Delete @<...> constructs ;; Thanks to Daniel Clemente for this regexp (goto-char (point-min)) (while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t) (org-if-unprotected - (replace-match ""))) - - ;; When converting to LaTeX, replace footnotes - ;; FIXME: don't protect footnotes from conversion - (when (plist-get org-export-latex-options-plist :footnotes) - (goto-char (point-min)) - (while (re-search-forward "\\[\\([0-9]+\\)\\]" nil t) - (org-if-unprotected - (when (and (save-match-data - (save-excursion (beginning-of-line) - (looking-at "[^:|#]"))) - (not (org-in-verbatim-emphasis))) - (let ((foot-beg (match-beginning 0)) - (foot-end (match-end 0)) - (foot-prefix (match-string 0)) - footnote footnote-rpl) - (save-excursion - (if (not (re-search-forward (concat "^" (regexp-quote foot-prefix)) - nil t)) - (replace-match (org-export-latex-protect-string - (concat "$^{" (match-string 1) "}$"))) - (replace-match "") - (let ((end (save-excursion - (if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t) - (match-beginning 0) (point-max))))) - (setq footnote (concat (org-trim (buffer-substring (point) end)) - " ")) ; prevent last } being part of a link - (delete-region (point) end)) - (goto-char foot-beg) - (delete-region foot-beg foot-end) - (unless (null footnote) - (setq footnote-rpl (format "\\footnote{%s}" footnote)) - (add-text-properties 0 10 '(org-protected t) footnote-rpl) - (add-text-properties (1- (length footnote-rpl)) - (length footnote-rpl) - '(org-protected t) footnote-rpl) - (if (org-on-heading-p) - (setq footnote-rpl - (concat (org-export-latex-protect-string "\\protect") - footnote-rpl))) - (insert footnote-rpl))) - ))))) - - ;; Remove footnote section tag for LaTeX - (goto-char (point-min)) - (while (re-search-forward - (concat "^" footnote-section-tag-regexp) nil t) - (org-if-unprotected - (replace-match ""))))) + (replace-match "")))) (defun org-export-latex-fix-inputenc () "Set the coding system in inputenc to what the buffer is." @@ -2368,22 +2547,38 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defun org-export-latex-lists () "Convert plain text lists in current buffer into LaTeX lists." - (let (res) - (goto-char (point-min)) - (while (org-search-forward-unenclosed org-item-beginning-re nil t) - (beginning-of-line) - (setq res (org-list-to-latex (org-list-parse-list t) - org-export-latex-list-parameters)) - (while (string-match "^\\(\\\\item[ \t]+\\)\\[@\\(?:start:\\)?\\([0-9]+\\)\\]" - res) - (setq res (replace-match - (concat (format "\\setcounter{enumi}{%d}" - (1- (string-to-number - (match-string 2 res)))) - "\n" - (match-string 1 res)) - t t res))) - (insert res)))) + ;; `org-list-end-re' output has changed since preprocess from + ;; org-exp.el. Make sure it is taken into account. + (let ((org-list-ending-method + (if (eq org-list-ending-method 'regexp) 'regexp 'both)) + (org-list-end-re "^ORG-LIST-END-MARKER\n")) + (mapc + (lambda (e) + ;; For each type of context allowed for list export (E), find + ;; every list, parse it, delete it and insert resulting + ;; conversion to latex (RES), while keeping the same + ;; `original-indentation' property. + (let (res) + (goto-char (point-min)) + (while (re-search-forward (org-item-beginning-re) nil t) + (when (and (eq (get-text-property (point) 'list-context) e) + (not (get-text-property (point) 'org-example))) + (beginning-of-line) + (setq res + (org-list-to-latex + ;; Narrowing is needed because we're converting + ;; from inner functions to outer ones. + (save-restriction + (narrow-to-region (point) (point-max)) + (org-list-parse-list t)) + org-export-latex-list-parameters)) + ;; Extend previous value of original-indentation to the + ;; whole string + (insert (org-add-props res nil 'original-indentation + (org-find-text-property-in-string + 'original-indentation res))))))) + ;; List of allowed contexts for export, and the default one. + (append org-list-export-context '(nil))))) (defconst org-latex-entities '("\\!" @@ -2402,6 +2597,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\Styles" "\\\\" "\\`" + "\\\"" "\\addcontentsline" "\\address" "\\addtocontents" @@ -2573,5 +2769,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (provide 'org-export-latex) (provide 'org-latex) +;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad ;;; org-latex.el ends here diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 08c733acc6f..2339c4d1bc1 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -1,12 +1,13 @@ ;;; org-list.el --- Plain lists for Org-mode ;; -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Bastien Guerry <bzg AT altern DOT org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -28,42 +29,107 @@ ;; This file contains the code dealing with plain lists in Org-mode. +;; The fundamental idea behind lists work is to use structures. +;; A structure is a snapshot of the list, in the shape of data tree +;; (see `org-list-struct'). + +;; Once the list structure is stored, it is possible to make changes +;; directly on it or get useful information about the list, with the +;; two helper functions, namely `org-list-parents-alist' and +;; `org-list-prevs-alist', and using accessors or methods. + +;; Structure is eventually applied to the buffer with +;; `org-list-write-struct'. This function repairs (bullets, +;; indentation, checkboxes) the structure before applying it. It +;; should be called near the end of any function working on +;; structures. + +;; Thus, a function applying to lists should usually follow this +;; template: + +;; 1. Verify point is in a list and grab item beginning (with the same +;; function `org-in-item-p'). If the function requires the cursor +;; to be at item's bullet, `org-at-item-p' is more selective. If +;; the cursor is amidst the buffer, it is possible to find the +;; closest item with `org-list-search-backward', or +;; `org-list-search-forward', applied to `org-item-beginning-re'. + +;; 2. Get list structure with `org-list-struct'. + +;; 3. Compute one, or both, helper functions, +;; (`org-list-parents-alist', `org-list-prevs-alist') depending on +;; needed accessors. + +;; 4. Proceed with the modifications, using methods and accessors. + +;; 5. Verify and apply structure to buffer, using +;; `org-list-write-struct'. Possibly use +;; `org-update-checkbox-count-maybe' if checkboxes might have been +;; modified. + +;; Computing a list structure can be a costly operation on huge lists +;; (a few thousand lines long). Thus, code should follow the rule : +;; "collect once, use many". As a corollary, it is usally a bad idea +;; to use directly an interactive function inside the code, as those, +;; being independant entities, read the whole list structure another +;; time. + ;;; Code: -(eval-when-compile +(eval-when-compile (require 'cl)) (require 'org-macs) (require 'org-compat) -(defvar org-blank-before-new-entry) (defvar org-M-RET-may-split-line) -(defvar org-complex-heading-regexp) +(defvar org-auto-align-tags) +(defvar org-blank-before-new-entry) +(defvar org-clock-string) +(defvar org-closed-string) +(defvar org-deadline-string) +(defvar org-description-max-indent) +(defvar org-drawers) (defvar org-odd-levels-only) -(defvar org-outline-regexp) +(defvar org-scheduled-string) (defvar org-ts-regexp) (defvar org-ts-regexp-both) -(declare-function org-invisible-p "org" ()) -(declare-function org-on-heading-p "org" (&optional invisible-ok)) -(declare-function outline-next-heading "outline" ()) -(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-at-heading-p "org" (&optional ignored)) +(declare-function org-before-first-heading-p "org" ()) (declare-function org-back-over-empty-lines "org" ()) -(declare-function org-trim "org" (s)) -(declare-function org-get-indentation "org" (&optional line)) -(declare-function org-timer-item "org-timer" (&optional arg)) -(declare-function org-timer-hms-to-secs "org-timer" (hms)) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-combine-plists "org" (&rest plists)) +(declare-function org-count "org" (cl-item cl-seq)) +(declare-function org-current-level "org" ()) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-fix-tags-on-the-fly "org" ()) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-in-block-p "org" (names)) +(declare-function org-in-regexp "org" (re &optional nlines visually)) +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-goto-end "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) +(declare-function org-level-increment "org" ()) (declare-function org-narrow-to-subtree "org" ()) +(declare-function org-on-heading-p "org" (&optional invisible-ok)) +(declare-function org-previous-line-empty-p "org" ()) +(declare-function org-remove-if "org" (predicate seq)) +(declare-function org-reduced-level "org" (L)) (declare-function org-show-subtree "org" ()) -(declare-function org-in-regexps-block-p "org" - (start-re end-re &optional bound)) -(declare-function org-level-increment "org" ()) -(declare-function org-at-heading-p "org" (&optional ignored)) -(declare-function outline-previous-heading "outline" ()) -(declare-function org-icompleting-read "org" (&rest args)) (declare-function org-time-string-to-seconds "org" (s)) +(declare-function org-timer-hms-to-secs "org-timer" (hms)) +(declare-function org-timer-item "org-timer" (&optional arg)) +(declare-function org-trim "org" (s)) +(declare-function org-uniquify "org" (list)) +(declare-function outline-invisible-p "outline" (&optional pos)) +(declare-function outline-flag-region "outline" (from to flag)) +(declare-function outline-next-heading "outline" ()) +(declare-function outline-previous-heading "outline" ()) + +;;; Configuration variables (defgroup org-plain-lists nil "Options concerning plain lists in Org-mode." @@ -136,21 +202,26 @@ into (defcustom org-plain-list-ordered-item-terminator t "The character that makes a line with leading number an ordered list item. -Valid values are ?. and ?\). To get both terminators, use t. While -?. may look nicer, it creates the danger that a line with leading -number may be incorrectly interpreted as an item. ?\) therefore is -the safe choice." +Valid values are ?. and ?\). To get both terminators, use t." :group 'org-plain-lists :type '(choice (const :tag "dot like in \"2.\"" ?.) (const :tag "paren like in \"2)\"" ?\)) (const :tab "both" t))) +(defcustom org-alphabetical-lists nil + "Non-nil means single character alphabetical bullets are allowed. +Both uppercase and lowercase are handled. Lists with more than +26 items will fallback to standard numbering. Alphabetical +counters like \"[@c]\" will be recognized." + :group 'org-plain-lists + :type 'boolean) + (defcustom org-list-two-spaces-after-bullet-regexp nil "A regular expression matching bullets that should have 2 spaces after them. -When nil, no bullet will have two spaces after them. -When a string, it will be used as a regular expression. When the +When nil, no bullet will have two spaces after them. When +a string, it will be used as a regular expression. When the bullet type of a list is changed, the new bullet type will be -matched against this regexp. If it matches, there will be two +matched against this regexp. If it matches, there will be two spaces instead of one after the bullet in each item of the list." :group 'org-plain-lists :type '(choice @@ -163,15 +234,14 @@ Valid values are: `regexp', `indent' or `both'. When set to `regexp', Org will look into two variables, `org-empty-line-terminates-plain-lists' and the more general -`org-list-end-regexp', to determine what will end lists. This is -the fastest method. +`org-list-end-regexp', to determine what will end lists. When set to `indent', a list will end whenever a line following an item, but not starting one, is less or equally indented than -it. +the first item of the list. When set to `both', each of the preceding methods is applied to -determine lists endings. This is the default method." +determine lists endings. This is the default method." :group 'org-plain-lists :type '(choice (const :tag "With a regexp defining ending" regexp) @@ -181,7 +251,7 @@ determine lists endings. This is the default method." (defcustom org-empty-line-terminates-plain-lists nil "Non-nil means an empty line ends all plain list levels. This variable only makes sense if `org-list-ending-method' is set -to `regexp' or `both'. This is then equivalent to set +to `regexp' or `both'. This is then equivalent to set `org-list-end-regexp' to \"^[ \\t]*$\"." :group 'org-plain-lists :type 'boolean) @@ -196,15 +266,14 @@ precedence over it." (defcustom org-list-automatic-rules '((bullet . t) (checkbox . t) - (indent . t) - (insert . t)) + (indent . t)) "Non-nil means apply set of rules when acting on lists. By default, automatic actions are taken when using \\[org-meta-return], \\[org-metaright], \\[org-metaleft], \\[org-shiftmetaright], \\[org-shiftmetaleft], \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or \\[org-insert-todo-heading]. You can disable individually these - rules by setting them to nil. Valid rules are: + rules by setting them to nil. Valid rules are: bullet when non-nil, cycling bullet do not allow lists at column 0 to have * as a bullet and descriptions lists @@ -216,21 +285,36 @@ checkbox when non-nil, checkbox statistics is updated each time indent when non-nil, indenting or outdenting list top-item with its subtree will move the whole list and outdenting a list whose bullet is * to column 0 will - change that bullet to - -insert when non-nil, trying to insert an item inside a block - will insert it right before the block instead of - throwing an error." + change that bullet to \"-\"." :group 'org-plain-lists :type '(alist :tag "Sets of rules" :key-type (choice (const :tag "Bullet" bullet) (const :tag "Checkbox" checkbox) - (const :tag "Indent" indent) - (const :tag "Insert" insert)) + (const :tag "Indent" indent)) :value-type (boolean :tag "Activate" :value t))) +(defcustom org-list-use-circular-motion nil + "Non-nil means commands implying motion in lists should be cyclic. + +In that case, the item following the last item is the first one, +and the item preceding the first item is the last one. + +This affects the behavior of \\[org-move-item-up], + \\[org-move-item-down], \\[org-next-item] and + \\[org-previous-item]." + :group 'org-plain-lists + :type 'boolean) + +(defvar org-checkbox-statistics-hook nil + "Hook that is run whenever Org thinks checkbox statistics should be updated. +This hook runs even if checkbox rule in +`org-list-automatic-rules' does not apply, so it can be used to +implement alternative ways of collecting statistics +information.") + (defcustom org-hierarchical-checkbox-statistics t "Non-nil means checkbox statistics counts only the state of direct children. When nil, all boxes below the cookie are counted. @@ -246,6 +330,13 @@ When the indentation would be larger than this, it will become :group 'org-plain-lists :type 'integer) +(defcustom org-list-indent-offset 0 + "Additional indentation for sub-items in a list. +By setting this to a small number, usually 1 or 2, one can more +clearly distinguish sub-items in a list." + :group 'org-plain-lists + :type 'integer) + (defcustom org-list-radio-list-templates '((latex-mode "% BEGIN RECEIVE ORGLST %n % END RECEIVE ORGLST %n @@ -273,547 +364,151 @@ list, obtained by prompting the user." (list (symbol :tag "Major mode") (string :tag "Format")))) -;;; Internal functions - -(defun org-list-end-re () - "Return the regex corresponding to the end of a list. -It depends on `org-empty-line-terminates-plain-lists'." - (if org-empty-line-terminates-plain-lists - "^[ \t]*\n" - org-list-end-regexp)) - -(defun org-item-re (&optional general) - "Return the correct regular expression for plain lists. -If GENERAL is non-nil, return the general regexp independent of the value -of `org-plain-list-ordered-item-terminator'." - (cond - ((or general (eq org-plain-list-ordered-item-terminator t)) - "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") - ((= org-plain-list-ordered-item-terminator ?.) - "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") - ((= org-plain-list-ordered-item-terminator ?\)) - "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))) - -(defconst org-item-beginning-re (concat "^" (org-item-re)) - "Regexp matching the beginning of a plain list item.") - -(defun org-list-ending-between (min max &optional firstp) - "Find the position of a list ending between MIN and MAX, or nil. -This function looks for `org-list-end-re' outside a block. - -If FIRSTP in non-nil, return the point at the beginning of the -nearest valid terminator from MIN. Otherwise, return the point at -the end of the nearest terminator from MAX." - (save-excursion - (let* ((start (if firstp min max)) - (end (if firstp max min)) - (search-fun (if firstp - #'org-search-forward-unenclosed - #'org-search-backward-unenclosed)) - (list-end-p (progn - (goto-char start) - (funcall search-fun (org-list-end-re) end t)))) - ;; Is there a valid list ending somewhere ? - (and list-end-p - ;; we want to be on the first line of the list ender - (match-beginning 0))))) - -(defun org-list-maybe-skip-block (search limit) - "Return non-nil value if point is in a block, skipping it on the way. -It looks for the boundary of the block in SEARCH direction, -stopping at LIMIT." - (save-match-data - (let ((case-fold-search t) - (boundary (if (eq search 're-search-forward) 3 5))) - (when (save-excursion - (and (funcall search "^[ \t]*#\\+\\(begin\\|end\\)_" limit t) - (= (length (match-string 1)) boundary))) - ;; We're in a block: get out of it - (goto-char (match-beginning 0)))))) - -(defun org-list-search-unenclosed-generic (search re bound noerr) - "Search a string outside blocks and protected places. -Arguments SEARCH, RE, BOUND and NOERR are similar to those in -`search-forward', `search-backward', `re-search-forward' and -`re-search-backward'." - (catch 'exit - (let ((origin (point))) - (while t - ;; 1. No match: return to origin or bound, depending on NOERR. - (unless (funcall search re bound noerr) - (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound)) - nil))) - ;; 2. Match not in block or protected: return point. Else - ;; skip the block and carry on. - (unless (or (get-text-property (match-beginning 0) 'org-protected) - (org-list-maybe-skip-block search bound)) - (throw 'exit (point))))))) - -(defun org-search-backward-unenclosed (regexp &optional bound noerror) - "Like `re-search-backward' but don't stop inside blocks or protected places. -Arguments REGEXP, BOUND and NOERROR are similar to those used in -`re-search-backward'." - (org-list-search-unenclosed-generic - #'re-search-backward regexp (or bound (point-min)) noerror)) - -(defun org-search-forward-unenclosed (regexp &optional bound noerror) - "Like `re-search-forward' but don't stop inside blocks or protected places. -Arguments REGEXP, BOUND and NOERROR are similar to those used in -`re-search-forward'." - (org-list-search-unenclosed-generic - #'re-search-forward regexp (or bound (point-max)) noerror)) - -(defun org-list-in-item-p-with-indent (limit) - "Is the cursor inside a plain list? -Plain lists are considered ending when a non-blank line is less -indented than the previous item within LIMIT." - (save-excursion - (beginning-of-line) - (cond - ;; do not start searching inside a block... - ((org-list-maybe-skip-block #'re-search-backward limit)) - ;; ... or at a blank line - ((looking-at "^[ \t]*$") - (skip-chars-backward " \r\t\n") - (beginning-of-line))) - (beginning-of-line) - (or (org-at-item-p) - (let* ((case-fold-search t) - (ind-ref (org-get-indentation)) - ;; Ensure there is at least an item above - (up-item-p (save-excursion - (org-search-backward-unenclosed - org-item-beginning-re limit t)))) - (and up-item-p - (catch 'exit - (while t - (cond - ((org-at-item-p) - (throw 'exit (< (org-get-indentation) ind-ref))) - ((looking-at "^[ \t]*$") - (skip-chars-backward " \r\t\n") - (beginning-of-line)) - ((looking-at "^[ \t]*#\\+end_") - (re-search-backward "^[ \t]*#\\+begin_")) - (t - (setq ind-ref (min (org-get-indentation) ind-ref)) - (forward-line -1)))))))))) - -(defun org-list-in-item-p-with-regexp (limit) - "Is the cursor inside a plain list? -Plain lists end when `org-list-end-regexp' is matched, or at a -blank line if `org-empty-line-terminates-plain-lists' is true. - -Argument LIMIT specifies the upper-bound of the search." - (save-excursion - (let* ((actual-pos (goto-char (point-at-eol))) - ;; Moved to eol so current line can be matched by - ;; `org-item-re'. - (last-item-start (save-excursion - (org-search-backward-unenclosed - org-item-beginning-re limit t))) - (list-ender (org-list-ending-between - last-item-start actual-pos))) - ;; We are in a list when we are on an item line or when we can - ;; find an item before point and there is no valid list ender - ;; between it and the point. - (and last-item-start (not list-ender))))) - -(defun org-list-top-point-with-regexp (limit) - "Return point at the top level item in a list. -Argument LIMIT specifies the upper-bound of the search. - -List ending is determined by regexp. See -`org-list-ending-method'. for more information." - (save-excursion - (let ((pos (point-at-eol))) - ;; Is there some list above this one ? If so, go to its ending. - ;; Otherwise, go back to the heading above or bob. - (goto-char (or (org-list-ending-between limit pos) limit)) - ;; From there, search down our list. - (org-search-forward-unenclosed org-item-beginning-re pos t) - (point-at-bol)))) - -(defun org-list-bottom-point-with-regexp (limit) - "Return point just before list ending. -Argument LIMIT specifies the lower-bound of the search. - -List ending is determined by regexp. See -`org-list-ending-method'. for more information." - (save-excursion - (let ((pos (org-get-item-beginning))) - ;; The list ending is either first point matching - ;; `org-list-end-re', point at first white-line before next - ;; heading, or eob. - (or (org-list-ending-between (min pos limit) limit t) limit)))) - -(defun org-list-top-point-with-indent (limit) - "Return point at the top level in a list. -Argument LIMIT specifies the upper-bound of the search. - -List ending is determined by indentation of text. See -`org-list-ending-method'. for more information." - (save-excursion - (let ((case-fold-search t)) - (let ((item-ref (goto-char (org-get-item-beginning))) - (ind-ref 10000)) - (forward-line -1) - (catch 'exit - (while t - (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) - (org-get-indentation)))) - (cond - ((looking-at "^[ \t]*:END:") - (throw 'exit item-ref)) - ((<= (point) limit) - (throw 'exit - (if (and (org-at-item-p) (< ind ind-ref)) - (point-at-bol) - item-ref))) - ((looking-at "^[ \t]*$") - (skip-chars-backward " \r\t\n") - (beginning-of-line)) - ((looking-at "^[ \t]*#\\+end_") - (re-search-backward "^[ \t]*#\\+begin_")) - ((not (org-at-item-p)) - (setq ind-ref (min ind ind-ref)) - (forward-line -1)) - ((>= ind ind-ref) - (throw 'exit item-ref)) - (t - (setq item-ref (point-at-bol) ind-ref 10000) - (forward-line -1)))))))))) - -(defun org-list-bottom-point-with-indent (limit) - "Return point just before list ending or nil if not in a list. -Argument LIMIT specifies the lower-bound of the search. - -List ending is determined by the indentation of text. See -`org-list-ending-method' for more information." - (save-excursion - (let ((ind-ref (progn - (goto-char (org-get-item-beginning)) - (org-get-indentation))) - (case-fold-search t)) - ;; do not start inside a block - (org-list-maybe-skip-block #'re-search-forward limit) - (beginning-of-line) - (catch 'exit - (while t - (skip-chars-forward " \t") - (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) - (org-get-indentation)))) - (cond - ((or (>= (point) limit) - (looking-at ":END:")) - (throw 'exit (progn - ;; Ensure bottom is just after a - ;; non-blank line. - (skip-chars-backward " \r\t\n") - (min (point-max) (1+ (point-at-eol)))))) - ((= (point) (point-at-eol)) - (skip-chars-forward " \r\t\n") - (beginning-of-line)) - ((org-at-item-p) - (setq ind-ref ind) - (forward-line 1)) - ((<= ind ind-ref) - (throw 'exit (progn - ;; Again, ensure bottom is just after a - ;; non-blank line. - (skip-chars-backward " \r\t\n") - (min (point-max) (1+ (point-at-eol)))))) - ((looking-at "#\\+begin_") - (re-search-forward "[ \t]*#\\+end_") - (forward-line 1)) - (t (forward-line 1))))))))) +(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer" + "docbook" "html" "latex" "odt") + "Names of blocks where lists are not allowed. +Names must be in lower case.") + +(defvar org-list-export-context '(block inlinetask) + "Context types where lists will be interpreted during export. + +Valid types are `drawer', `inlinetask' and `block'. More +specifically, type `block' is determined by the variable +`org-list-forbidden-blocks'.") + + +;;; Predicates and regexps + +(defconst org-list-end-re (if org-empty-line-terminates-plain-lists + "^[ \t]*\n" + org-list-end-regexp) + "Regex corresponding to the end of a list. +It depends on `org-empty-line-terminates-plain-lists'.") + +(defconst org-list-full-item-re + (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" + "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" + "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?") + "Matches a list item and puts everything into groups: +group 1: bullet +group 2: counter +group 3: checkbox +group 4: description tag") + +(defun org-item-re () + "Return the correct regular expression for plain lists." + (let ((term (cond + ((eq org-plain-list-ordered-item-terminator t) "[.)]") + ((= org-plain-list-ordered-item-terminator ?\)) ")") + ((= org-plain-list-ordered-item-terminator ?.) "\\.") + (t "[.)]"))) + (alpha (if org-alphabetical-lists "\\|[A-Za-z]" ""))) + (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term + "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)"))) + +(defsubst org-item-beginning-re () + "Regexp matching the beginning of a plain list item." + (concat "^" (org-item-re))) (defun org-list-at-regexp-after-bullet-p (regexp) "Is point at a list item with REGEXP after bullet?" (and (org-at-item-p) (save-excursion (goto-char (match-end 0)) - ;; Ignore counter if any - (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") - (goto-char (match-end 0))) + (let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?" + (if org-alphabetical-lists + "\\([0-9]+\\|[A-Za-z]\\)" + "[0-9]+") + "\\][ \t]*\\)"))) + ;; Ignore counter if any + (when (looking-at counter-re) (goto-char (match-end 0)))) (looking-at regexp)))) -(defun org-list-get-item-same-level (search-fun pos limit pre-move) - "Return point at the beginning of next item at the same level. -Search items using function SEARCH-FUN, from POS to LIMIT. It -uses PRE-MOVE before search. Return nil if no item was found." - (save-excursion - (goto-char pos) - (let* ((start (org-get-item-beginning)) - (ind (progn (goto-char start) (org-get-indentation)))) - ;; We don't want to match the current line. - (funcall pre-move) - ;; Skip any sublist on the way - (while (and (funcall search-fun org-item-beginning-re limit t) - (> (org-get-indentation) ind))) - (when (and (/= (point-at-bol) start) ; Have we moved ? - (= (org-get-indentation) ind)) - (point-at-bol))))) - -(defun org-list-separating-blank-lines-number (pos top bottom) - "Return number of blank lines that should separate items in list. -POS is the position of point to be considered. - -TOP and BOTTOM are respectively position of list beginning and -list ending. - -Assume point is at item's beginning. If the item is alone, apply -some heuristics to guess the result." - (save-excursion - (let ((insert-blank-p - (cdr (assq 'plain-list-item org-blank-before-new-entry))) - usr-blank) - (cond - ;; Trivial cases where there should be none. - ((or (and (not (eq org-list-ending-method 'indent)) - org-empty-line-terminates-plain-lists) - (not insert-blank-p)) 0) - ;; When `org-blank-before-new-entry' says so, it is 1. - ((eq insert-blank-p t) 1) - ;; plain-list-item is 'auto. Count blank lines separating - ;; neighbours items in list. - (t (let ((next-p (org-get-next-item (point) bottom))) - (cond - ;; Is there a next item? - (next-p (goto-char next-p) - (org-back-over-empty-lines)) - ;; Is there a previous item? - ((org-get-previous-item (point) top) - (org-back-over-empty-lines)) - ;; User inserted blank lines, trust him - ((and (> pos (org-end-of-item-before-blank bottom)) - (> (save-excursion - (goto-char pos) - (skip-chars-backward " \t") - (setq usr-blank (org-back-over-empty-lines))) 0)) - usr-blank) - ;; Are there blank lines inside the item ? - ((save-excursion - (org-search-forward-unenclosed - "^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1) - ;; No parent: no blank line. - (t 0)))))))) - -(defun org-list-insert-item-generic (pos &optional checkbox after-bullet) - "Insert a new list item at POS. -If POS is before first character after bullet of the item, the -new item will be created before the current one. - -Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET -after the bullet. Cursor will be after this text once the -function ends." - (goto-char pos) - ;; Is point in a special block? - (when (org-in-regexps-block-p - "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" - '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) - (if (not (cdr (assq 'insert org-list-automatic-rules))) - ;; Rule in `org-list-automatic-rules' forbids insertion. - (error "Cannot insert item inside a block") - ;; Else, move before it prior to add a new item. - (end-of-line) - (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) - (end-of-line 0))) - (let* ((true-pos (point)) - (top (org-list-top-point)) - (bottom (copy-marker (org-list-bottom-point))) - (bullet (and (goto-char (org-get-item-beginning)) - (org-list-bullet-string (org-get-bullet)))) - (ind (org-get-indentation)) - (before-p (progn - ;; Description item: text starts after colons. - (or (org-at-item-description-p) - ;; At a checkbox: text starts after it. - (org-at-item-checkbox-p) - ;; Otherwise, text starts after bullet. - (org-at-item-p)) - (<= true-pos (match-end 0)))) - (blank-lines-nb (org-list-separating-blank-lines-number - true-pos top bottom)) - (insert-fun - (lambda (text) - ;; insert bullet above item in order to avoid bothering - ;; with possible blank lines ending last item. - (goto-char (org-get-item-beginning)) - (org-indent-to-column ind) - (insert (concat bullet (when checkbox "[ ] ") after-bullet)) - ;; Stay between after-bullet and before text. - (save-excursion - (insert (concat text (make-string (1+ blank-lines-nb) ?\n)))) - (unless before-p - ;; store bottom: exchanging items doesn't change list - ;; bottom point but will modify marker anyway - (setq bottom (marker-position bottom)) - (let ((col (current-column))) - (org-list-exchange-items - (org-get-item-beginning) (org-get-next-item (point) bottom) - bottom) - ;; recompute next-item: last sexp modified list - (goto-char (org-get-next-item (point) bottom)) - (org-move-to-column col))) - ;; checkbox update might modify bottom point, so use a - ;; marker here - (setq bottom (copy-marker bottom)) - (when checkbox (org-update-checkbox-count-maybe)) - (org-list-repair nil top bottom)))) - (goto-char true-pos) - (cond - (before-p (funcall insert-fun nil) t) - ;; Can't split item: insert bullet at the end of item. - ((not (org-get-alist-option org-M-RET-may-split-line 'item)) - (funcall insert-fun nil) t) - ;; else, insert a new bullet along with everything from point - ;; down to last non-blank line of item. - (t - (delete-horizontal-space) - ;; Get pos again in case previous command modified line. - (let* ((pos (point)) - (end-before-blank (org-end-of-item-before-blank bottom)) - (after-text - (when (< pos end-before-blank) - (prog1 - (delete-and-extract-region pos end-before-blank) - ;; delete any blank line at and before point. - (beginning-of-line) - (while (looking-at "^[ \t]*$") - (delete-region (point-at-bol) (1+ (point-at-eol))) - (beginning-of-line 0)))))) - (funcall insert-fun after-text) t))))) - -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) - -(defun org-list-indent-item-generic (arg no-subtree top bottom) - "Indent a local list item including its children. -When number ARG is a negative, item will be outdented, otherwise -it will be indented. - -If a region is active, all items inside will be moved. - -If NO-SUBTREE is non-nil, only indent the item itself, not its -children. - -TOP and BOTTOM are respectively position at item beginning and at -item ending. - -Return t if successful." - (let* ((regionp (org-region-active-p)) - (rbeg (and regionp (region-beginning))) - (rend (and regionp (region-end)))) - (cond - ((and regionp - (goto-char rbeg) - (not (org-search-forward-unenclosed org-item-beginning-re rend t))) - (error "No item in region")) - ((not (org-at-item-p)) - (error "Not on an item")) - (t - ;; Are we going to move the whole list? - (let* ((specialp (and (cdr (assq 'indent org-list-automatic-rules)) - (not no-subtree) - (= top (point-at-bol))))) - ;; Determine begin and end points of zone to indent. If moving - ;; more than one item, ensure we keep them on subsequent moves. - (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (memq this-command '(org-shiftmetaright org-shiftmetaleft))) - (if regionp - (progn - (set-marker org-last-indent-begin-marker rbeg) - (set-marker org-last-indent-end-marker rend)) - (set-marker org-last-indent-begin-marker (point-at-bol)) - (set-marker org-last-indent-end-marker - (save-excursion - (cond - (specialp bottom) - (no-subtree (org-end-of-item-or-at-child bottom)) - (t (org-get-end-of-item bottom))))))) - ;; Get everything ready - (let* ((beg (marker-position org-last-indent-begin-marker)) - (end (marker-position org-last-indent-end-marker)) - (struct (org-list-struct - beg end top (if specialp end bottom) (< arg 0))) - (origins (org-list-struct-origins struct)) - (beg-item (assq beg struct))) - (cond - ;; Special case: moving top-item with indent rule - (specialp - (let* ((level-skip (org-level-increment)) - (offset (if (< arg 0) (- level-skip) level-skip)) - (top-ind (nth 1 beg-item))) - (if (< (+ top-ind offset) 0) - (error "Cannot outdent beyond margin") - ;; Change bullet if necessary - (when (and (= (+ top-ind offset) 0) - (string-match "*" (nth 2 beg-item))) - (setcdr beg-item (list (nth 1 beg-item) - (org-list-bullet-string "-")))) - ;; Shift ancestor - (let ((anc (car struct))) - (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) - (org-list-struct-fix-struct struct origins) - (org-list-struct-apply-struct struct end)))) - ;; Forbidden move - ((and (< arg 0) - (or (and no-subtree - (not regionp) - (org-list-struct-get-child beg-item struct)) - (let ((last-item (save-excursion - (goto-char end) - (skip-chars-backward " \r\t\n") - (goto-char (org-get-item-beginning)) - (org-list-struct-assoc-at-point)))) - (org-list-struct-get-child last-item struct)))) - (error "Cannot outdent an item without its children")) - ;; Normal shifting - (t - (let* ((shifted-ori (if (< arg 0) - (org-list-struct-outdent beg end origins) - (org-list-struct-indent beg end origins struct)))) - (org-list-struct-fix-struct struct shifted-ori) - (org-list-struct-apply-struct struct bottom)))))))))) - -;;; Predicates +(defun org-list-in-valid-context-p () + "Is point in a context where lists are allowed?" + (not (org-in-block-p org-list-forbidden-blocks))) (defun org-in-item-p () - "Is the cursor inside a plain list? + "Return item beginning position when in a plain list, nil otherwise. This checks `org-list-ending-method'." - (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) - (let* ((prev-head (save-excursion (outline-previous-heading))) - (bound (if prev-head - (or (save-excursion - (let ((case-fold-search t)) - (re-search-backward "^[ \t]*:END:" prev-head t))) - prev-head) - (point-min)))) - (cond - ((eq org-list-ending-method 'regexp) - (org-list-in-item-p-with-regexp bound)) - ((eq org-list-ending-method 'indent) - (org-list-in-item-p-with-indent bound)) - (t (and (org-list-in-item-p-with-regexp bound) - (org-list-in-item-p-with-indent bound))))))) - -(defun org-list-first-item-p (top) - "Is this item the first item in a plain list? -Assume point is at an item. - -TOP is the position of list's top-item." (save-excursion (beginning-of-line) - (let ((ind (org-get-indentation))) - (or (not (org-search-backward-unenclosed org-item-beginning-re top t)) - (< (org-get-indentation) ind))))) + (let* ((case-fold-search t) + (context (org-list-context)) + (lim-up (car context)) + (drawers-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) + (item-re (org-item-re)) + ;; Indentation isn't meaningful when point starts at an empty + ;; line or an inline task. + (ind-ref (if (or (looking-at "^[ \t]*$") + (and inlinetask-re (looking-at inlinetask-re))) + 10000 + (org-get-indentation)))) + (cond + ((eq (nth 2 context) 'invalid) nil) + ((looking-at item-re) (point)) + (t + ;; Detect if cursor in amidst `org-list-end-re'. First, count + ;; number HL of hard lines it takes, then call `org-in-regexp' + ;; to compute its boundaries END-BOUNDS. When point is + ;; in-between, move cursor before regexp beginning. + (let ((hl 0) (i -1) end-bounds) + (when (and (not (eq org-list-ending-method 'indent)) + (progn + (while (setq i (string-match + "[\r\n]" org-list-end-re (1+ i))) + (setq hl (1+ hl))) + (setq end-bounds (org-in-regexp org-list-end-re hl))) + (>= (point) (car end-bounds)) + (< (point) (cdr end-bounds))) + (goto-char (car end-bounds)) + (forward-line -1))) + ;; Look for an item, less indented that reference line if + ;; `org-list-ending-method' isn't `regexp'. + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ;; This is exactly what we want. + ((and (looking-at item-re) + (or (< ind ind-ref) + (eq org-list-ending-method 'regexp))) + (throw 'exit (point))) + ;; At upper bound of search or looking at the end of a + ;; previous list: search is over. + ((<= (point) lim-up) (throw 'exit nil)) + ((and (not (eq org-list-ending-method 'indent)) + (looking-at org-list-end-re)) + (throw 'exit nil)) + ;; Skip blocks, drawers, inline-tasks, blank lines + ((and (looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) + ((and (looking-at "^[ \t]*:END:") + (re-search-backward drawers-re lim-up t)) + (beginning-of-line)) + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning) + (forward-line -1)) + ((looking-at "^[ \t]*$") (forward-line -1)) + ;; Text at column 0 cannot belong to a list: stop. + ((zerop ind) (throw 'exit nil)) + ;; Normal text less indented than reference line, take + ;; it as new reference. + ((< ind ind-ref) + (setq ind-ref ind) + (forward-line -1)) + (t (forward-line -1))))))))))) (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" (save-excursion - (beginning-of-line) (looking-at org-item-beginning-re))) + (beginning-of-line) + (and (looking-at (org-item-re)) (org-list-in-valid-context-p)))) (defun org-at-item-bullet-p () "Is point at the bullet of a plain list item?" @@ -834,795 +529,1631 @@ TOP is the position of list's top-item." "Is point at a line starting a plain-list item with a checklet?" (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) -(defun org-checkbox-blocked-p () - "Is the current checkbox blocked from for being checked now? -A checkbox is blocked if all of the following conditions are fulfilled: +(defun org-at-item-counter-p () + "Is point at a line starting a plain-list item with a counter?" + (and (org-at-item-p) + (looking-at org-list-full-item-re) + (match-string 2))) -1. The checkbox is not checked already. -2. The current entry has the ORDERED property set. -3. There is an unchecked checkbox in this entry before the current line." - (catch 'exit - (save-match-data - (save-excursion - (unless (org-at-item-checkbox-p) (throw 'exit nil)) - (when (equal (match-string 1) "[X]") - ;; the box is already checked! - (throw 'exit nil)) - (let ((end (point-at-bol))) - (condition-case nil (org-back-to-heading t) - (error (throw 'exit nil))) - (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) - (when (org-search-forward-unenclosed - "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t) - (org-current-line))))))) - -;;; Navigate - -;; Every interactive navigation function is derived from a -;; non-interactive one, which doesn't move point, assumes point is -;; already in a list and doesn't compute list boundaries. - -;; If you plan to use more than one org-list function is some code, -;; you should therefore first check if point is in a list with -;; `org-in-item-p' or `org-at-item-p', then compute list boundaries -;; with `org-list-top-point' and `org-list-bottom-point', and make use -;; of non-interactive forms. - -(defun org-list-top-point () - "Return point at the top level in a list. -Assume point is in a list." - (let* ((prev-head (save-excursion (outline-previous-heading))) - (bound (if prev-head - (or (save-excursion - (let ((case-fold-search t)) - (re-search-backward "^[ \t]*:END:" prev-head t))) - prev-head) - (point-min)))) - (cond - ((eq org-list-ending-method 'regexp) - (org-list-top-point-with-regexp bound)) - ((eq org-list-ending-method 'indent) - (org-list-top-point-with-indent bound)) - (t (let ((top-re (org-list-top-point-with-regexp bound))) - (org-list-top-point-with-indent (or top-re bound))))))) - -(defun org-list-bottom-point () - "Return point just before list ending. -Assume point is in a list." - (let* ((next-head (save-excursion - (and (let ((outline-regexp org-outline-regexp)) - ;; Use default regexp because folding - ;; changes OUTLINE-REGEXP. - (outline-next-heading))))) - (limit (or (save-excursion - (and (re-search-forward "^[ \t]*:END:" next-head t) - (point-at-bol))) - next-head - (point-max)))) - (cond - ((eq org-list-ending-method 'regexp) - (org-list-bottom-point-with-regexp limit)) - ((eq org-list-ending-method 'indent) - (org-list-bottom-point-with-indent limit)) - (t (let ((bottom-re (org-list-bottom-point-with-regexp limit))) - (org-list-bottom-point-with-indent (or bottom-re limit))))))) - -(defun org-get-item-beginning () - "Return position of current item beginning." - (save-excursion - ;; possibly match current line - (end-of-line) - (org-search-backward-unenclosed org-item-beginning-re nil t) - (point-at-bol))) -(defun org-beginning-of-item () - "Go to the beginning of the current hand-formatted item. -If the cursor is not in an item, throw an error." - (interactive) - (if (org-in-item-p) - (goto-char (org-get-item-beginning)) - (error "Not in an item"))) +;;; Structures and helper functions -(defun org-get-beginning-of-list (top) - "Return position of the first item of the current list or sublist. -TOP is the position at list beginning." - (save-excursion - (let (prev-p) - (while (setq prev-p (org-get-previous-item (point) top)) - (goto-char prev-p)) - (point-at-bol)))) +(defun org-list-context () + "Determine context, and its boundaries, around point. -(defun org-beginning-of-item-list () - "Go to the beginning item of the current list or sublist. -Return an error if not in a list." - (interactive) - (if (org-in-item-p) - (goto-char (org-get-beginning-of-list (org-list-top-point))) - (error "Not in an item"))) +Context will be a cell like (MIN MAX CONTEXT) where MIN and MAX +are boundaries and CONTEXT is a symbol among `drawer', `block', +`invalid', `inlinetask' and nil. -(defun org-get-end-of-list (bottom) - "Return position at the end of the current list or sublist. -BOTTOM is the position at list ending." +Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." + (save-match-data + (save-excursion + (org-with-limited-levels + (beginning-of-line) + (let ((case-fold-search t) (pos (point)) beg end context-type + ;; Get positions of surrounding headings. This is the + ;; default context. + (lim-up (or (save-excursion (and (ignore-errors (org-back-to-heading t)) + (point))) + (point-min))) + (lim-down (or (save-excursion (outline-next-heading)) (point-max)))) + ;; Is point inside a drawer? + (let ((end-re "^[ \t]*:END:") + ;; Can't use org-drawers-regexp as this function might + ;; be called in buffers not in Org mode. + (beg-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$"))) + (when (save-excursion + (and (not (looking-at beg-re)) + (not (looking-at end-re)) + (setq beg (and (re-search-backward beg-re lim-up t) + (1+ (point-at-eol)))) + (setq end (or (and (re-search-forward end-re lim-down t) + (1- (match-beginning 0))) + lim-down)) + (>= end pos))) + (setq lim-up beg lim-down end context-type 'drawer))) + ;; Is point strictly in a block, and of which type? + (let ((block-re "^[ \t]*#\\+\\(begin\\|end\\)_") type) + (when (save-excursion + (and (not (looking-at block-re)) + (setq beg (and (re-search-backward block-re lim-up t) + (1+ (point-at-eol)))) + (looking-at "^[ \t]*#\\+begin_\\(\\S-+\\)") + (setq type (downcase (match-string 1))) + (goto-char beg) + (setq end (or (and (re-search-forward block-re lim-down t) + (1- (point-at-bol))) + lim-down)) + (>= end pos) + (equal (downcase (match-string 1)) "end"))) + (setq lim-up beg lim-down end + context-type (if (member type org-list-forbidden-blocks) + 'invalid 'block)))) + ;; Is point in an inlinetask? + (when (and (featurep 'org-inlinetask) + (save-excursion + (let* ((beg-re (org-inlinetask-outline-regexp)) + (end-re (concat beg-re "END[ \t]*$"))) + (and (not (looking-at "^\\*+")) + (setq beg (and (re-search-backward beg-re lim-up t) + (1+ (point-at-eol)))) + (not (looking-at end-re)) + (setq end (and (re-search-forward end-re lim-down t) + (1- (match-beginning 0)))) + (> (point) pos))))) + (setq lim-up beg lim-down end context-type 'inlinetask)) + ;; Return context boundaries and type. + (list lim-up lim-down context-type)))))) + +(defun org-list-struct () + "Return structure of list at point. + +A list structure is an alist where key is point at item, and +values are: +1. indentation, +2. bullet with trailing whitespace, +3. bullet counter, if any, +4. checkbox, if any, +5. description tag, if any, +6. position at item end. + +Thus the following list, where numbers in parens are +point-at-bol: + +- [X] first item (1) + 1. sub-item 1 (18) + 5. [@5] sub-item 2 (34) + some other text belonging to first item (55) +- last item (97) + + tag :: description (109) + (131) + +will get the following structure: + +\(\(1 0 \"- \" nil \"[X]\" nil 97\) + \(18 2 \"1. \" nil nil nil 34\) + \(34 2 \"5. \" \"5\" nil nil 55\) + \(97 0 \"- \" nil nil nil 131\) + \(109 2 \"+ \" nil nil \"tag\" 131\) + +Assume point is at an item." (save-excursion - (goto-char (org-get-item-beginning)) - (let ((ind (org-get-indentation))) - (while (and (/= (point) bottom) - (>= (org-get-indentation) ind)) - (org-search-forward-unenclosed org-item-beginning-re bottom 'move)) - (if (= (point) bottom) bottom (point-at-bol))))) - -(defun org-end-of-item-list () - "Go to the end of the current list or sublist. -If the cursor in not in an item, throw an error." - (interactive) - (if (org-in-item-p) - (goto-char (org-get-end-of-list (org-list-bottom-point))) - (error "Not in an item"))) - -(defun org-get-end-of-item (bottom) - "Return position at the end of the current item. -BOTTOM is the position at list ending." - (or (org-get-next-item (point) bottom) - (org-get-end-of-list bottom))) + (beginning-of-line) + (let* ((case-fold-search t) + (context (org-list-context)) + (lim-up (car context)) + (lim-down (nth 1 context)) + (text-min-ind 10000) + (item-re (org-item-re)) + (drawers-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) + (beg-cell (cons (point) (org-get-indentation))) + ind itm-lst itm-lst-2 end-lst end-lst-2 struct + (assoc-at-point + (function + ;; Return association at point. + (lambda (ind) + (looking-at org-list-full-item-re) + (list (point) + ind + (match-string-no-properties 1) ; bullet + (match-string-no-properties 2) ; counter + (match-string-no-properties 3) ; checkbox + (match-string-no-properties 4))))) ; description tag + (end-before-blank + (function + ;; Ensure list ends at the first blank line. + (lambda () + (skip-chars-backward " \r\t\n") + (min (1+ (point-at-eol)) lim-down))))) + ;; 1. Read list from starting item to its beginning, and save + ;; top item position and indentation in BEG-CELL. Also store + ;; ending position of items in END-LST. + (save-excursion + (catch 'exit + (while t + (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) + (org-get-indentation)))) + (cond + ((<= (point) lim-up) + ;; At upward limit: if we ended at an item, store it, + ;; else dimiss useless data recorded above BEG-CELL. + ;; Jump to part 2. + (throw 'exit + (setq itm-lst + (if (or (not (looking-at item-re)) + (get-text-property (point) 'org-example)) + (memq (assq (car beg-cell) itm-lst) itm-lst) + (setq beg-cell (cons (point) ind)) + (cons (funcall assoc-at-point ind) itm-lst))))) + ;; At a verbatim block, go before its beginning. Move + ;; from eol to ensure `previous-single-property-change' + ;; will return a value. + ((get-text-property (point) 'org-example) + (goto-char (previous-single-property-change + (point-at-eol) 'org-example nil lim-up)) + (forward-line -1)) + ;; Looking at a list ending regexp. Dismiss useless + ;; data recorded above BEG-CELL. Jump to part 2. + ((and (not (eq org-list-ending-method 'indent)) + (looking-at org-list-end-re)) + (throw 'exit + (setq itm-lst + (memq (assq (car beg-cell) itm-lst) itm-lst)))) + ;; Point is at an item. Add data to ITM-LST. It may + ;; also end a previous item: save it in END-LST. If + ;; ind is less or equal than BEG-CELL and there is no + ;; end at this ind or lesser, this item becomes the new + ;; BEG-CELL. + ((looking-at item-re) + (push (funcall assoc-at-point ind) itm-lst) + (push (cons ind (point)) end-lst) + (when (or (and (eq org-list-ending-method 'regexp) + (<= ind (cdr beg-cell))) + (< ind text-min-ind)) + (setq beg-cell (cons (point) ind))) + (forward-line -1)) + ;; Skip blocks, drawers, inline tasks, blank lines. + ((and (looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) + ((and (looking-at "^[ \t]*:END:") + (re-search-backward drawers-re lim-up t)) + (beginning-of-line)) + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning) + (forward-line -1)) + ((looking-at "^[ \t]*$") + (forward-line -1)) + ;; From there, point is not at an item. Unless ending + ;; method is `regexp', interpret line's indentation: + ;; - text at column 0 is necessarily out of any list. + ;; Dismiss data recorded above BEG-CELL. Jump to + ;; part 2. + ;; - any other case may be an ending position for an + ;; hypothetical item above. Store it and proceed. + ((eq org-list-ending-method 'regexp) (forward-line -1)) + ((zerop ind) + (throw 'exit + (setq itm-lst + (memq (assq (car beg-cell) itm-lst) itm-lst)))) + (t + (when (< ind text-min-ind) (setq text-min-ind ind)) + (push (cons ind (point)) end-lst) + (forward-line -1))))))) + ;; 2. Read list from starting point to its end, that is until we + ;; get out of context, or that a non-item line is less or + ;; equally indented than BEG-CELL's cdr. Also, store ending + ;; position of items in END-LST-2. + (catch 'exit + (while t + (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) + (org-get-indentation)))) + (cond + ((>= (point) lim-down) + ;; At downward limit: this is de facto the end of the + ;; list. Save point as an ending position, and jump to + ;; part 3. + (throw 'exit + (push (cons 0 (funcall end-before-blank)) end-lst-2))) + ;; At a verbatim block, move to its end. Point is at bol + ;; and 'org-example property is set by whole lines: + ;; `next-single-property-change' always return a value. + ((get-text-property (point) 'org-example) + (goto-char + (next-single-property-change (point) 'org-example nil lim-down))) + ;; Looking at a list ending regexp. Save point as an + ;; ending position and jump to part 3. + ((and (not (eq org-list-ending-method 'indent)) + (looking-at org-list-end-re)) + (throw 'exit (push (cons 0 (point)) end-lst-2))) + ((looking-at item-re) + ;; Point is at an item. Add data to ITM-LST-2. It may + ;; also end a previous item, so save it in END-LST-2. + (push (funcall assoc-at-point ind) itm-lst-2) + (push (cons ind (point)) end-lst-2) + (forward-line 1)) + ;; Skip inline tasks and blank lines along the way + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-end)) + ((looking-at "^[ \t]*$") + (forward-line 1)) + ;; Ind is lesser or equal than BEG-CELL's. The list is + ;; over: store point as an ending position and jump to + ;; part 3. + ((and (not (eq org-list-ending-method 'regexp)) + (<= ind (cdr beg-cell))) + (throw 'exit + (push (cons 0 (funcall end-before-blank)) end-lst-2))) + ;; Else, if ind is lesser or equal than previous item's, + ;; this is an ending position: store it. In any case, + ;; skip block or drawer at point, and move to next line. + (t + (when (and (not (eq org-list-ending-method 'regexp)) + (<= ind (nth 1 (car itm-lst-2)))) + (push (cons ind (point)) end-lst-2)) + (cond + ((and (looking-at "^[ \t]*#\\+begin_") + (re-search-forward "^[ \t]*#\\+end_" lim-down t))) + ((and (looking-at drawers-re) + (re-search-forward "^[ \t]*:END:" lim-down t)))) + (forward-line 1)))))) + (setq struct (append itm-lst (cdr (nreverse itm-lst-2))) + end-lst (append end-lst (cdr (nreverse end-lst-2)))) + ;; 3. Correct ill-formed lists by ensuring top item is the least + ;; indented. + (let ((min-ind (nth 1 (car struct)))) + (mapc (lambda (item) + (let ((ind (nth 1 item)) + (bul (nth 2 item))) + (when (< ind min-ind) + (setcar (cdr item) min-ind) + ;; Trim bullet so item will be seen as different + ;; when compared with repaired version. + (setcar (nthcdr 2 item) (org-trim bul))))) + struct)) + ;; 4. Associate each item to its end pos. + (org-list-struct-assoc-end struct end-lst) + ;; 5. Return STRUCT + struct))) + +(defun org-list-struct-assoc-end (struct end-list) + "Associate proper ending point to items in STRUCT. + +END-LIST is a pseudo-alist where car is indentation and cdr is +ending position. -(defun org-end-of-item () - "Go to the end of the current hand-formatted item. -If the cursor is not in an item, throw an error." - (interactive) - (if (org-in-item-p) - (goto-char (org-get-end-of-item (org-list-bottom-point))) - (error "Not in an item"))) - -(defun org-end-of-item-or-at-child (bottom) - "Move to the end of the item, stops before the first child if any. -BOTTOM is the position at list ending." - (end-of-line) - (goto-char - (if (org-search-forward-unenclosed org-item-beginning-re bottom t) - (point-at-bol) - (org-get-end-of-item bottom)))) - -(defun org-end-of-item-before-blank (bottom) - "Return point at end of item, before any blank line. -Point returned is at eol. - -BOTTOM is the position at list ending." +This function modifies STRUCT." + (let ((endings end-list)) + (mapc + (lambda (elt) + (let ((pos (car elt)) + (ind (nth 1 elt))) + ;; Remove end candidates behind current item. + (while (or (<= (cdar endings) pos)) + (pop endings)) + ;; Add end position to item assoc. + (let ((old-end (nthcdr 6 elt)) + (new-end (assoc-default ind endings '<=))) + (if old-end + (setcar old-end new-end) + (setcdr elt (append (cdr elt) (list new-end))))))) + struct))) + +(defun org-list-prevs-alist (struct) + "Return alist between item and previous item in STRUCT." + (let ((item-end-alist (mapcar (lambda (e) (cons (car e) (nth 6 e))) + struct))) + (mapcar (lambda (e) + (let ((prev (car (rassq (car e) item-end-alist)))) + (cons (car e) prev))) + struct))) + +(defun org-list-parents-alist (struct) + "Return alist between item and parent in STRUCT." + (let ((ind-to-ori (list (list (nth 1 (car struct))))) + (prev-pos (list (caar struct)))) + (cons prev-pos + (mapcar (lambda (item) + (let ((pos (car item)) + (ind (nth 1 item)) + (prev-ind (caar ind-to-ori))) + (push pos prev-pos) + (cond + ((> prev-ind ind) + (setq ind-to-ori + (member (assq ind ind-to-ori) ind-to-ori)) + (cons pos (cdar ind-to-ori))) + ((< prev-ind ind) + (let ((origin (nth 1 prev-pos))) + (push (cons ind origin) ind-to-ori) + (cons pos origin))) + (t (cons pos (cdar ind-to-ori)))))) + (cdr struct))))) + + +;;; Accessors + +(defsubst org-list-get-nth (n key struct) + "Return the Nth value of KEY in STRUCT." + (nth n (assq key struct))) + +(defun org-list-set-nth (n key struct new) + "Set the Nth value of KEY in STRUCT to NEW. +\nThis function modifies STRUCT." + (setcar (nthcdr n (assq key struct)) new)) + +(defsubst org-list-get-ind (item struct) + "Return indentation of ITEM in STRUCT." + (org-list-get-nth 1 item struct)) + +(defun org-list-set-ind (item struct ind) + "Set indentation of ITEM in STRUCT to IND. +\nThis function modifies STRUCT." + (org-list-set-nth 1 item struct ind)) + +(defsubst org-list-get-bullet (item struct) + "Return bullet of ITEM in STRUCT." + (org-list-get-nth 2 item struct)) + +(defun org-list-set-bullet (item struct bullet) + "Set bullet of ITEM in STRUCT to BULLET. +\nThis function modifies STRUCT." + (org-list-set-nth 2 item struct bullet)) + +(defsubst org-list-get-counter (item struct) + "Return counter of ITEM in STRUCT." + (org-list-get-nth 3 item struct)) + +(defsubst org-list-get-checkbox (item struct) + "Return checkbox of ITEM in STRUCT or nil." + (org-list-get-nth 4 item struct)) + +(defun org-list-set-checkbox (item struct checkbox) + "Set checkbox of ITEM in STRUCT to CHECKBOX. +\nThis function modifies STRUCT." + (org-list-set-nth 4 item struct checkbox)) + +(defsubst org-list-get-tag (item struct) + "Return end position of ITEM in STRUCT." + (org-list-get-nth 5 item struct)) + +(defun org-list-get-item-end (item struct) + "Return end position of ITEM in STRUCT." + (org-list-get-nth 6 item struct)) + +(defun org-list-get-item-end-before-blank (item struct) + "Return point at end of ITEM in STRUCT, before any blank line. +Point returned is at end of line." (save-excursion - (goto-char (org-get-end-of-item bottom)) + (goto-char (org-list-get-item-end item struct)) (skip-chars-backward " \r\t\n") (point-at-eol))) -(defun org-get-previous-item (pos limit) - "Return point of the previous item at the same level as POS. -Stop searching at LIMIT. Return nil if no item is found." - (org-list-get-item-same-level - #'org-search-backward-unenclosed pos limit #'beginning-of-line)) +(defun org-list-get-parent (item struct parents) + "Return parent of ITEM or nil. +STRUCT is the list structure. PARENTS is the alist of parents, +as returned by `org-list-parents-alist'." + (let ((parents (or parents (org-list-parents-alist struct)))) + (cdr (assq item parents)))) + +(defun org-list-has-child-p (item struct) + "Non-nil if ITEM has a child. + +STRUCT is the list structure. + +Value returned is the position of the first child of ITEM." + (let ((ind (org-list-get-ind item struct)) + (child-maybe (car (nth 1 (member (assq item struct) struct))))) + (when (and child-maybe + (< ind (org-list-get-ind child-maybe struct))) + child-maybe))) + +(defun org-list-get-next-item (item struct prevs) + "Return next item in same sub-list as ITEM, or nil. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (car (rassq item prevs))) + +(defun org-list-get-prev-item (item struct prevs) + "Return previous item in same sub-list as ITEM, or nil. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (cdr (assq item prevs))) + +(defun org-list-get-subtree (item struct) + "List all items having ITEM as a common ancestor, or nil. +STRUCT is the list structure." + (let* ((item-end (org-list-get-item-end item struct)) + (sub-struct (cdr (member (assq item struct) struct))) + subtree) + (catch 'exit + (mapc (lambda (e) + (let ((pos (car e))) + (if (< pos item-end) (push pos subtree) (throw 'exit nil)))) + sub-struct)) + (nreverse subtree))) + +(defun org-list-get-all-items (item struct prevs) + "List all items in the same sub-list as ITEM. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (let ((prev-item item) + (next-item item) + before-item after-item) + (while (setq prev-item (org-list-get-prev-item prev-item struct prevs)) + (push prev-item before-item)) + (while (setq next-item (org-list-get-next-item next-item struct prevs)) + (push next-item after-item)) + (append before-item (list item) (nreverse after-item)))) + +(defun org-list-get-children (item struct parents) + "List all children of ITEM, or nil. +STRUCT is the list structure. PARENTS is the alist of parents, as +returned by `org-list-parents-alist'." + (let (all child) + (while (setq child (car (rassq item parents))) + (setq parents (cdr (member (assq child parents) parents))) + (push child all)) + (nreverse all))) + +(defun org-list-get-top-point (struct) + "Return point at beginning of list. +STRUCT is the list structure." + (caar struct)) + +(defun org-list-get-bottom-point (struct) + "Return point at bottom of list. +STRUCT is the list structure." + (apply 'max + (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct))) + +(defun org-list-get-list-begin (item struct prevs) + "Return point at beginning of sub-list ITEM belongs. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (let ((first-item item) prev-item) + (while (setq prev-item (org-list-get-prev-item first-item struct prevs)) + (setq first-item prev-item)) + first-item)) + +(defalias 'org-list-get-first-item 'org-list-get-list-begin) + +(defun org-list-get-last-item (item struct prevs) + "Return point at last item of sub-list ITEM belongs. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (let ((last-item item) next-item) + (while (setq next-item (org-list-get-next-item last-item struct prevs)) + (setq last-item next-item)) + last-item)) + +(defun org-list-get-list-end (item struct prevs) + "Return point at end of sub-list ITEM belongs. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (org-list-get-item-end (org-list-get-last-item item struct prevs) struct)) + +(defun org-list-get-list-type (item struct prevs) + "Return the type of the list containing ITEM, as a symbol. + +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. + +Possible types are `descriptive', `ordered' and `unordered'. The +type is determined by the first item of the list." + (let ((first (org-list-get-list-begin item struct prevs))) + (cond + ((org-list-get-tag first struct) 'descriptive) + ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) + (t 'unordered)))) -(defun org-previous-item () - "Move to the beginning of the previous item. -Item is at the same level in the current plain list. Error if not -in a plain list, or if this is the first item in the list." - (interactive) - (if (not (org-in-item-p)) - (error "Not in an item") - (let ((prev-p (org-get-previous-item (point) (org-list-top-point)))) - (if prev-p (goto-char prev-p) (error "On first item"))))) -(defun org-get-next-item (pos limit) - "Return point of the next item at the same level as POS. -Stop searching at LIMIT. Return nil if no item is found." - (org-list-get-item-same-level - #'org-search-forward-unenclosed pos limit #'end-of-line)) +;;; Searching + +(defun org-list-search-generic (search re bound noerr) + "Search a string in valid contexts for lists. +Arguments SEARCH, RE, BOUND and NOERR are similar to those used +in `re-search-forward'." + (catch 'exit + (let ((origin (point))) + (while t + ;; 1. No match: return to origin or bound, depending on NOERR. + (unless (funcall search re bound noerr) + (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound)) + nil))) + ;; 2. Match in valid context: return point. Else, continue + ;; searching. + (when (org-list-in-valid-context-p) (throw 'exit (point))))))) + +(defun org-list-search-backward (regexp &optional bound noerror) + "Like `re-search-backward' but stop only where lists are recognized. +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-backward'." + (org-list-search-generic #'re-search-backward + regexp (or bound (point-min)) noerror)) + +(defun org-list-search-forward (regexp &optional bound noerror) + "Like `re-search-forward' but stop only where lists are recognized. +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-forward'." + (org-list-search-generic #'re-search-forward + regexp (or bound (point-max)) noerror)) -(defun org-next-item () - "Move to the beginning of the next item. -Item is at the same level in the current plain list. Error if not -in a plain list, or if this is the last item in the list." - (interactive) - (if (not (org-in-item-p)) - (error "Not in an item") - (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) - (if next-p (goto-char next-p) (error "On last item"))))) -;;; Manipulate +;;; Methods on structures -(defun org-list-exchange-items (beg-A beg-B bottom) - "Swap item starting at BEG-A with item starting at BEG-B. -Blank lines at the end of items are left in place. Assume BEG-A -is lesser than BEG-B. +(defsubst org-list-bullet-string (bullet) + "Return BULLET with the correct number of whitespaces. +It determines the number of whitespaces to append by looking at +`org-list-two-spaces-after-bullet-regexp'." + (save-match-data + (let ((spaces (if (and org-list-two-spaces-after-bullet-regexp + (string-match + org-list-two-spaces-after-bullet-regexp bullet)) + " " + " "))) + (string-match "\\S-+\\([ \t]*\\)" bullet) + (replace-match spaces nil nil bullet 1)))) + +(defun org-list-swap-items (beg-A beg-B struct) + "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. +Blank lines at the end of items are left in place. Return the +new structure after the changes. + +Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong +to the same sub-list. -BOTTOM is the position at list ending." +This function modifies STRUCT." (save-excursion - (let* ((end-of-item-no-blank - (lambda (pos) - (goto-char pos) - (goto-char (org-end-of-item-before-blank bottom)))) - (end-A-no-blank (funcall end-of-item-no-blank beg-A)) - (end-B-no-blank (funcall end-of-item-no-blank beg-B)) + (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct)) + (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) + (end-A (org-list-get-item-end beg-A struct)) + (end-B (org-list-get-item-end beg-B struct)) + (size-A (- end-A-no-blank beg-A)) + (size-B (- end-B-no-blank beg-B)) (body-A (buffer-substring beg-A end-A-no-blank)) (body-B (buffer-substring beg-B end-B-no-blank)) - (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))) + (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)) + (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) + (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))) + ;; 1. Move effectively items in buffer. (goto-char beg-A) (delete-region beg-A end-B-no-blank) - (insert (concat body-B between-A-no-blank-and-B body-A))))) + (insert (concat body-B between-A-no-blank-and-B body-A)) + ;; 2. Now modify struct. No need to re-read the list, the + ;; transformation is just a shift of positions. Some special + ;; attention is required for items ending at END-A and END-B + ;; as empty spaces are not moved there. In others words, + ;; item BEG-A will end with whitespaces that were at the end + ;; of BEG-B and the same applies to BEG-B. + (mapc (lambda (e) + (let ((pos (car e))) + (cond + ((< pos beg-A)) + ((memq pos sub-A) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) + (setcar (nthcdr 6 e) + (+ end-e (- end-B-no-blank end-A-no-blank))) + (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) + ((memq pos sub-B) + (let ((end-e (nth 6 e))) + (setcar e (- (+ pos beg-A) beg-B)) + (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) + (when (= end-e end-B) + (setcar (nthcdr 6 e) + (+ beg-A size-B (- end-A end-A-no-blank)))))) + ((< pos beg-B) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- size-B size-A))) + (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) + struct) + (sort struct (lambda (e1 e2) (< (car e1) (car e2))))))) + +(defun org-list-separating-blank-lines-number (pos struct prevs) + "Return number of blank lines that should separate items in list. -(defun org-move-item-down () - "Move the plain list item at point down, i.e. swap with following item. -Subitems (items with larger indentation) are considered part of the item, -so this really moves item trees." - (interactive) - (if (not (org-at-item-p)) - (error "Not at an item") - (let* ((pos (point)) - (col (current-column)) - (bottom (org-list-bottom-point)) - (actual-item (goto-char (org-get-item-beginning))) - (next-item (org-get-next-item (point) bottom))) - (if (not next-item) - (progn - (goto-char pos) - (error "Cannot move this item further down")) - (org-list-exchange-items actual-item next-item bottom) - (org-list-repair nil nil bottom) - (goto-char (org-get-next-item (point) bottom)) - (org-move-to-column col))))) +POS is the position of point where `org-list-insert-item' was called. -(defun org-move-item-up () - "Move the plain list item at point up, i.e. swap with previous item. -Subitems (items with larger indentation) are considered part of the item, -so this really moves item trees." - (interactive) - (if (not (org-at-item-p)) - (error "Not at an item") - (let* ((pos (point)) - (col (current-column)) - (top (org-list-top-point)) - (bottom (org-list-bottom-point)) - (actual-item (goto-char (org-get-item-beginning))) - (prev-item (org-get-previous-item (point) top))) - (if (not prev-item) - (progn - (goto-char pos) - (error "Cannot move this item further up")) - (org-list-exchange-items prev-item actual-item bottom) - (org-list-repair nil top bottom) - (org-move-to-column col))))) +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. -(defun org-insert-item (&optional checkbox) - "Insert a new item at the current level. -If cursor is before first character after bullet of the item, the -new item will be created before the current one. +Assume point is at item's beginning. If the item is alone, apply +some heuristics to guess the result." + (save-excursion + (let ((item (point)) + (insert-blank-p + (cdr (assq 'plain-list-item org-blank-before-new-entry))) + usr-blank) + (cond + ;; Trivial cases where there should be none. + ((or (and (not (eq org-list-ending-method 'indent)) + org-empty-line-terminates-plain-lists) + (not insert-blank-p)) 0) + ;; When `org-blank-before-new-entry' says so, it is 1. + ((eq insert-blank-p t) 1) + ;; `plain-list-item' is 'auto. Count blank lines separating + ;; neighbours items in list. + (t (let ((next-p (org-list-get-next-item item struct prevs))) + (cond + ;; Is there a next item? + (next-p (goto-char next-p) + (org-back-over-empty-lines)) + ;; Is there a previous item? + ((org-list-get-prev-item item struct prevs) + (org-back-over-empty-lines)) + ;; User inserted blank lines, trust him. + ((and (> pos (org-list-get-item-end-before-blank item struct)) + (> (save-excursion + (goto-char pos) + (skip-chars-backward " \t") + (setq usr-blank (org-back-over-empty-lines))) 0)) + usr-blank) + ;; Are there blank lines inside the list so far? + ((save-excursion + (goto-char (org-list-get-top-point struct)) + (org-list-search-forward + "^[ \t]*$" (org-list-get-item-end-before-blank item struct) t)) + 1) + ;; Default choice: no blank line. + (t 0)))))))) -If CHECKBOX is non-nil, add a checkbox next to the bullet. +(defun org-list-insert-item (pos struct prevs &optional checkbox after-bullet) + "Insert a new list item at POS and return the new structure. +If POS is before first character after bullet of the item, the +new item will be created before the current one. -Return t when things worked, nil when we are not in an item, or -item is invisible." - (unless (or (not (org-in-item-p)) - (save-excursion - (goto-char (org-get-item-beginning)) - (org-invisible-p))) - (if (save-excursion - (goto-char (org-get-item-beginning)) - (org-at-item-timer-p)) - ;; Timer list: delegate to `org-timer-item'. - (progn (org-timer-item) t) - ;; if we're in a description list, ask for the new term. - (let ((desc-text (when (save-excursion - (and (goto-char (org-get-item-beginning)) - (org-at-item-description-p))) - (concat (read-string "Term: ") " :: ")))) - ;; Don't insert a checkbox if checkbox rule is applied and it - ;; is a description item. - (org-list-insert-item-generic - (point) (and checkbox - (or (not desc-text) - (not (cdr (assq 'checkbox org-list-automatic-rules))))) - desc-text))))) - -;;; Structures - -;; The idea behind structures is to avoid moving back and forth in the -;; buffer on costly operations like indenting or fixing bullets. - -;; It achieves this by taking a snapshot of an interesting part of the -;; list, in the shape of an alist, using `org-list-struct'. - -;; It then proceeds to changes directly on the alist, with the help of -;; and `org-list-struct-origins'. When those are done, -;; `org-list-struct-apply-struct' applies the changes to the buffer. - -(defun org-list-struct-assoc-at-point () - "Return the structure association at point. -It is a cons-cell whose key is point and values are indentation, -bullet string and bullet counter, if any." - (save-excursion - (beginning-of-line) - (list (point-at-bol) - (org-get-indentation) - (progn - (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)") - (match-string 1)) - (progn - (goto-char (match-end 0)) - (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]") - (match-string 1)))))) - -(defun org-list-struct (begin end top bottom &optional outdent) - "Return the structure containing the list between BEGIN and END. -A structure is an alist where key is point of item and values -are, in that order, indentation, bullet string and value of -counter, if any. A structure contains every list and sublist that -has items between BEGIN and END along with their common ancestor. -If no such ancestor can be found, the function will add a virtual -ancestor at position 0. - -TOP and BOTTOM are respectively the position of list beginning -and list ending. - -If OUTDENT is non-nil, it will also grab all of the parent list -and the grand-parent. Setting OUTDENT to t is mandatory when next -change is an outdent." - (save-excursion - (let* (struct - (extend - (lambda (struct) - (let* ((ind-min (apply 'min (mapcar 'cadr struct))) - (begin (caar struct)) - (end (caar (last struct))) - pre-list post-list) - (goto-char begin) - ;; Find beginning of most outdented list (min list) - (while (and (org-search-backward-unenclosed - org-item-beginning-re top t) - (>= (org-get-indentation) ind-min)) - (setq pre-list (cons (org-list-struct-assoc-at-point) - pre-list))) - ;; Now get the parent. If none, add a virtual ancestor - (if (< (org-get-indentation) ind-min) - (setq pre-list (cons (org-list-struct-assoc-at-point) - pre-list)) - (setq pre-list (cons (list 0 (org-get-indentation) "" nil) - pre-list))) - ;; Find end of min list - (goto-char end) - (end-of-line) - (while (and (org-search-forward-unenclosed - org-item-beginning-re bottom 'move) - (>= (org-get-indentation) ind-min)) - (setq post-list (cons (org-list-struct-assoc-at-point) - post-list))) - ;; Is list is malformed? If some items are less - ;; indented that top-item, add them anyhow. - (when (and (= (caar pre-list) 0) (< (point) bottom)) - (beginning-of-line) - (while (org-search-forward-unenclosed - org-item-beginning-re bottom t) - (setq post-list (cons (org-list-struct-assoc-at-point) - post-list)))) - (append pre-list struct (reverse post-list)))))) - ;; Here we start: first get the core zone... - (goto-char end) - (while (org-search-backward-unenclosed org-item-beginning-re begin t) - (setq struct (cons (org-list-struct-assoc-at-point) struct))) - ;; ... then, extend it to make it a structure... - (let ((extended (funcall extend struct))) - ;; ... twice when OUTDENT is non-nil and struct still can be - ;; extended - (if (and outdent (> (caar extended) 0)) - (funcall extend extended) - extended))))) - -(defun org-list-struct-origins (struct) - "Return an alist where key is item's position and value parent's. -STRUCT is the list's structure looked up." - (let* ((struct-rev (reverse struct)) - (acc (list (cons (nth 1 (car struct)) 0))) - (prev-item (lambda (item) - (car (nth 1 (member (assq item struct) struct-rev))))) - (get-origins - (lambda (item) - (let* ((item-pos (car item)) - (ind (nth 1 item)) - (prev-ind (caar acc))) - (cond - ;; List closing. - ((> prev-ind ind) - (let ((current-origin (or (member (assq ind acc) acc) - ;; needed if top-point is - ;; not the most outdented - (last acc)))) - (setq acc current-origin) - (cons item-pos (cdar acc)))) - ;; New list - ((< prev-ind ind) - (let ((origin (funcall prev-item item-pos))) - (setq acc (cons (cons ind origin) acc)) - (cons item-pos origin))) - ;; Current list going on - (t (cons item-pos (cdar acc)))))))) - (cons '(0 . 0) (mapcar get-origins (cdr struct))))) - -(defun org-list-struct-get-parent (item struct origins) - "Return parent association of ITEM in STRUCT or nil. -ORIGINS is the alist of parents. See `org-list-struct-origins'." - (let* ((parent-pos (cdr (assq (car item) origins)))) - (when (> parent-pos 0) (assq parent-pos struct)))) - -(defun org-list-struct-get-child (item struct) - "Return child association of ITEM in STRUCT or nil." - (let ((ind (nth 1 item)) - (next-item (cadr (member item struct)))) - (when (and next-item (> (nth 1 next-item) ind)) next-item))) - -(defun org-list-struct-fix-bul (struct origins) - "Verify and correct bullets for every association in STRUCT. -ORIGINS is the alist of parents. See `org-list-struct-origins'. +STRUCT is the list structure. PREVS is the the alist of previous +items, as returned by `org-list-prevs-alist'. -This function modifies STRUCT." - (let* (acc - (init-bul (lambda (item) - (let ((counter (nth 3 item)) - (bullet (org-list-bullet-string (nth 2 item)))) - (cond - ((and (string-match "[0-9]+" bullet) counter) - (replace-match counter nil nil bullet)) - ((string-match "[0-9]+" bullet) - (replace-match "1" nil nil bullet)) - (t bullet))))) - (set-bul (lambda (item bullet) - (setcdr item (list (nth 1 item) bullet (nth 3 item))))) - (get-bul (lambda (item bullet) - (let* ((counter (nth 3 item))) - (if (and counter (string-match "[0-9]+" bullet)) - (replace-match counter nil nil bullet) - bullet)))) - (fix-bul - (lambda (item) struct - (let* ((parent (cdr (assq (car item) origins))) - (orig-ref (assq parent acc))) - (if orig-ref - ;; Continuing previous list - (let* ((prev-bul (cdr orig-ref)) - (new-bul (funcall get-bul item prev-bul))) - (setcdr orig-ref (org-list-inc-bullet-maybe new-bul)) - (funcall set-bul item new-bul)) - ;; A new list is starting - (let ((new-bul (funcall init-bul item))) - (funcall set-bul item new-bul) - (setq acc (cons (cons parent - (org-list-inc-bullet-maybe new-bul)) - acc)))))))) - (mapc fix-bul (cdr struct)))) - -(defun org-list-struct-fix-ind (struct origins) - "Verify and correct indentation for every association in STRUCT. -ORIGINS is the alist of parents. See `org-list-struct-origins'. +Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET +after the bullet. Cursor will be after this text once the +function ends. This function modifies STRUCT." - (let* ((headless (cdr struct)) - (ancestor (car struct)) - (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor)))) - (new-ind - (lambda (item) - (let* ((parent (org-list-struct-get-parent item headless origins))) - (if parent - ;; Indent like parent + length of parent's bullet - (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) - (cddr item))) - ;; If no parent, indent like top-point - (setcdr item (cons top-ind (cddr item)))))))) - (mapc new-ind headless))) - -(defun org-list-struct-fix-struct (struct origins) - "Return STRUCT with correct bullets and indentation. -ORIGINS is the alist of parents. See `org-list-struct-origins'. - -Only elements of STRUCT that have changed are returned." - (let ((old (copy-alist struct))) - (org-list-struct-fix-bul struct origins) - (org-list-struct-fix-ind struct origins) - (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct)))) - -(defun org-list-struct-outdent (start end origins) - "Outdent items in a structure. -Items are indented when their key is between START, included, and -END, excluded. - -ORIGINS is the alist of parents. See `org-list-struct-origins'. - -STRUCT is the concerned structure." + (let ((case-fold-search t)) + ;; 1. Get information about list: position of point with regards + ;; to item start (BEFOREP), blank lines number separating items + ;; (BLANK-NB), if we're allowed to (SPLIT-LINE-P). + (let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin)))) + (item-end (org-list-get-item-end item struct)) + (item-end-no-blank (org-list-get-item-end-before-blank item struct)) + (beforep (and (looking-at org-list-full-item-re) + (<= pos (match-end 0)))) + (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) + (blank-nb (org-list-separating-blank-lines-number + pos struct prevs)) + ;; 2. Build the new item to be created. Concatenate same + ;; bullet as item, checkbox, text AFTER-BULLET if + ;; provided, and text cut from point to end of item + ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on + ;; BEFOREP and SPLIT-LINE-P. The difference of size + ;; between what was cut and what was inserted in buffer + ;; is stored in SIZE-OFFSET. + (ind (org-list-get-ind item struct)) + (ind-size (if indent-tabs-mode + (+ (/ ind tab-width) (mod ind tab-width)) + ind)) + (bullet (org-list-bullet-string (org-list-get-bullet item struct))) + (box (when checkbox "[ ]")) + (text-cut + (and (not beforep) split-line-p + (progn + (goto-char pos) + ;; If POS is greater than ITEM-END, then point is + ;; in some white lines after the end of the list. + ;; Those must be removed, or they will be left, + ;; stacking up after the list. + (when (< item-end pos) + (delete-region (1- item-end) (point-at-eol))) + (skip-chars-backward " \r\t\n") + (setq pos (point)) + (delete-and-extract-region pos item-end-no-blank)))) + (body (concat bullet (when box (concat box " ")) after-bullet + (and text-cut + (if (string-match "\\`[ \t]+" text-cut) + (replace-match "" t t text-cut) + text-cut)))) + (item-sep (make-string (1+ blank-nb) ?\n)) + (item-size (+ ind-size (length body) (length item-sep))) + (size-offset (- item-size (length text-cut)))) + ;; 4. Insert effectively item into buffer. + (goto-char item) + (org-indent-to-column ind) + (insert body item-sep) + ;; 5. Add new item to STRUCT. + (mapc (lambda (e) + (let ((p (car e)) + (end (nth 6 e))) + (cond + ;; Before inserted item, positions don't change but + ;; an item ending after insertion has its end shifted + ;; by SIZE-OFFSET. + ((< p item) + (when (> end item) (setcar (nthcdr 6 e) (+ end size-offset)))) + ;; Trivial cases where current item isn't split in + ;; two. Just shift every item after new one by + ;; ITEM-SIZE. + ((or beforep (not split-line-p)) + (setcar e (+ p item-size)) + (setcar (nthcdr 6 e) (+ end item-size))) + ;; Item is split in two: elements before POS are just + ;; shifted by ITEM-SIZE. In the case item would end + ;; after split POS, ending is only shifted by + ;; SIZE-OFFSET. + ((< p pos) + (setcar e (+ p item-size)) + (if (< end pos) + (setcar (nthcdr 6 e) (+ end item-size)) + (setcar (nthcdr 6 e) (+ end size-offset)))) + ;; Elements after POS are moved into new item. + ;; Length of ITEM-SEP has to be removed as ITEM-SEP + ;; doesn't appear in buffer yet. + ((< p item-end) + (setcar e (+ p size-offset (- item pos (length item-sep)))) + (if (= end item-end) + (setcar (nthcdr 6 e) (+ item item-size)) + (setcar (nthcdr 6 e) + (+ end size-offset + (- item pos (length item-sep)))))) + ;; Elements at ITEM-END or after are only shifted by + ;; SIZE-OFFSET. + (t (setcar e (+ p size-offset)) + (setcar (nthcdr 6 e) (+ end size-offset)))))) + struct) + (push (list item ind bullet nil box nil (+ item item-size)) struct) + (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) + ;; 6. If not BEFOREP, new item must appear after ITEM, so + ;; exchange ITEM with the next item in list. Position cursor + ;; after bullet, counter, checkbox, and label. + (if beforep + (goto-char item) + (setq struct (org-list-swap-items item (+ item item-size) struct)) + (goto-char (org-list-get-next-item + item struct (org-list-prevs-alist struct)))) + struct))) + +(defun org-list-delete-item (item struct) + "Remove ITEM from the list and return the new structure. + +STRUCT is the list structure." + (let* ((end (org-list-get-item-end item struct)) + (beg (if (= (org-list-get-bottom-point struct) end) + ;; If ITEM ends with the list, delete blank lines + ;; before it. + (save-excursion + (goto-char item) + (skip-chars-backward " \r\t\n") + (min (1+ (point-at-eol)) (point-max))) + item))) + ;; Remove item from buffer. + (delete-region beg end) + ;; Remove item from structure and shift others items accordingly. + ;; Don't forget to shift also ending position when appropriate. + (let ((size (- end beg))) + (delq nil (mapcar (lambda (e) + (let ((pos (car e))) + (cond + ((< pos item) + (let ((end-e (nth 6 e))) + (cond + ((< end-e item) e) + ((= end-e item) + (append (butlast e) (list beg))) + (t + (append (butlast e) (list (- end-e size))))))) + ((< pos end) nil) + (t + (cons (- pos size) + (append (butlast (cdr e)) + (list (- (nth 6 e) size)))))))) + struct))))) + +(defun org-list-send-item (item dest struct) + "Send ITEM to destination DEST. + +STRUCT is the list structure. + +DEST can have various values. + +If DEST is a buffer position, the function will assume it points +to another item in the same list as ITEM, and will move the +latter just before the former. + +If DEST is `begin' \(resp. `end'\), ITEM will be moved at the +beginning \(resp. end\) of the list it belongs to. + +If DEST is a string like \"N\", where N is an integer, ITEM will +be moved at the Nth position in the list. + +If DEST is `kill', ITEM will be deleted and its body will be +added to the kill-ring. + +If DEST is `delete', ITEM will be deleted. + +This function returns, destructively, the new list structure." + (let* ((prevs (org-list-prevs-alist struct)) + (item-end (org-list-get-item-end item struct)) + ;; Grab full item body minus its bullet. + (body (org-trim + (buffer-substring + (save-excursion + (goto-char item) + (looking-at + (concat "[ \t]*" + (regexp-quote (org-list-get-bullet item struct)))) + (match-end 0)) + item-end))) + ;; Change DEST into a buffer position. A trick is needed + ;; when ITEM is meant to be sent at the end of the list. + ;; Indeed, by setting locally `org-M-RET-may-split-line' to + ;; nil and insertion point (INS-POINT) to the first line's + ;; end of the last item, we ensure the new item will be + ;; inserted after the last item, and not after any of its + ;; hypothetical sub-items. + (ins-point (cond + ((or (eq dest 'kill) (eq dest 'delete))) + ((eq dest 'begin) + (setq dest (org-list-get-list-begin item struct prevs))) + ((eq dest 'end) + (setq dest (org-list-get-list-end item struct prevs)) + (save-excursion + (goto-char (org-list-get-last-item item struct prevs)) + (point-at-eol))) + ((string-match "\\`[0-9]+\\'" dest) + (let* ((all (org-list-get-all-items item struct prevs)) + (len (length all)) + (index (mod (string-to-number dest) len))) + (if (not (zerop index)) + (setq dest (nth (1- index) all)) + ;; Send ITEM at the end of the list. + (setq dest (org-list-get-list-end item struct prevs)) + (save-excursion + (goto-char + (org-list-get-last-item item struct prevs)) + (point-at-eol))))) + (t dest))) + (org-M-RET-may-split-line nil)) + (cond + ((eq dest 'delete) (org-list-delete-item item struct)) + ((eq dest 'kill) + (kill-new body) + (org-list-delete-item item struct)) + ((and (integerp dest) (/= item ins-point)) + (setq item (copy-marker item)) + (setq struct (org-list-insert-item ins-point struct prevs nil body)) + ;; 1. Structure returned by `org-list-insert-item' may not be + ;; accurate, as it cannot see sub-items included in BODY. + ;; Thus, first compute the real structure so far. + (let ((moved-items + (cons (marker-position item) + (org-list-get-subtree (marker-position item) struct))) + (new-end (org-list-get-item-end (point) struct)) + (old-end (org-list-get-item-end (marker-position item) struct)) + (new-item (point)) + (shift (- (point) item))) + ;; 1.1. Remove the item just created in structure. + (setq struct (delete (assq new-item struct) struct)) + ;; 1.2. Copy ITEM and any of its sub-items at NEW-ITEM. + (setq struct (sort* + (append + struct + (mapcar (lambda (e) + (let* ((cell (assq e struct)) + (pos (car cell)) + (end (nth 6 cell))) + (cons (+ pos shift) + (append (butlast (cdr cell)) + (list (if (= end old-end) + new-end + (+ end shift))))))) + moved-items)) + (lambda (e1 e2) (< (car e1) (car e2)))))) + ;; 2. Eventually delete extra copy of the item and clean marker. + (prog1 + (org-list-delete-item (marker-position item) struct) + (move-marker item nil))) + (t struct)))) + +(defun org-list-struct-outdent (start end struct parents) + "Outdent items between positions START and END. + +STRUCT is the list structure. PARENTS is the alist of items' +parents, as returned by `org-list-parents-alist'. + +START is included, END excluded." (let* (acc (out (lambda (cell) (let* ((item (car cell)) (parent (cdr cell))) (cond - ;; Item not yet in zone: keep association + ;; Item not yet in zone: keep association. ((< item start) cell) - ;; Item out of zone: follow associations in acc + ;; Item out of zone: follow associations in ACC. ((>= item end) - (let ((convert (assq parent acc))) + (let ((convert (and parent (assq parent acc)))) (if convert (cons item (cdr convert)) cell))) ;; Item has no parent: error - ((<= parent 0) + ((not parent) (error "Cannot outdent top-level items")) - ;; Parent is outdented: keep association + ;; Parent is outdented: keep association. ((>= parent start) - (setq acc (cons (cons parent item) acc)) cell) + (push (cons parent item) acc) cell) (t - ;; Parent isn't outdented: reparent to grand-parent - (let ((grand-parent (cdr (assq parent origins)))) - (setq acc (cons (cons parent item) acc)) + ;; Parent isn't outdented: reparent to grand-parent. + (let ((grand-parent (org-list-get-parent + parent struct parents))) + (push (cons parent item) acc) (cons item grand-parent)))))))) - (mapcar out origins))) + (mapcar out parents))) + +(defun org-list-struct-indent (start end struct parents prevs) + "Indent items between positions START and END. -(defun org-list-struct-indent (start end origins struct) - "Indent items in a structure. -Items are indented when their key is between START, included, and -END, excluded. +STRUCT is the list structure. PARENTS is the alist of parents +and PREVS is the alist of previous items, returned by, +respectively, `org-list-parents-alist' and +`org-list-prevs-alist'. -ORIGINS is the alist of parents. See `org-list-struct-origins'. +START is included and END excluded. -STRUCT is the concerned structure. It may be modified if -`org-list-demote-modify-bullet' matches bullets between START and -END." +STRUCT may be modified if `org-list-demote-modify-bullet' matches +bullets between START and END." (let* (acc - (orig-rev (reverse origins)) - (get-prev-item - (lambda (cell parent) - (car (rassq parent (cdr (memq cell orig-rev)))))) - (set-assoc - (lambda (cell) - (setq acc (cons cell acc)) cell)) + (set-assoc (lambda (cell) (push cell acc) cell)) (change-bullet-maybe - (lambda (item) - (let* ((full-item (assq item struct)) - (item-bul (org-trim (nth 2 full-item))) - (new-bul-p (cdr (assoc item-bul org-list-demote-modify-bullet)))) - (when new-bul-p - ;; new bullet is stored without space to ensure item - ;; will be modified - (setcdr full-item - (list (nth 1 full-item) - new-bul-p - (nth 3 full-item))))))) + (function + (lambda (item) + (let* ((bul (org-trim (org-list-get-bullet item struct))) + (new-bul-p (cdr (assoc bul org-list-demote-modify-bullet)))) + (when new-bul-p (org-list-set-bullet item struct new-bul-p)))))) (ind (lambda (cell) (let* ((item (car cell)) (parent (cdr cell))) (cond - ;; Item not yet in zone: keep association + ;; Item not yet in zone: keep association. ((< item start) cell) ((>= item end) - ;; Item out of zone: follow associations in acc + ;; Item out of zone: follow associations in ACC. (let ((convert (assq parent acc))) (if convert (cons item (cdr convert)) cell))) (t ;; Item is in zone... - (let ((prev (funcall get-prev-item cell parent))) - ;; Check if bullet needs to be changed + (let ((prev (org-list-get-prev-item item struct prevs))) + ;; Check if bullet needs to be changed. (funcall change-bullet-maybe item) (cond ;; First item indented but not parent: error - ((and (or (not prev) (= prev 0)) (< parent start)) + ((and (not prev) (< parent start)) (error "Cannot indent the first item of a list")) - ;; First item and parent indented: keep same parent - ((or (not prev) (= prev 0)) - (funcall set-assoc cell)) - ;; Previous item not indented: reparent to it - ((< prev start) - (funcall set-assoc (cons item prev))) - ;; Previous item indented: reparent like it + ;; First item and parent indented: keep same + ;; parent. + ((not prev) (funcall set-assoc cell)) + ;; Previous item not indented: reparent to it. + ((< prev start) (funcall set-assoc (cons item prev))) + ;; Previous item indented: reparent like it. (t - (funcall set-assoc (cons item - (cdr (assq prev acc))))))))))))) - (mapcar ind origins))) - -(defun org-list-struct-apply-struct (struct bottom) - "Apply modifications to list so it mirrors STRUCT. -BOTTOM is position at list ending. - -Initial position is restored after the changes." - (let* ((pos (copy-marker (point))) - (ancestor (caar struct)) - (modify + (funcall set-assoc + (cons item (cdr (assq prev acc))))))))))))) + (mapcar ind parents))) + + +;;; Repairing structures + +(defun org-list-use-alpha-bul-p (first struct prevs) + "Non-nil if list starting at FIRST can have alphabetical bullets. + +STRUCT is list structure. PREVS is the alist of previous items, +as returned by `org-list-prevs-alist'." + (and org-alphabetical-lists + (catch 'exit + (let ((item first) (ascii 64) (case-fold-search nil)) + ;; Pretend that bullets are uppercase and check if alphabet + ;; is sufficient, taking counters into account. + (while item + (let ((bul (org-list-get-bullet item struct)) + (count (org-list-get-counter item struct))) + ;; Virtually determine current bullet + (if (and count (string-match "[a-zA-Z]" count)) + ;; Counters are not case-sensitive. + (setq ascii (string-to-char (upcase count))) + (setq ascii (1+ ascii))) + ;; Test if bullet would be over z or Z. + (if (> ascii 90) + (throw 'exit nil) + (setq item (org-list-get-next-item item struct prevs))))) + ;; All items checked. All good. + t)))) + +(defun org-list-inc-bullet-maybe (bullet) + "Increment BULLET if applicable." + (let ((case-fold-search nil)) + (cond + ;; Num bullet: increment it. + ((string-match "[0-9]+" bullet) + (replace-match + (number-to-string (1+ (string-to-number (match-string 0 bullet)))) + nil nil bullet)) + ;; Alpha bullet: increment it. + ((string-match "[A-Za-z]" bullet) + (replace-match + (char-to-string (1+ (string-to-char (match-string 0 bullet)))) + nil nil bullet)) + ;; Unordered bullet: leave it. + (t bullet)))) + +(defun org-list-struct-fix-bul (struct prevs) + "Verify and correct bullets in STRUCT. +PREVS is the alist of previous items, as returned by +`org-list-prevs-alist'. + +This function modifies STRUCT." + (let ((case-fold-search nil) + (fix-bul + (function + ;; Set bullet of ITEM in STRUCT, depending on the type of + ;; first item of the list, the previous bullet and counter + ;; if any. + (lambda (item) + (let* ((prev (org-list-get-prev-item item struct prevs)) + (prev-bul (and prev (org-list-get-bullet prev struct))) + (counter (org-list-get-counter item struct)) + (bullet (org-list-get-bullet item struct)) + (alphap (and (not prev) + (org-list-use-alpha-bul-p item struct prevs)))) + (org-list-set-bullet + item struct + (org-list-bullet-string + (cond + ;; Alpha counter in alpha list: use counter. + ((and prev counter + (string-match "[a-zA-Z]" counter) + (string-match "[a-zA-Z]" prev-bul)) + ;; Use cond to be sure `string-match' is used in + ;; both cases. + (let ((real-count + (cond + ((string-match "[a-z]" prev-bul) (downcase counter)) + ((string-match "[A-Z]" prev-bul) (upcase counter))))) + (replace-match real-count nil nil prev-bul))) + ;; Num counter in a num list: use counter. + ((and prev counter + (string-match "[0-9]+" counter) + (string-match "[0-9]+" prev-bul)) + (replace-match counter nil nil prev-bul)) + ;; No counter: increase, if needed, previous bullet. + (prev + (org-list-inc-bullet-maybe (org-list-get-bullet prev struct))) + ;; Alpha counter at first item: use counter. + ((and counter (org-list-use-alpha-bul-p item struct prevs) + (string-match "[A-Za-z]" counter) + (string-match "[A-Za-z]" bullet)) + (let ((real-count + (cond + ((string-match "[a-z]" bullet) (downcase counter)) + ((string-match "[A-Z]" bullet) (upcase counter))))) + (replace-match real-count nil nil bullet))) + ;; Num counter at first item: use counter. + ((and counter + (string-match "[0-9]+" counter) + (string-match "[0-9]+" bullet)) + (replace-match counter nil nil bullet)) + ;; First bullet is alpha uppercase: use "A". + ((and alphap (string-match "[A-Z]" bullet)) + (replace-match "A" nil nil bullet)) + ;; First bullet is alpha lowercase: use "a". + ((and alphap (string-match "[a-z]" bullet)) + (replace-match "a" nil nil bullet)) + ;; First bullet is num: use "1". + ((string-match "\\([0-9]+\\|[A-Za-z]\\)" bullet) + (replace-match "1" nil nil bullet)) + ;; Not an ordered list: keep bullet. + (t bullet))))))))) + (mapc fix-bul (mapcar 'car struct)))) + +(defun org-list-struct-fix-ind (struct parents &optional bullet-size) + "Verify and correct indentation in STRUCT. + +PARENTS is the alist of parents, as returned by +`org-list-parents-alist'. + +If numeric optional argument BULLET-SIZE is set, assume all +bullets in list have this length to determine new indentation. + +This function modifies STRUCT." + (let* ((ancestor (org-list-get-top-point struct)) + (top-ind (org-list-get-ind ancestor struct)) + (new-ind (lambda (item) - (goto-char (car item)) - (let* ((new-ind (nth 1 item)) - (new-bul (org-list-bullet-string (nth 2 item))) - (old-ind (org-get-indentation)) - (old-bul (progn - (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") - (match-string 1))) - (old-body-ind (+ (length old-bul) old-ind)) - (new-body-ind (+ (length new-bul) new-ind))) - ;; 1. Shift item's body - (unless (= old-body-ind new-body-ind) - (org-shift-item-indentation - (- new-body-ind old-body-ind) bottom)) - ;; 2. Replace bullet - (unless (equal new-bul old-bul) - (save-excursion - (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") - (replace-match new-bul nil nil nil 1))) - ;; 3. Indent item to appropriate column - (unless (= new-ind old-ind) - (delete-region (point-at-bol) - (progn - (skip-chars-forward " \t") - (point))) - (indent-to new-ind))))) - ;; Remove ancestor if it is left. - (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) - (cdr struct) - struct))) - ;; Apply changes from bottom to top - (mapc modify (nreverse struct-to-apply)) - (goto-char pos))) + (let ((parent (org-list-get-parent item struct parents))) + (if parent + ;; Indent like parent + length of parent's bullet + + ;; sub-list offset. + (org-list-set-ind + item struct (+ (or bullet-size + (length + (org-list-get-bullet parent struct))) + (org-list-get-ind parent struct) + org-list-indent-offset)) + ;; If no parent, indent like top-point. + (org-list-set-ind item struct top-ind)))))) + (mapc new-ind (mapcar 'car (cdr struct))))) + +(defun org-list-struct-fix-box (struct parents prevs &optional ordered) + "Verify and correct checkboxes in STRUCT. + +PARENTS is the alist of parents and PREVS is the alist of +previous items, as returned by, respectively, +`org-list-parents-alist' and `org-list-prevs-alist'. + +If ORDERED is non-nil, a checkbox can only be checked when every +checkbox before it is checked too. If there was an attempt to +break this rule, the function will return the blocking item. In +all others cases, the return value will be nil. -;;; Indentation +This function modifies STRUCT." + (let ((all-items (mapcar 'car struct)) + (set-parent-box + (function + (lambda (item) + (let* ((box-list + (mapcar (lambda (child) + (org-list-get-checkbox child struct)) + (org-list-get-children item struct parents)))) + (org-list-set-checkbox + item struct + (cond + ((and (member "[ ]" box-list) (member "[X]" box-list)) "[-]") + ((member "[-]" box-list) "[-]") + ((member "[X]" box-list) "[X]") + ((member "[ ]" box-list) "[ ]") + ;; Parent has no boxed child: leave box as-is. + (t (org-list-get-checkbox item struct)))))))) + parent-list) + ;; 1. List all parents with a checkbox. + (mapc + (lambda (e) + (let* ((parent (org-list-get-parent e struct parents)) + (parent-box-p (org-list-get-checkbox parent struct))) + (when (and parent-box-p (not (memq parent parent-list))) + (push parent parent-list)))) + all-items) + ;; 2. Sort those parents by decreasing indentation. + (setq parent-list (sort parent-list + (lambda (e1 e2) + (> (org-list-get-ind e1 struct) + (org-list-get-ind e2 struct))))) + ;; 3. For each parent, get all children's checkboxes to determine + ;; and set its checkbox accordingly. + (mapc set-parent-box parent-list) + ;; 4. If ORDERED is set, see if we need to uncheck some boxes. + (when ordered + (let* ((box-list + (mapcar (lambda (e) (org-list-get-checkbox e struct)) all-items)) + (after-unchecked (member "[ ]" box-list))) + ;; There are boxes checked after an unchecked one: fix that. + (when (member "[X]" after-unchecked) + (let ((index (- (length struct) (length after-unchecked)))) + (mapc (lambda (e) (org-list-set-checkbox e struct "[ ]")) + (nthcdr index all-items)) + ;; Verify once again the structure, without ORDERED. + (org-list-struct-fix-box struct parents prevs nil) + ;; Return blocking item. + (nth index all-items))))))) + +(defun org-list-struct-apply-struct (struct old-struct) + "Apply set-difference between STRUCT and OLD-STRUCT to the buffer. + +OLD-STRUCT is the structure before any modifications, and STRUCT +the structure to be applied. The function will only modify parts +of the list which have changed. + +Initial position of cursor is restored after the changes." + (let* ((origin (copy-marker (point))) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) + (item-re (org-item-re)) + (box-rule-p (cdr (assq 'checkbox org-list-automatic-rules))) + (shift-body-ind + (function + ;; Shift the indentation between END and BEG by DELTA. + ;; Start from the line before END. + (lambda (end beg delta) + (goto-char end) + (skip-chars-backward " \r\t\n") + (beginning-of-line) + (while (or (> (point) beg) + (and (= (point) beg) + (not (looking-at item-re)))) + (cond + ;; Skip inline tasks. + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning)) + ;; Shift only non-empty lines. + ((org-looking-at-p "^[ \t]*\\S-") + (let ((i (org-get-indentation))) + (org-indent-line-to (+ i delta))))) + (forward-line -1))))) + (modify-item + (function + ;; Replace ITEM first line elements with new elements from + ;; STRUCT, if appropriate. + (lambda (item) + (goto-char item) + (let* ((new-ind (org-list-get-ind item struct)) + (old-ind (org-get-indentation)) + (new-bul (org-list-bullet-string + (org-list-get-bullet item struct))) + (old-bul (org-list-get-bullet item old-struct)) + (new-box (org-list-get-checkbox item struct))) + (looking-at org-list-full-item-re) + ;; a. Replace bullet + (unless (equal old-bul new-bul) + (replace-match new-bul nil nil nil 1)) + ;; b. Replace checkbox. + (cond + ((and new-box box-rule-p + (save-match-data (org-at-item-description-p))) + (message "Cannot add a checkbox to a description list item")) + ((equal (match-string 3) new-box)) + ((and (match-string 3) new-box) + (replace-match new-box nil nil nil 3)) + ((match-string 3) + ;; (goto-char (or (match-end 2) (match-end 1))) + ;; (skip-chars-backward " \t") + (looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)") + (replace-match "" nil nil nil 1)) + (t (let ((counterp (match-end 2))) + (goto-char (if counterp (1+ counterp) (match-end 1))) + (insert (concat new-box (unless counterp " ")))))) + ;; c. Indent item to appropriate column. + (unless (= new-ind old-ind) + (delete-region (goto-char (point-at-bol)) + (progn (skip-chars-forward " \t") (point))) + (indent-to new-ind))))))) + ;; 1. First get list of items and position endings. We maintain + ;; two alists: ITM-SHIFT, determining indentation shift needed + ;; at item, and END-POS, a pseudo-alist where key is ending + ;; position and value point. + (let (end-list acc-end itm-shift all-ends sliced-struct) + (mapc (lambda (e) + (let* ((pos (car e)) + (ind-pos (org-list-get-ind pos struct)) + (ind-old (org-list-get-ind pos old-struct)) + (bul-pos (org-list-get-bullet pos struct)) + (bul-old (org-list-get-bullet pos old-struct)) + (ind-shift (- (+ ind-pos (length bul-pos)) + (+ ind-old (length bul-old)))) + (end-pos (org-list-get-item-end pos old-struct))) + (push (cons pos ind-shift) itm-shift) + (unless (assq end-pos old-struct) + ;; To determine real ind of an ending position that + ;; is not at an item, we have to find the item it + ;; belongs to: it is the last item (ITEM-UP), whose + ;; ending is further than the position we're + ;; interested in. + (let ((item-up (assoc-default end-pos acc-end '>))) + (push (cons end-pos item-up) end-list))) + (push (cons end-pos pos) acc-end))) + old-struct) + ;; 2. Slice the items into parts that should be shifted by the + ;; same amount of indentation. The slices are returned in + ;; reverse order so changes modifying buffer do not change + ;; positions they refer to. + (setq all-ends (sort (append (mapcar 'car itm-shift) + (org-uniquify (mapcar 'car end-list))) + '<)) + (while (cdr all-ends) + (let* ((up (pop all-ends)) + (down (car all-ends)) + (ind (if (assq up struct) + (cdr (assq up itm-shift)) + (cdr (assq (cdr (assq up end-list)) itm-shift))))) + (push (list down up ind) sliced-struct))) + ;; 3. Shift each slice in buffer, provided delta isn't 0, from + ;; end to beginning. Take a special action when beginning is + ;; at item bullet. + (mapc (lambda (e) + (unless (zerop (nth 2 e)) (apply shift-body-ind e)) + (let* ((beg (nth 1 e)) + (cell (assq beg struct))) + (unless (or (not cell) (equal cell (assq beg old-struct))) + (funcall modify-item beg)))) + sliced-struct)) + ;; 4. Go back to initial position and clean marker. + (goto-char origin) + (move-marker origin nil))) + +(defun org-list-write-struct (struct parents) + "Correct bullets, checkboxes and indentation in list at point. +STRUCT is the list structure. PARENTS is the alist of parents, +as returned by `org-list-parents-alist'." + ;; Order of functions matters here: checkboxes and endings need + ;; correct indentation to be set, and indentation needs correct + ;; bullets. + ;; + ;; 0. Save a copy of structure before modifications + (let ((old-struct (copy-tree struct))) + ;; 1. Set a temporary, but coherent with PARENTS, indentation in + ;; order to get items endings and bullets properly + (org-list-struct-fix-ind struct parents 2) + ;; 2. Get pseudo-alist of ending positions and sort it by position. + ;; Then associate them to the structure. + (let (end-list acc-end) + (mapc (lambda (e) + (let* ((pos (car e)) + (ind-pos (org-list-get-ind pos struct)) + (end-pos (org-list-get-item-end pos struct))) + (unless (assq end-pos struct) + ;; To determine real ind of an ending position that is + ;; not at an item, we have to find the item it belongs + ;; to: it is the last item (ITEM-UP), whose ending is + ;; further than the position we're interested in. + (let ((item-up (assoc-default end-pos acc-end '>))) + (push (cons + ;; Else part is for the bottom point. + (if item-up (+ (org-list-get-ind item-up struct) 2) 0) + end-pos) + end-list))) + (push (cons ind-pos pos) end-list) + (push (cons end-pos pos) acc-end))) + struct) + (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2))))) + (org-list-struct-assoc-end struct end-list)) + ;; 3. Get bullets right. + (let ((prevs (org-list-prevs-alist struct))) + (org-list-struct-fix-bul struct prevs) + ;; 4. Now get real indentation. + (org-list-struct-fix-ind struct parents) + ;; 5. Eventually fix checkboxes. + (org-list-struct-fix-box struct parents prevs)) + ;; 6. Apply structure modifications to buffer. + (org-list-struct-apply-struct struct old-struct))) -(defun org-get-string-indentation (s) - "What indentation has S due to SPACE and TAB at the beginning of the string?" - (let ((n -1) (i 0) (w tab-width) c) - (catch 'exit - (while (< (setq n (1+ n)) (length s)) - (setq c (aref s n)) - (cond ((= c ?\ ) (setq i (1+ i))) - ((= c ?\t) (setq i (* (/ (+ w i) w) w))) - (t (throw 'exit t))))) - i)) - -(defun org-shift-item-indentation (delta bottom) - "Shift the indentation in current item by DELTA. -Sub-items are not moved. - -BOTTOM is position at list ending." - (save-excursion - (let ((beg (point-at-bol)) - (end (org-end-of-item-or-at-child bottom))) - (beginning-of-line (unless (eolp) 0)) - (while (> (point) beg) - (when (looking-at "[ \t]*\\S-") - ;; this is not an empty line - (let ((i (org-get-indentation))) - (when (and (> i 0) (> (+ i delta) 0)) - (org-indent-line-to (+ i delta))))) - (beginning-of-line 0))))) -(defun org-outdent-item () - "Outdent a local list item, but not its children. -If a region is active, all items inside will be moved." - (interactive) - (org-list-indent-item-generic - -1 t (org-list-top-point) (org-list-bottom-point))) +;;; Misc Tools -(defun org-indent-item () - "Indent a local list item, but not its children. -If a region is active, all items inside will be moved." - (interactive) - (org-list-indent-item-generic - 1 t (org-list-top-point) (org-list-bottom-point))) +(defun org-apply-on-list (function init-value &rest args) + "Call FUNCTION on each item of the list at point. +FUNCTION must be called with at least one argument: INIT-VALUE, +that will contain the value returned by the function at the +previous item, plus ARGS extra arguments. -(defun org-outdent-item-tree () - "Outdent a local list item including its children. -If a region is active, all items inside will be moved." - (interactive) - (org-list-indent-item-generic - -1 nil (org-list-top-point) (org-list-bottom-point))) +FUNCTION is applied on items in reverse order. -(defun org-indent-item-tree () - "Indent a local list item including its children. -If a region is active, all items inside will be moved." +As an example, \(org-apply-on-list \(lambda \(result\) \(1+ result\)\) 0\) +will return the number of items in the current list. + +Sublists of the list are skipped. Cursor is always at the +beginning of the item." + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (item (copy-marker (point-at-bol))) + (all (org-list-get-all-items (marker-position item) struct prevs)) + (value init-value)) + (mapc (lambda (e) + (goto-char e) + (setq value (apply function value args))) + (nreverse all)) + (goto-char item) + (move-marker item nil) + value)) + +(defun org-list-set-item-visibility (item struct view) + "Set visibility of ITEM in STRUCT to VIEW. + +Possible values are: `folded', `children' or `subtree'. See +`org-cycle' for more information." + (cond + ((eq view 'folded) + (let ((item-end (org-list-get-item-end-before-blank item struct))) + ;; Hide from eol + (outline-flag-region (save-excursion (goto-char item) (point-at-eol)) + item-end t))) + ((eq view 'children) + ;; First show everything. + (org-list-set-item-visibility item struct 'subtree) + ;; Then fold every child. + (let* ((parents (org-list-parents-alist struct)) + (children (org-list-get-children item struct parents))) + (mapc (lambda (e) + (org-list-set-item-visibility e struct 'folded)) + children))) + ((eq view 'subtree) + ;; Show everything + (let ((item-end (org-list-get-item-end item struct))) + (outline-flag-region item item-end nil))))) + +(defun org-list-item-body-column (item) + "Return column at which body of ITEM should start." + (let (bpos bcol tpos tcol) + (save-excursion + (goto-char item) + (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?[ \t]+") + (setq bpos (match-beginning 1) tpos (match-end 0) + bcol (progn (goto-char bpos) (current-column)) + tcol (progn (goto-char tpos) (current-column))) + (when (> tcol (+ bcol org-description-max-indent)) + (setq tcol (+ bcol 5)))) + tcol)) + + +;;; Interactive functions + +(defalias 'org-list-get-item-begin 'org-in-item-p) + +(defun org-beginning-of-item () + "Go to the beginning of the current item. +Throw an error when not in a list." (interactive) - (org-list-indent-item-generic - 1 nil (org-list-top-point) (org-list-bottom-point))) + (let ((begin (org-in-item-p))) + (if begin (goto-char begin) (error "Not in an item")))) -(defvar org-tab-ind-state) -(defun org-cycle-item-indentation () - "Cycle levels of indentation of an empty item. -The first run indent the item, if applicable. Subsequents runs -outdent it at meaningful levels in the list. When done, item is -put back at its original position with its original bullet. +(defun org-beginning-of-item-list () + "Go to the beginning item of the current list or sublist. +Throw an error when not in a list." + (interactive) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct))) + (goto-char (org-list-get-list-begin begin struct prevs)))))) -Return t at each successful move." - (let ((org-adapt-indentation nil) - (ind (org-get-indentation)) - (bottom (and (org-at-item-p) (org-list-bottom-point)))) - (when (and (or (org-at-item-description-p) - (org-at-item-checkbox-p) - (org-at-item-p)) - ;; Check that item is really empty - (>= (match-end 0) (save-excursion - (org-end-of-item-or-at-child bottom) - (skip-chars-backward " \r\t\n") - (point)))) - (setq this-command 'org-cycle-item-indentation) - (let ((top (org-list-top-point))) - ;; When in the middle of the cycle, try to outdent first. If it - ;; fails, and point is still at initial position, indent. Else, - ;; go back to original position. - (if (eq last-command 'org-cycle-item-indentation) - (cond - ((ignore-errors (org-list-indent-item-generic -1 t top bottom))) - ((and (= (org-get-indentation) (car org-tab-ind-state)) - (ignore-errors - (org-list-indent-item-generic 1 t top bottom)))) - (t (back-to-indentation) - (org-indent-to-column (car org-tab-ind-state)) - (end-of-line) - (org-list-repair (cdr org-tab-ind-state)) - ;; Break cycle - (setq this-command 'identity))) - ;; If a cycle is starting, remember indentation and bullet, - ;; then try to indent. If it fails, try to outdent. - (setq org-tab-ind-state (cons ind (org-get-bullet))) - (cond - ((ignore-errors (org-list-indent-item-generic 1 t top bottom))) - ((ignore-errors (org-list-indent-item-generic -1 t top bottom))) - (t (error "Cannot move item"))))) - t))) +(defun org-end-of-item-list () + "Go to the end of the current list or sublist. +Throw an error when not in a list." + (interactive) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct))) + (goto-char (org-list-get-list-end begin struct prevs)))))) -;;; Bullets +(defun org-end-of-item () + "Go to the end of the current item. +Throw an error when not in a list." + (interactive) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let ((struct (org-list-struct))) + (goto-char (org-list-get-item-end begin struct)))))) -(defun org-get-bullet () - "Return the bullet of the item at point. -Assume cursor is at an item." - (save-excursion - (beginning-of-line) - (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1)))) +(defun org-previous-item () + "Move to the beginning of the previous item. +Throw an error when not in a list. Also throw an error when at +first item, unless `org-list-use-circular-motion' is non-nil." + (interactive) + (let ((item (org-in-item-p))) + (if (not item) + (error "Not in an item") + (goto-char item) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (prevp (org-list-get-prev-item item struct prevs))) + (cond + (prevp (goto-char prevp)) + (org-list-use-circular-motion + (goto-char (org-list-get-last-item item struct prevs))) + (t (error "On first item"))))))) -(defun org-list-bullet-string (bullet) - "Return BULLET with the correct number of whitespaces. -It determines the number of whitespaces to append by looking at -`org-list-two-spaces-after-bullet-regexp'." - (save-match-data - (string-match "\\S-+\\([ \t]*\\)" bullet) - (replace-match - (save-match-data - (concat - " " - ;; Do we need to concat another white space ? - (when (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp bullet)) - " "))) - nil nil bullet 1))) +(defun org-next-item () + "Move to the beginning of the next item. +Throw an error when not in a list. Also throw an error when at +last item, unless `org-list-use-circular-motion' is non-nil." + (interactive) + (let ((item (org-in-item-p))) + (if (not item) + (error "Not in an item") + (goto-char item) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (prevp (org-list-get-next-item item struct prevs))) + (cond + (prevp (goto-char prevp)) + (org-list-use-circular-motion + (goto-char (org-list-get-first-item item struct prevs))) + (t (error "On last item"))))))) -(defun org-list-inc-bullet-maybe (bullet) - "Increment BULLET if applicable." - (if (string-match "[0-9]+" bullet) - (replace-match - (number-to-string (1+ (string-to-number (match-string 0 bullet)))) - nil nil bullet) - bullet)) +(defun org-move-item-down () + "Move the item at point down, i.e. swap with following item. +Sub-items (items with larger indentation) are considered part of +the item, so this really moves item trees." + (interactive) + (unless (org-at-item-p) (error "Not at an item")) + (let* ((col (current-column)) + (item (point-at-bol)) + (struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (next-item (org-list-get-next-item (point-at-bol) struct prevs))) + (unless (or next-item org-list-use-circular-motion) + (error "Cannot move this item further down")) + (if (not next-item) + (setq struct (org-list-send-item item 'begin struct)) + (setq struct (org-list-swap-items item next-item struct)) + (goto-char + (org-list-get-next-item item struct (org-list-prevs-alist struct)))) + (org-list-write-struct struct (org-list-parents-alist struct)) + (org-move-to-column col))) -(defun org-list-repair (&optional force-bullet top bottom) - "Make sure all items are correctly indented, with the right bullet. -This function scans the list at point, along with any sublist. +(defun org-move-item-up () + "Move the item at point up, i.e. swap with previous item. +Sub-items (items with larger indentation) are considered part of +the item, so this really moves item trees." + (interactive) + (unless (org-at-item-p) (error "Not at an item")) + (let* ((col (current-column)) + (item (point-at-bol)) + (struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (prev-item (org-list-get-prev-item (point-at-bol) struct prevs))) + (unless (or prev-item org-list-use-circular-motion) + (error "Cannot move this item further up")) + (if (not prev-item) + (setq struct (org-list-send-item item 'end struct)) + (setq struct (org-list-swap-items prev-item item struct))) + (org-list-write-struct struct (org-list-parents-alist struct)) + (org-move-to-column col))) -If FORCE-BULLET is a string, ensure all items in list share this -bullet, or a logical successor in the case of an ordered list. +(defun org-insert-item (&optional checkbox) + "Insert a new item at the current level. +If cursor is before first character after bullet of the item, the +new item will be created before the current one. -When non-nil, TOP and BOTTOM specify respectively position of -list beginning and list ending. +If CHECKBOX is non-nil, add a checkbox next to the bullet. -Item's body is not indented, only shifted with the bullet." +Return t when things worked, nil when we are not in an item, or +item is invisible." + (let ((itemp (org-in-item-p)) + (pos (point))) + ;; If cursor isn't is a list or if list is invisible, return nil. + (unless (or (not itemp) + (save-excursion + (goto-char itemp) + (outline-invisible-p))) + (if (save-excursion + (goto-char itemp) + (org-at-item-timer-p)) + ;; Timer list: delegate to `org-timer-item'. + (progn (org-timer-item) t) + (let* ((struct (save-excursion (goto-char itemp) + (org-list-struct))) + (prevs (org-list-prevs-alist struct)) + ;; If we're in a description list, ask for the new term. + (desc (when (org-list-get-tag itemp struct) + (concat (read-string "Term: ") " :: "))) + ;; Don't insert a checkbox if checkbox rule is applied + ;; and it is a description item. + (checkp (and checkbox + (or (not desc) + (not (cdr (assq 'checkbox + org-list-automatic-rules))))))) + (setq struct + (org-list-insert-item pos struct prevs checkp desc)) + (org-list-write-struct struct (org-list-parents-alist struct)) + (when checkp (org-update-checkbox-count-maybe)) + (looking-at org-list-full-item-re) + (goto-char (match-end 0)) + t))))) + +(defun org-list-repair () + "Fix indentation, bullets and checkboxes is the list at point." (interactive) (unless (org-at-item-p) (error "This is not a list")) - (let* ((bottom (or bottom (org-list-bottom-point))) - (struct (org-list-struct - (point-at-bol) (point-at-eol) - (or top (org-list-top-point)) bottom)) - (origins (org-list-struct-origins struct)) - fixed-struct) - (if (stringp force-bullet) - (let ((begin (nth 1 struct))) - (setcdr begin (list (nth 1 begin) - (org-list-bullet-string force-bullet) - (nth 3 begin))) - (setq fixed-struct - (cons begin (org-list-struct-fix-struct struct origins)))) - (setq fixed-struct (org-list-struct-fix-struct struct origins))) - (org-list-struct-apply-struct fixed-struct bottom))) + (let* ((struct (org-list-struct)) + (parents (org-list-parents-alist struct))) + (org-list-write-struct struct parents))) (defun org-cycle-list-bullet (&optional which) "Cycle through the different itemize/enumerate bullets. @@ -1630,31 +2161,50 @@ This cycle the entire list level through the sequence: `-' -> `+' -> `*' -> `1.' -> `1)' -If WHICH is a valid string, use that as the new bullet. If WHICH -is an integer, 0 means `-', 1 means `+' etc. If WHICH is -'previous, cycle backwards." +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") + (unless (org-at-item-p) (error "Not at an item")) (save-excursion - (let* ((top (org-list-top-point)) - (bullet (progn - (goto-char (org-get-beginning-of-list top)) - (org-get-bullet))) + (beginning-of-line) + (let* ((struct (org-list-struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (list-beg (org-list-get-first-item (point) struct prevs)) + (bullet (org-list-get-bullet list-beg struct)) + (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) + (alpha-p (org-list-use-alpha-bul-p list-beg struct prevs)) + (case-fold-search nil) (current (cond + ((string-match "[a-z]\\." bullet) "a.") + ((string-match "[a-z])" bullet) "a)") + ((string-match "[A-Z]\\." bullet) "A.") + ((string-match "[A-Z])" bullet) "A)") ((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)")))) + (t (org-trim bullet)))) + ;; Compute list of possible bullets, depending on context. + (bullet-list + (append '("-" "+" ) + ;; *-bullets are not allowed at column 0. + (unless (and bullet-rule-p + (looking-at "\\S-")) '("*")) + ;; Description items cannot be numbered. + (unless (or (eq org-plain-list-ordered-item-terminator ?\)) + (and bullet-rule-p (org-at-item-description-p))) + '("1.")) + (unless (or (eq org-plain-list-ordered-item-terminator ?.) + (and bullet-rule-p (org-at-item-description-p))) + '("1)")) + (unless (or (not alpha-p) + (eq org-plain-list-ordered-item-terminator ?\)) + (and bullet-rule-p (org-at-item-description-p))) + '("a." "A.")) + (unless (or (not alpha-p) + (eq org-plain-list-ordered-item-terminator ?.) + (and bullet-rule-p (org-at-item-description-p))) + '("a)" "A)")))) (len (length bullet-list)) (item-index (- len (length (member current bullet-list)))) (get-value (lambda (index) (nth (mod index len) bullet-list))) @@ -1663,9 +2213,13 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is ((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 + ;; Use a short variation of `org-list-write-struct' as there's + ;; no need to go through all the steps. + (let ((old-struct (copy-tree struct))) + (org-list-set-bullet list-beg struct (org-list-bullet-string new)) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (org-list-struct-apply-struct struct old-struct))))) (defun org-toggle-checkbox (&optional toggle-presence) "Toggle the checkbox in the current line. @@ -1673,220 +2227,256 @@ With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With double prefix, set checkbox to [-]. When there is an active region, toggle status or presence of the -first checkbox there, and make every item inside have the -same status or presence, respectively. +first checkbox there, and make every item inside have the same +status or presence, respectively. If the cursor is in a headline, apply this to all checkbox items in the text below the heading, taking as reference the first item in subtree, ignoring drawers." (interactive "P") - ;; Bounds is a list of type (beg end single-p) where single-p is t - ;; when `org-toggle-checkbox' is applied to a single item. Only - ;; toggles on single items will return errors. - (let* ((bounds - (cond - ((org-region-active-p) - (let ((rbeg (region-beginning)) - (rend (region-end))) - (save-excursion - (goto-char rbeg) - (if (org-search-forward-unenclosed org-item-beginning-re rend 'move) - (list (point-at-bol) rend nil) - (error "No item in region"))))) - ((org-on-heading-p) - ;; In this case, reference line is the first item in - ;; subtree outside drawers - (let ((pos (point)) - (limit (save-excursion (outline-next-heading) (point)))) - (save-excursion - (goto-char limit) - (org-search-backward-unenclosed ":END:" pos 'move) - (org-search-forward-unenclosed - org-item-beginning-re limit 'move) - (list (point) limit nil)))) - ((org-at-item-p) - (list (point-at-bol) (1+ (point-at-eol)) t)) - (t (error "Not at an item or heading, and no active region")))) - (beg (car bounds)) - ;; marker is needed because deleting or inserting checkboxes - ;; will change bottom point - (end (copy-marker (nth 1 bounds))) - (single-p (nth 2 bounds)) - (ref-presence (save-excursion - (goto-char beg) - (org-at-item-checkbox-p))) - (ref-status (equal (match-string 1) "[X]")) - (act-on-item - (lambda (ref-pres ref-stat) - (if (equal toggle-presence '(4)) - (cond - ((and ref-pres (org-at-item-checkbox-p)) - (replace-match "")) - ((and (not ref-pres) - (not (org-at-item-checkbox-p)) - (org-at-item-p)) - (goto-char (match-end 0)) - ;; Ignore counter, if any - (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") - (goto-char (match-end 0))) - (let ((desc-p (and (org-at-item-description-p) - (cdr (assq 'checkbox org-list-automatic-rules))))) - (cond - ((and single-p desc-p) - (error "Cannot add a checkbox in a description list")) - ((not desc-p) (insert "[ ] ")))))) - (let ((blocked (org-checkbox-blocked-p))) - (cond - ((and blocked single-p) - (error "Checkbox blocked because of unchecked box in line %d" blocked)) - (blocked nil) - ((org-at-item-checkbox-p) - (replace-match - (cond ((equal toggle-presence '(16)) "[-]") - (ref-stat "[ ]") - (t "[X]")) - t t nil 1)))))))) - (save-excursion - (goto-char beg) - (while (< (point) end) - (funcall act-on-item ref-presence ref-status) - (org-search-forward-unenclosed org-item-beginning-re end 'move))) - (org-update-checkbox-count-maybe))) + (save-excursion + (let* (singlep + block-item + lim-up + lim-down + (drawer-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string + "\\|" org-deadline-string + "\\|" org-closed-string + "\\|" org-clock-string "\\)" + " *[[<]\\([^]>]+\\)[]>]")) + (orderedp (org-entry-get nil "ORDERED")) + (bounds + ;; In a region, start at first item in region. + (cond + ((org-region-active-p) + (let ((limit (region-end))) + (goto-char (region-beginning)) + (if (org-list-search-forward (org-item-beginning-re) limit t) + (setq lim-up (point-at-bol)) + (error "No item in region")) + (setq lim-down (copy-marker limit)))) + ((org-on-heading-p) + ;; On an heading, start at first item after drawers and + ;; time-stamps (scheduled, etc.). + (let ((limit (save-excursion (outline-next-heading) (point)))) + (forward-line 1) + (while (or (looking-at drawer-re) (looking-at keyword-re)) + (if (looking-at keyword-re) + (forward-line 1) + (re-search-forward "^[ \t]*:END:" limit nil))) + (if (org-list-search-forward (org-item-beginning-re) limit t) + (setq lim-up (point-at-bol)) + (error "No item in subtree")) + (setq lim-down (copy-marker limit)))) + ;; Just one item: set SINGLEP flag. + ((org-at-item-p) + (setq singlep t) + (setq lim-up (point-at-bol) + lim-down (point-at-eol))) + (t (error "Not at an item or heading, and no active region")))) + ;; Determine the checkbox going to be applied to all items + ;; within bounds. + (ref-checkbox + (progn + (goto-char lim-up) + (let ((cbox (and (org-at-item-checkbox-p) (match-string 1)))) + (cond + ((equal toggle-presence '(16)) "[-]") + ((equal toggle-presence '(4)) + (unless cbox "[ ]")) + ((equal "[X]" cbox) "[ ]") + (t "[X]")))))) + ;; When an item is found within bounds, grab the full list at + ;; point structure, then: (1) set check-box of all its items + ;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the + ;; whole list, (3) move point after the list. + (goto-char lim-up) + (while (and (< (point) lim-down) + (org-list-search-forward (org-item-beginning-re) + lim-down 'move)) + (let* ((struct (org-list-struct)) + (struct-copy (copy-tree struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (bottom (copy-marker (org-list-get-bottom-point struct))) + (items-to-toggle (org-remove-if + (lambda (e) (or (< e lim-up) (> e lim-down))) + (mapcar 'car struct)))) + (mapc (lambda (e) (org-list-set-checkbox + e struct + ;; If there is no box at item, leave as-is + ;; unless function was called with C-u prefix. + (let ((cur-box (org-list-get-checkbox e struct))) + (if (or cur-box (equal toggle-presence '(4))) + ref-checkbox + cur-box)))) + items-to-toggle) + (setq block-item (org-list-struct-fix-box + struct parents prevs orderedp)) + ;; Report some problems due to ORDERED status of subtree. + ;; If only one box was being checked, throw an error, else, + ;; only signal problems. + (cond + ((and singlep block-item (> lim-up block-item)) + (error + "Checkbox blocked because of unchecked box at line %d" + (org-current-line block-item))) + (block-item + (message + "Checkboxes were removed due to unchecked box at line %d" + (org-current-line block-item)))) + (goto-char bottom) + (move-marker lim-down nil) + (move-marker bottom nil) + (org-list-struct-apply-struct struct struct-copy))))) + (org-update-checkbox-count-maybe)) (defun org-reset-checkbox-state-subtree () "Reset all checkboxes in an entry subtree." (interactive "*") - (save-restriction - (save-excursion - (org-narrow-to-subtree) - (org-show-subtree) - (goto-char (point-min)) - (let ((end (point-max))) - (while (< (point) end) - (when (org-at-item-checkbox-p) - (replace-match "[ ]" t t nil 1)) - (beginning-of-line 2)))) - (org-update-checkbox-count-maybe))) - -(defvar org-checkbox-statistics-hook nil - "Hook that is run whenever Org thinks checkbox statistics should be updated. -This hook runs even if checkbox rule in -`org-list-automatic-rules' does not apply, so it can be used to -implement alternative ways of collecting statistics -information.") - -(defun org-update-checkbox-count-maybe () - "Update checkbox statistics unless turned off by user." - (when (cdr (assq 'checkbox org-list-automatic-rules)) - (org-update-checkbox-count)) - (run-hooks 'org-checkbox-statistics-hook)) + (if (org-before-first-heading-p) + (error "Not inside a tree") + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (org-show-subtree) + (goto-char (point-min)) + (let ((end (point-max))) + (while (< (point) end) + (when (org-at-item-checkbox-p) + (replace-match "[ ]" t t nil 1)) + (beginning-of-line 2))) + (org-update-checkbox-count-maybe 'all))))) (defun org-update-checkbox-count (&optional all) "Update the checkbox statistics in the current section. -This will find all statistic cookies like [57%] and [6/12] and update them -with the current numbers. With optional prefix argument ALL, do this for -the whole buffer." +This will find all statistic cookies like [57%] and [6/12] and +update them with the current numbers. + +With optional prefix argument ALL, do this for the whole buffer." (interactive "P") (save-excursion - (let ((cstat 0)) - (catch 'exit - (while t - (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 - (beg (condition-case nil - (progn (org-back-to-heading) (point)) - (error (point-min)))) - (end (copy-marker (save-excursion - (outline-next-heading) (point)))) - (re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)") - beg-cookie end-cookie is-percent c-on c-off lim new - curr-ind next-ind continue-from startsearch list-beg list-end - (recursive - (or (not org-hierarchical-checkbox-statistics) - (string-match "\\<recursive\\>" - (or (ignore-errors - (org-entry-get nil "COOKIE_DATA")) - ""))))) - (goto-char end) - ;; find each statistics cookie - (while (and (org-search-backward-unenclosed re-cookie beg 'move) - (not (save-match-data - (and (org-on-heading-p) - (string-match "\\<todo\\>" - (downcase - (or (org-entry-get - nil "COOKIE_DATA") - ""))))))) - (setq beg-cookie (match-beginning 1) - end-cookie (match-end 1) - cstat (+ cstat (if end-cookie 1 0)) - startsearch (point-at-eol) - continue-from (match-beginning 0) - is-percent (match-beginning 2) - lim (cond - ((org-on-heading-p) (outline-next-heading) (point)) - ;; Ensure many cookies in the same list won't imply - ;; computing list boundaries as many times. - ((org-at-item-p) - (unless (and list-beg (>= (point) list-beg)) - (setq list-beg (org-list-top-point) - list-end (copy-marker - (org-list-bottom-point)))) - (org-get-end-of-item list-end)) - (t nil)) - c-on 0 - c-off 0) - (when lim - ;; find first checkbox for this cookie and gather - ;; statistics from all that are at this indentation level - (goto-char startsearch) - (if (org-search-forward-unenclosed re-box lim t) - (progn - (beginning-of-line) - (setq curr-ind (org-get-indentation)) - (setq next-ind curr-ind) - (while (and (bolp) (org-at-item-p) - (if recursive - (<= curr-ind next-ind) - (= curr-ind next-ind))) - (when (org-at-item-checkbox-p) - (if (member (match-string 1) '("[ ]" "[-]")) - (setq c-off (1+ c-off)) - (setq c-on (1+ c-on)))) - (if (not recursive) - ;; org-get-next-item goes through list-enders - ;; with proper limit. - (goto-char (or (org-get-next-item (point) lim) lim)) - (end-of-line) - (when (org-search-forward-unenclosed - org-item-beginning-re lim t) - (beginning-of-line))) - (setq next-ind (org-get-indentation))))) - (goto-char continue-from) - ;; update cookie - (when end-cookie - (setq new (if is-percent - (format "[%d%%]" (/ (* 100 c-on) - (max 1 (+ c-on c-off)))) - (format "[%d/%d]" c-on (+ c-on c-off)))) - (goto-char beg-cookie) - (insert new) - (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) - ;; update items checkbox if it has one - (when (and (org-at-item-checkbox-p) - (> (+ c-on c-off) 0)) - (setq beg-cookie (match-beginning 1) - end-cookie (match-end 1)) - (delete-region beg-cookie end-cookie) - (goto-char beg-cookie) - (cond ((= c-off 0) (insert "[X]")) - ((= c-on 0) (insert "[ ]")) - (t (insert "[-]"))))) - (goto-char continue-from))) - (unless (and all (outline-next-heading)) (throw 'exit nil)))) - (when (interactive-p) - (message "Checkbox statistics updated %s (%d places)" - (if all "in entire file" "in current outline entry") cstat))))) + (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") + (recursivep + (or (not org-hierarchical-checkbox-statistics) + (string-match "\\<recursive\\>" + (or (org-entry-get nil "COOKIE_DATA") "")))) + (bounds (if all + (cons (point-min) (point-max)) + (cons (or (ignore-errors (org-back-to-heading t) (point)) + (point-min)) + (save-excursion (outline-next-heading) (point))))) + (count-boxes + (function + ;; Return number of checked boxes and boxes of all types + ;; in all structures in STRUCTS. If RECURSIVEP is + ;; non-nil, also count boxes in sub-lists. If ITEM is + ;; nil, count across the whole structure, else count only + ;; across subtree whose ancestor is ITEM. + (lambda (item structs recursivep) + (let ((c-on 0) (c-all 0)) + (mapc + (lambda (s) + (let* ((pre (org-list-prevs-alist s)) + (par (org-list-parents-alist s)) + (items + (cond + ((and recursivep item) (org-list-get-subtree item s)) + (recursivep (mapcar 'car s)) + (item (org-list-get-children item s par)) + (t (org-list-get-all-items + (org-list-get-top-point s) s pre)))) + (cookies (delq nil (mapcar + (lambda (e) + (org-list-get-checkbox e s)) + items)))) + (setq c-all (+ (length cookies) c-all) + c-on (+ (org-count "[X]" cookies) c-on)))) + structs) + (cons c-on c-all))))) + (backup-end 1) + cookies-list structs-bak box-num) + (goto-char (car bounds)) + ;; 1. Build an alist for each cookie found within BOUNDS. The + ;; key will be position at beginning of cookie and values + ;; ending position, format of cookie, and a cell whose car is + ;; number of checked boxes to report, and cdr total number of + ;; boxes. + (while (re-search-forward cookie-re (cdr bounds) t) + (catch 'skip + (save-excursion + (push + (list + (match-beginning 1) ; cookie start + (match-end 1) ; cookie end + (match-string 2) ; percent? + (cond ; boxes count + ;; Cookie is at an heading, but specifically for todo, + ;; not for checkboxes: skip it. + ((and (org-on-heading-p) + (string-match "\\<todo\\>" + (downcase + (or (org-entry-get nil "COOKIE_DATA") "")))) + (throw 'skip nil)) + ;; Cookie is at an heading, but all lists before next + ;; heading already have been read. Use data collected + ;; in STRUCTS-BAK. This should only happen when + ;; heading has more than one cookie on it. + ((and (org-on-heading-p) + (<= (save-excursion (outline-next-heading) (point)) + backup-end)) + (funcall count-boxes nil structs-bak recursivep)) + ;; Cookie is at a fresh heading. Grab structure of + ;; every list containing a checkbox between point and + ;; next headline, and save them in STRUCTS-BAK. + ((org-on-heading-p) + (setq backup-end (save-excursion + (outline-next-heading) (point)) + structs-bak nil) + (while (org-list-search-forward box-re backup-end 'move) + (let* ((struct (org-list-struct)) + (bottom (org-list-get-bottom-point struct))) + (push struct structs-bak) + (goto-char bottom))) + (funcall count-boxes nil structs-bak recursivep)) + ;; Cookie is at an item, and we already have list + ;; structure stored in STRUCTS-BAK. + ((and (org-at-item-p) + (< (point-at-bol) backup-end) + ;; Only lists in no special context are stored. + (not (nth 2 (org-list-context)))) + (funcall count-boxes (point-at-bol) structs-bak recursivep)) + ;; Cookie is at an item, but we need to compute list + ;; structure. + ((org-at-item-p) + (let ((struct (org-list-struct))) + (setq backup-end (org-list-get-bottom-point struct) + structs-bak (list struct))) + (funcall count-boxes (point-at-bol) structs-bak recursivep)) + ;; Else, cookie found is at a wrong place. Skip it. + (t (throw 'skip nil)))) + cookies-list)))) + ;; 2. Apply alist to buffer, in reverse order so positions stay + ;; unchanged after cookie modifications. + (mapc (lambda (cookie) + (let* ((beg (car cookie)) + (end (nth 1 cookie)) + (percentp (nth 2 cookie)) + (checked (car (nth 3 cookie))) + (total (cdr (nth 3 cookie))) + (new (if percentp + (format "[%d%%]" (/ (* 100 checked) + (max 1 total))) + (format "[%d/%d]" checked total)))) + (goto-char beg) + (insert new) + (delete-region (point) (+ (point) (- end beg))) + (when org-auto-align-tags (org-fix-tags-on-the-fly)))) + cookies-list)))) (defun org-get-checkbox-statistics-face () "Select the face for checkbox statistics. @@ -1901,39 +2491,210 @@ Otherwise it will be `org-todo'." 'org-checkbox-statistics-done 'org-checkbox-statistics-todo))) -;;; Misc Tools +(defun org-update-checkbox-count-maybe (&optional all) + "Update checkbox statistics unless turned off by user." + (when (cdr (assq 'checkbox org-list-automatic-rules)) + (org-update-checkbox-count all)) + (run-hooks 'org-checkbox-statistics-hook)) -(defun org-apply-on-list (function init-value &rest args) - "Call FUNCTION on each item of the list at point. -FUNCTION must be called with at least one argument: INIT-VALUE, -that will contain the value returned by the function at the -previous item, plus ARGS extra arguments. +(defvar org-last-indent-begin-marker (make-marker)) +(defvar org-last-indent-end-marker (make-marker)) +(defun org-list-indent-item-generic (arg no-subtree struct) + "Indent a local list item including its children. +When number ARG is a negative, item will be outdented, otherwise +it will be indented. -As an example, (org-apply-on-list (lambda (result) (1+ result)) 0) -will return the number of items in the current list. +If a region is active, all items inside will be moved. -Sublists of the list are skipped. Cursor is always at the -beginning of the item." - (let* ((pos (copy-marker (point))) - (end (copy-marker (org-list-bottom-point))) - (next-p (copy-marker (org-get-beginning-of-list (org-list-top-point)))) - (value init-value)) - (while (< next-p end) - (goto-char next-p) - (set-marker next-p (or (org-get-next-item (point) end) end)) - (setq value (apply function value args))) - (goto-char pos) - value)) +If NO-SUBTREE is non-nil, only indent the item itself, not its +children. + +STRUCT is the list structure. + +Return t if successful." + (save-excursion + (beginning-of-line) + (let* ((regionp (org-region-active-p)) + (rbeg (and regionp (region-beginning))) + (rend (and regionp (region-end))) + (top (org-list-get-top-point struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + ;; Are we going to move the whole list? + (specialp + (and (= top (point)) + (cdr (assq 'indent org-list-automatic-rules)) + (if no-subtree + (error + "First item of list cannot move without its subtree") + t)))) + ;; Determine begin and end points of zone to indent. If moving + ;; more than one item, save them for subsequent moves. + (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (if regionp + (progn + (set-marker org-last-indent-begin-marker rbeg) + (set-marker org-last-indent-end-marker rend)) + (set-marker org-last-indent-begin-marker (point)) + (set-marker org-last-indent-end-marker + (cond + (specialp (org-list-get-bottom-point struct)) + (no-subtree (1+ (point))) + (t (org-list-get-item-end (point) struct)))))) + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker))) + (cond + ;; Special case: moving top-item with indent rule. + (specialp + (let* ((level-skip (org-level-increment)) + (offset (if (< arg 0) (- level-skip) level-skip)) + (top-ind (org-list-get-ind beg struct)) + (old-struct (copy-tree struct))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary. + (when (and (= (+ top-ind offset) 0) + (string-match "*" + (org-list-get-bullet beg struct))) + (org-list-set-bullet beg struct + (org-list-bullet-string "-"))) + ;; Shift every item by OFFSET and fix bullets. Then + ;; apply changes to buffer. + (mapc (lambda (e) + (let ((ind (org-list-get-ind (car e) struct))) + (org-list-set-ind (car e) struct (+ ind offset)))) + struct) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-apply-struct struct old-struct)))) + ;; Forbidden move: + ((and (< arg 0) + ;; If only one item is moved, it mustn't have a child. + (or (and no-subtree + (not regionp) + (org-list-has-child-p beg struct)) + ;; If a subtree or region is moved, the last item + ;; of the subtree mustn't have a child. + (let ((last-item (caar + (reverse + (org-remove-if + (lambda (e) (>= (car e) end)) + struct))))) + (org-list-has-child-p last-item struct)))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((new-parents + (if (< arg 0) + (org-list-struct-outdent beg end struct parents) + (org-list-struct-indent beg end struct parents prevs)))) + (org-list-write-struct struct new-parents)) + (org-update-checkbox-count-maybe)))))) + t) + +(defun org-outdent-item () + "Outdent a local list item, but not its children. +If a region is active, all items inside will be moved." + (interactive) + (if (org-at-item-p) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic -1 t struct)) + (error "Not at an item"))) + +(defun org-indent-item () + "Indent a local list item, but not its children. +If a region is active, all items inside will be moved." + (interactive) + (if (org-at-item-p) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic 1 t struct)) + (error "Not at an item"))) + +(defun org-outdent-item-tree () + "Outdent a local list item including its children. +If a region is active, all items inside will be moved." + (interactive) + (let ((regionp (org-region-active-p))) + (cond + ((or (org-at-item-p) + (and (org-region-active-p) + (goto-char (region-beginning)) + (org-at-item-p))) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic -1 nil struct))) + (regionp (error "Region not starting at an item")) + (t (error "Not at an item"))))) + +(defun org-indent-item-tree () + "Indent a local list item including its children. +If a region is active, all items inside will be moved." + (interactive) + (let ((regionp (org-region-active-p))) + (cond + ((or (org-at-item-p) + (and (org-region-active-p) + (goto-char (region-beginning)) + (org-at-item-p))) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic 1 nil struct))) + (regionp (error "Region not starting at an item")) + (t (error "Not at an item"))))) + +(defvar org-tab-ind-state) +(defun org-cycle-item-indentation () + "Cycle levels of indentation of an empty item. +The first run indents the item, if applicable. Subsequents runs +outdent it at meaningful levels in the list. When done, item is +put back at its original position with its original bullet. + +Return t at each successful move." + (when (org-at-item-p) + (let* ((org-adapt-indentation nil) + (struct (org-list-struct)) + (ind (org-list-get-ind (point-at-bol) struct)) + (bullet (org-trim (buffer-substring (point-at-bol) (point-at-eol))))) + ;; Accept empty items or if cycle has already started. + (when (or (eq last-command 'org-cycle-item-indentation) + (and (save-excursion + (beginning-of-line) + (looking-at org-list-full-item-re)) + (>= (match-end 0) (save-excursion + (goto-char (org-list-get-item-end + (point-at-bol) struct)) + (skip-chars-backward " \r\t\n") + (point))))) + (setq this-command 'org-cycle-item-indentation) + ;; When in the middle of the cycle, try to outdent first. If + ;; it fails, and point is still at initial position, indent. + ;; Else, re-create it at its original position. + (if (eq last-command 'org-cycle-item-indentation) + (cond + ((ignore-errors (org-list-indent-item-generic -1 t struct))) + ((and (= ind (car org-tab-ind-state)) + (ignore-errors (org-list-indent-item-generic 1 t struct)))) + (t (delete-region (point-at-bol) (point-at-eol)) + (org-indent-to-column (car org-tab-ind-state)) + (insert (cdr org-tab-ind-state) " ") + ;; Break cycle + (setq this-command 'identity))) + ;; If a cycle is starting, remember indentation and bullet, + ;; then try to indent. If it fails, try to outdent. + (setq org-tab-ind-state (cons ind bullet)) + (cond + ((ignore-errors (org-list-indent-item-generic 1 t struct))) + ((ignore-errors (org-list-indent-item-generic -1 t struct))) + (t (error "Cannot move item")))) + t)))) (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) - "Sort plain list items. + "Sort list items. The cursor may be at any item of the list that should be sorted. Sublists are not sorted. Checkboxes, if any, are ignored. -Sorting can be alphabetically, numerically, by date/time as given by -a time stamp, by a property or by priority. +Sorting can be alphabetically, numerically, by date/time as given +by a time stamp, by a property or by priority. -Comparing entries ignores case by default. However, with an +Comparing entries ignores case by default. However, with an optional argument WITH-CASE, the sorting considers case as well. The command prompts for the sorting type unless it has been given @@ -1948,26 +2709,25 @@ t By date/time, either the first active time stamp in the entry, if Capital letters will reverse the sort order. -If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a -function to be called with point at the beginning of the record. -It must return either a string or a number that should serve as -the sorting key for that record. It will then use COMPARE-FUNC to -compare entries." +If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies +a function to be called with point at the beginning of the +record. It must return either a string or a number that should +serve as the sorting key for that record. It will then use +COMPARE-FUNC to compare entries." (interactive "P") (let* ((case-func (if with-case 'identity 'downcase)) - (top (org-list-top-point)) - (bottom (org-list-bottom-point)) - (start (org-get-beginning-of-list top)) - (end (org-get-end-of-list bottom)) + (struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (start (org-list-get-list-begin (point-at-bol) struct prevs)) + (end (org-list-get-list-end (point-at-bol) struct prevs)) (sorting-type (progn (message "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") (read-char-exclusive))) (getkey-func (and (= (downcase sorting-type) ?f) - (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil) - (intern getkey-func)))) + (intern (org-icompleting-read "Sort using function: " + obarray 'fboundp t nil nil))))) (message "Sorting items...") (save-restriction (narrow-to-region start end) @@ -1980,11 +2740,12 @@ compare entries." ((= dcst ?f) compare-func) ((= dcst ?t) '<) (t nil))) - (begin-record (lambda () + (next-record (lambda () (skip-chars-forward " \r\t\n") (beginning-of-line))) (end-record (lambda () - (goto-char (org-end-of-item-before-blank end)))) + (goto-char (org-list-get-item-end-before-blank + (point) struct)))) (value-to-sort (lambda () (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") @@ -1993,16 +2754,16 @@ compare entries." (string-to-number (buffer-substring (match-end 0) (point-at-eol)))) ((= dcst ?a) - (buffer-substring (match-end 0) (point-at-eol))) + (funcall case-func + (buffer-substring (match-end 0) (point-at-eol)))) ((= dcst ?t) (cond ;; If it is a timer list, convert timer to seconds ((org-at-item-timer-p) (org-timer-hms-to-secs (match-string 1))) - ((or (org-search-forward-unenclosed org-ts-regexp - (point-at-eol) t) - (org-search-forward-unenclosed org-ts-regexp-both - (point-at-eol) t)) + ((or (re-search-forward org-ts-regexp (point-at-eol) t) + (re-search-forward org-ts-regexp-both + (point-at-eol) t)) (org-time-string-to-seconds (match-string 0))) (t (org-float-time now)))) ((= dcst ?f) @@ -2014,82 +2775,141 @@ compare entries." (error "Invalid key function `%s'" getkey-func))) (t (error "Invalid sorting type `%c'" sorting-type))))))) (sort-subr (/= dcst sorting-type) - begin-record + next-record end-record value-to-sort nil sort-func) - (org-list-repair nil top bottom) + ;; Read and fix list again, as `sort-subr' probably destroyed + ;; its structure. + (org-list-repair) (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting items...done"))))) + ;;; Send and receive lists (defun org-list-parse-list (&optional delete) "Parse the list at point and maybe DELETE it. -Return a list containing first level items as strings and -sublevels as a list of strings." - (let* ((start (goto-char (org-list-top-point))) - (end (org-list-bottom-point)) - output itemsep ltype) - (while (org-search-forward-unenclosed org-item-beginning-re end t) - (save-excursion - (beginning-of-line) - (setq ltype (cond ((org-looking-at-p "^[ \t]*[0-9]") 'ordered) - ((org-at-item-description-p) 'descriptive) - (t 'unordered)))) - (let* ((indent1 (org-get-indentation)) - (nextitem (or (org-get-next-item (point) end) end)) - (item (org-trim (buffer-substring (point) - (org-end-of-item-or-at-child end)))) - (nextindent (if (= (point) end) 0 (org-get-indentation))) - (item (if (string-match - "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" - item) - (replace-match (if (equal (match-string 1 item) " ") - "CBOFF" - "CBON") - t nil item 1) - item))) - (push item output) - (when (> nextindent indent1) - (save-restriction - (narrow-to-region (point) nextitem) - (push (org-list-parse-list) output))))) + +Return a list whose car is a symbol of list type, among +`ordered', `unordered' and `descriptive'. Then, each item is +a list whose car is counter, and cdr are strings and other +sub-lists. Inside strings, check-boxes are replaced by +\"[CBON]\", \"[CBOFF]\" and \"[CBTRANS]\". + +For example, the following list: + +1. first item + + sub-item one + + [X] sub-item two + more text in first item +2. [@3] last item + +will be parsed as: + +\(ordered + \(nil \"first item\" + \(unordered + \(nil \"sub-item one\"\) + \(nil \"[CBON] sub-item two\"\)\) + \"more text in first item\"\) + \(3 \"last item\"\)\) + +Point is left at list end." + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct)) + (top (org-list-get-top-point struct)) + (bottom (org-list-get-bottom-point struct)) + out + parse-item ; for byte-compiler + (get-text + (function + ;; Return text between BEG and END, trimmed, with + ;; checkboxes replaced. + (lambda (beg end) + (let ((text (org-trim (buffer-substring beg end)))) + (if (string-match "\\`\\[\\([-X ]\\)\\]" text) + (replace-match + (let ((box (match-string 1 text))) + (cond + ((equal box " ") "CBOFF") + ((equal box "-") "CBTRANS") + (t "CBON"))) + t nil text 1) + text))))) + (parse-sublist + (function + ;; Return a list whose car is list type and cdr a list of + ;; items' body. + (lambda (e) + (cons (org-list-get-list-type (car e) struct prevs) + (mapcar parse-item e))))) + (parse-item + (function + ;; Return a list containing counter of item, if any, text + ;; and any sublist inside it. + (lambda (e) + (let ((start (save-excursion + (goto-char e) + (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*") + (match-end 0))) + ;; Get counter number. For alphabetic counter, get + ;; its position in the alphabet. + (counter (let ((c (org-list-get-counter e struct))) + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string 0 c)))))) + (childp (org-list-has-child-p e struct)) + (end (org-list-get-item-end e struct))) + ;; If item has a child, store text between bullet and + ;; next child, then recursively parse all sublists. At + ;; the end of each sublist, check for the presence of + ;; text belonging to the original item. + (if childp + (let* ((children (org-list-get-children e struct parents)) + (body (list (funcall get-text start childp)))) + (while children + (let* ((first (car children)) + (sub (org-list-get-all-items first struct prevs)) + (last-c (car (last sub))) + (last-end (org-list-get-item-end last-c struct))) + (push (funcall parse-sublist sub) body) + ;; Remove children from the list just parsed. + (setq children (cdr (member last-c children))) + ;; There is a chunk of text belonging to the + ;; item if last child doesn't end where next + ;; child starts or where item ends. + (unless (= (or (car children) end) last-end) + (push (funcall get-text + last-end (or (car children) end)) + body)))) + (cons counter (nreverse body))) + (list counter (funcall get-text start end)))))))) + ;; Store output, take care of cursor position and deletion of + ;; list, then return output. + (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs))) + (goto-char top) (when delete - (delete-region start end) - (save-match-data - (when (and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re))) - (replace-match "\n")))) - (setq output (nreverse output)) - (push ltype output))) + (delete-region top bottom) + (when (and (not (eq org-list-ending-method 'indent)) + (not (looking-at "[ \t]*$")) + (looking-at org-list-end-re)) + (replace-match ""))) + out)) (defun org-list-make-subtree () "Convert the plain list at point into a subtree." (interactive) - (if (not (org-in-item-p)) + (if (not (ignore-errors (goto-char (org-in-item-p)))) (error "Not in a list") - (let ((list (org-list-parse-list t)) nstars) - (save-excursion - (if (ignore-errors - (org-back-to-heading)) - (progn (looking-at org-complex-heading-regexp) - (setq nstars (length (match-string 1)))) - (setq nstars 0))) - (org-list-make-subtrees list (1+ nstars))))) - -(defun org-list-make-subtrees (list level) - "Convert LIST into subtrees starting at LEVEL." - (if (symbolp (car list)) - (org-list-make-subtrees (cdr list) level) - (mapcar (lambda (item) - (if (stringp item) - (insert (make-string - (if org-odd-levels-only - (1- (* 2 level)) level) ?*) " " item "\n") - (org-list-make-subtrees item (1+ level)))) - list))) + (let ((list (save-excursion (org-list-parse-list t)))) + (insert (org-list-to-subtree list))))) (defun org-list-insert-radio-list () "Insert a radio list template appropriate for this major mode." @@ -2108,8 +2928,8 @@ sublevels as a list of strings." (defun org-list-send-list (&optional maybe) "Send a transformed version of this list to the receiver position. -With argument MAYBE, fail quietly if no transformation is defined for -this list." +With argument MAYBE, fail quietly if no transformation is defined +for this list." (interactive) (catch 'exit (unless (org-at-item-p) (error "Not at a list item")) @@ -2129,7 +2949,7 @@ this list." (top-point (progn (re-search-backward "#\\+ORGLST" nil t) - (re-search-forward org-item-beginning-re bottom-point t) + (re-search-forward (org-item-beginning-re) bottom-point t) (match-beginning 0))) (list (save-restriction (narrow-to-region top-point bottom-point) @@ -2158,7 +2978,7 @@ this list." (defun org-list-to-generic (list params) "Convert a LIST parsed through `org-list-parse-list' to other formats. -Valid parameters PARAMS are +Valid parameters PARAMS are: :ustart String to start an unordered list :uend String to end an unordered list @@ -2176,15 +2996,25 @@ Valid parameters PARAMS are :splice When set to t, return only list body lines, don't wrap them into :[u/o]start and :[u/o]end. Default is nil. -:istart String to start a list item +:istart String to start a list item. +:icount String to start an item with a counter. :iend String to end a list item :isep String to separate items :lsep String to separate sublists - -:cboff String to insert for an unchecked checkbox -:cbon String to insert for a checked checkbox" +:csep String to separate text from a sub-list + +:cboff String to insert for an unchecked check-box +:cbon String to insert for a checked check-box +:cbtrans String to insert for a check-box in transitional state + +Alternatively, each parameter can also be a form returning +a string. These sexp can use keywords `counter' and `depth', +reprensenting respectively counter associated to the current +item, and depth of the current sub-list, starting at 0. +Obviously, `counter' is only available for parameters applying to +items." (interactive) - (let* ((p params) sublist + (let* ((p params) (splicep (plist-get p :splice)) (ostart (plist-get p :ostart)) (oend (plist-get p :oend)) @@ -2197,42 +3027,81 @@ Valid parameters PARAMS are (ddstart (plist-get p :ddstart)) (ddend (plist-get p :ddend)) (istart (plist-get p :istart)) + (icount (plist-get p :icount)) (iend (plist-get p :iend)) (isep (plist-get p :isep)) (lsep (plist-get p :lsep)) + (csep (plist-get p :csep)) (cbon (plist-get p :cbon)) - (cboff (plist-get p :cboff))) - (let ((wrapper - (cond ((eq (car list) 'ordered) - (concat ostart "\n%s" oend "\n")) - ((eq (car list) 'unordered) - (concat ustart "\n%s" uend "\n")) - ((eq (car list) 'descriptive) - (concat dstart "\n%s" dend "\n")))) - rtn term defstart defend) - (while (setq sublist (pop list)) - (cond ((symbolp sublist) nil) - ((stringp sublist) - (when (string-match "^\\(.*\\)[ \t]+::" sublist) - (setq term (org-trim (format (concat dtstart "%s" dtend) - (match-string 1 sublist)))) - (setq sublist (concat ddstart - (org-trim (substring sublist - (match-end 0))) - ddend))) - (if (string-match "\\[CBON\\]" sublist) - (setq sublist (replace-match cbon t t sublist))) - (if (string-match "\\[CBOFF\\]" sublist) - (setq sublist (replace-match cboff t t sublist))) - (if (string-match "\\[-\\]" sublist) - (setq sublist (replace-match "$\\boxminus$" t t sublist))) - (setq rtn (concat rtn istart term sublist iend isep))) - (t (setq rtn (concat rtn ;; previous list - lsep ;; list separator - (org-list-to-generic sublist p) - lsep ;; list separator - ))))) - (format wrapper rtn)))) + (cboff (plist-get p :cboff)) + (cbtrans (plist-get p :cbtrans)) + export-sublist ; for byte-compiler + (export-item + (function + ;; Export an item ITEM of type TYPE, at DEPTH. First + ;; string in item is treated in a special way as it can + ;; bring extra information that needs to be processed. + (lambda (item type depth) + (let* ((counter (pop item)) + (fmt (concat + (cond + ((eq type 'descriptive) + ;; Stick DTSTART to ISTART by + ;; left-trimming the latter. + (concat (let ((s (eval istart))) + (or (and (string-match "[ \t\n\r]+\\'" s) + (replace-match "" t t s)) + istart)) + "%s" (eval ddend))) + ((and counter (eq type 'ordered)) + (concat (eval icount) "%s")) + (t (concat (eval istart) "%s"))) + (eval iend))) + (first (car item))) + ;; Replace checkbox if any is found. + (cond + ((string-match "\\[CBON\\]" first) + (setq first (replace-match cbon t t first))) + ((string-match "\\[CBOFF\\]" first) + (setq first (replace-match cboff t t first))) + ((string-match "\\[CBTRANS\\]" first) + (setq first (replace-match cbtrans t t first)))) + ;; Insert descriptive term if TYPE is `descriptive'. + (when (eq type 'descriptive) + (let* ((complete (string-match "^\\(.*\\)[ \t]+::" first)) + (term (if complete + (save-match-data + (org-trim (match-string 1 first))) + "???")) + (desc (if complete + (org-trim (substring first (match-end 0))) + first))) + (setq first (concat (eval dtstart) term (eval dtend) + (eval ddstart) desc)))) + (setcar item first) + (format fmt + (mapconcat (lambda (e) + (if (stringp e) e + (funcall export-sublist e (1+ depth)))) + item (or (eval csep) ""))))))) + (export-sublist + (function + ;; Export sublist SUB at DEPTH. + (lambda (sub depth) + (let* ((type (car sub)) + (items (cdr sub)) + (fmt (concat (cond + (splicep "%s") + ((eq type 'ordered) + (concat (eval ostart) "%s" (eval oend))) + ((eq type 'descriptive) + (concat (eval dstart) "%s" (eval dend))) + (t (concat (eval ustart) "%s" (eval uend)))) + (eval lsep)))) + (format fmt (mapconcat (lambda (e) + (funcall export-item e type depth)) + items (or (eval isep) "")))))))) + (concat (funcall export-sublist list 0) "\n"))) (defun org-list-to-latex (list &optional params) "Convert LIST into a LaTeX list. @@ -2241,14 +3110,22 @@ with overruling parameters for `org-list-to-generic'." (org-list-to-generic list (org-combine-plists - '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}" - :ustart "\\begin{itemize}" :uend "\\end{itemize}" - :dstart "\\begin{description}" :dend "\\end{description}" - :dtstart "[" :dtend "]" - :ddstart "" :ddend "" - :istart "\\item " :iend "" - :isep "\n" :lsep "\n" - :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}") + '(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}" + :ustart "\\begin{itemize}\n" :uend "\\end{itemize}" + :dstart "\\begin{description}\n" :dend "\\end{description}" + :dtstart "[" :dtend "] " + :istart "\\item " :iend "\n" + :icount (let ((enum (nth depth '("i" "ii" "iii" "iv")))) + (if enum + ;; LaTeX increments counter just before + ;; using it, so set it to the desired + ;; value, minus one. + (format "\\setcounter{enum%s}{%s}\n\\item " + enum (1- counter)) + "\\item ")) + :csep "\n" + :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}" + :cbtrans "\\texttt{[-]}") params))) (defun org-list-to-html (list &optional params) @@ -2258,14 +3135,16 @@ with overruling parameters for `org-list-to-generic'." (org-list-to-generic list (org-combine-plists - '(:splicep nil :ostart "<ol>" :oend "</ol>" - :ustart "<ul>" :uend "</ul>" - :dstart "<dl>" :dend "</dl>" - :dtstart "<dt>" :dtend "</dt>" + '(:splice nil :ostart "<ol>\n" :oend "\n</ol>" + :ustart "<ul>\n" :uend "\n</ul>" + :dstart "<dl>\n" :dend "\n</dl>" + :dtstart "<dt>" :dtend "</dt>\n" :ddstart "<dd>" :ddend "</dd>" :istart "<li>" :iend "</li>" - :isep "\n" :lsep "\n" - :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>") + :icount (format "<li value=\"%s\">" counter) + :isep "\n" :lsep "\n" :csep "\n" + :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>" + :cbtrans "<code>[-]</code>") params))) (defun org-list-to-texinfo (list &optional params) @@ -2275,16 +3154,52 @@ with overruling parameters for `org-list-to-generic'." (org-list-to-generic list (org-combine-plists - '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize" - :ustart "@enumerate" :uend "@end enumerate" - :dstart "@table" :dend "@end table" - :dtstart "@item " :dtend "\n" - :ddstart "" :ddend "" - :istart "@item\n" :iend "" - :isep "\n" :lsep "\n" - :cbon "@code{[X]}" :cboff "@code{[ ]}") + '(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize" + :ustart "@enumerate\n" :uend "@end enumerate" + :dstart "@table @asis\n" :dend "@end table" + :dtstart " " :dtend "\n" + :istart "@item\n" :iend "\n" + :icount "@item\n" + :csep "\n" + :cbon "@code{[X]}" :cboff "@code{[ ]}" + :cbtrans "@code{[-]}") params))) +(defun org-list-to-subtree (list &optional params) + "Convert LIST into an Org subtree. +LIST is as returned by `org-list-parse-list'. PARAMS is a property list +with overruling parameters for `org-list-to-generic'." + (let* ((rule (cdr (assq 'heading org-blank-before-new-entry))) + (level (org-reduced-level (or (org-current-level) 0))) + (blankp (or (eq rule t) + (and (eq rule 'auto) + (save-excursion + (outline-previous-heading) + (org-previous-line-empty-p))))) + (get-stars + (function + ;; Return the string for the heading, depending on depth D + ;; of current sub-list. + (lambda (d) + (let ((oddeven-level (+ level d 1))) + (concat (make-string (if org-odd-levels-only + (1- (* 2 oddeven-level)) + oddeven-level) + ?*) + " ")))))) + (org-list-to-generic + list + (org-combine-plists + '(:splice t + :dtstart " " :dtend " " + :istart (funcall get-stars depth) + :icount (funcall get-stars depth) + :isep (if blankp "\n\n" "\n") + :csep (if blankp "\n\n" "\n") + :cbon "DONE" :cboff "TODO" :cbtrans "TODO") + params)))) + (provide 'org-list) +;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8 ;;; org-list.el ends here diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el index 101743727c8..9c1089994ba 100644 --- a/lisp/org/org-mac-message.el +++ b/lisp/org/org-mac-message.el @@ -1,11 +1,11 @@ ;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> ;; Christopher Suckling <suckling at gmail dot com> -;; Version: 7.4 +;; Version: 7.7 ;; Keywords: outlines, hypermedia, calendar, wp ;; This file is part of GNU Emacs. @@ -214,5 +214,6 @@ list of message:// links to flagged mail after heading." (provide 'org-mac-message) +;; arch-tag: 3806d0c1-abe1-4db6-9c31-f3ed7d4a9b32 ;;; org-mac-message.el ends here diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 5bb86888739..906be613a9c 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -1,11 +1,12 @@ ;;; org-macs.el --- Top-level definitions for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -34,19 +35,26 @@ (eval-and-compile (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly)))) + (defmacro declare-function (fn file &optional arglist fileonly))) + (if (>= emacs-major-version 23) + (defsubst org-char-to-string(c) + "Defsubst to decode UTF-8 character values in emacs 23 and beyond." + (char-to-string c)) + (defsubst org-char-to-string (c) + "Defsubst to decode UTF-8 character values in emacs 22." + (string (decode-char 'ucs c))))) (declare-function org-add-props "org-compat" (string plist &rest props)) (declare-function org-string-match-p "org-compat" (&rest args)) (defmacro org-called-interactively-p (&optional kind) - `(if (featurep 'xemacs) - (interactive-p) + (if (featurep 'xemacs) + `(interactive-p) (if (or (> emacs-major-version 23) (and (>= emacs-major-version 23) (>= emacs-minor-version 2))) - (with-no-warnings (called-interactively-p ,kind)) ;; defined with no argument in <=23.1 - (interactive-p)))) + `(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) @@ -104,13 +112,15 @@ Also, do not record undo information." (org-move-to-column _col)))) (defmacro org-without-partial-completion (&rest body) - `(let ((pc-mode (and (boundp 'partial-completion-mode) - partial-completion-mode))) + `(if (and (boundp 'partial-completion-mode) + partial-completion-mode + (fboundp 'partial-completion-mode)) (unwind-protect (progn - (if pc-mode (partial-completion-mode -1)) + (partial-completion-mode -1) ,@body) - (if pc-mode (partial-completion-mode 1))))) + (partial-completion-mode 1)) + ,@body)) (defmacro org-maybe-intangible (props) "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22. @@ -126,11 +136,12 @@ We use a macro so that the test can happen at compilation time." (defmacro org-with-point-at (pom &rest body) "Move to buffer and point of point-or-marker POM for the duration of BODY." - `(save-excursion - (if (markerp ,pom) (set-buffer (marker-buffer ,pom))) + `(let ((pom ,pom)) (save-excursion - (goto-char (or ,pom (point))) - ,@body))) + (if (markerp pom) (set-buffer (marker-buffer pom))) + (save-excursion + (goto-char (or pom (point))) + ,@body)))) (put 'org-with-point-at 'lisp-indent-function 1) (defmacro org-no-warnings (&rest body) @@ -183,6 +194,7 @@ We use a macro so that the test can happen at compilation time." ;; remember which buffer to undo (push (list _cmd _cline _buf1 _c1 _buf2 _c2) org-agenda-undo-list))))) +(put 'org-with-remote-undo 'lisp-indent-function 1) (defmacro org-no-read-only (&rest body) "Inhibit read-only for BODY." @@ -313,35 +325,53 @@ but it also means that the buffer should stay alive during the operation, because otherwise all these markers will point nowhere." (declare (indent 1)) - `(let ((data (org-outline-overlay-data ,use-markers))) + `(let ((data (org-outline-overlay-data ,use-markers)) + rtn) (unwind-protect (progn - ,@body + (setq rtn (progn ,@body)) (org-set-outline-overlay-data data)) (when ,use-markers (mapc (lambda (c) (and (markerp (car c)) (move-marker (car c) nil)) (and (markerp (cdr c)) (move-marker (cdr c) nil))) - data))))) + data))) + rtn)) + +(defmacro org-with-wide-buffer (&rest body) + "Execute body while temporarily widening the buffer." + `(save-excursion + (save-restriction + (widen) + ,@body))) (defmacro org-with-limited-levels (&rest body) "Execute BODY with limited number of outline levels." - `(let* ((outline-regexp (org-get-limited-outline-regexp))) + `(let* ((org-outline-regexp (org-get-limited-outline-regexp)) + (outline-regexp org-outline-regexp) + (org-outline-regexp-at-bol (concat "^" org-outline-regexp))) ,@body)) +(defvar org-outline-regexp) ; defined in org.el (defvar org-odd-levels-only) ; defined in org.el (defvar org-inlinetask-min-level) ; defined in org-inlinetask.el (defun org-get-limited-outline-regexp () "Return outline-regexp with limited number of levels. The number of levels is controlled by `org-inlinetask-min-level'" (if (or (not (org-mode-p)) (not (featurep 'org-inlinetask))) - - outline-regexp + org-outline-regexp (let* ((limit-level (1- org-inlinetask-min-level)) (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) (format "\\*\\{1,%d\\} " nstars)))) +(defun org-format-seconds (string seconds) + "Compatibility function replacing format-seconds" + (if (fboundp 'format-seconds) + (format-seconds string seconds) + (format-time-string string (seconds-to-time seconds)))) + (provide 'org-macs) +;; arch-tag: 7e6a73ce-aac9-4fc0-9b30-ce6f89dc6668 ;;; org-macs.el ends here diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el index be0c3b93d1e..2f095949858 100644 --- a/lisp/org/org-mew.el +++ b/lisp/org/org-mew.el @@ -1,11 +1,11 @@ ;;; org-mew.el --- Support for links to Mew messages from within Org-mode -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. @@ -135,5 +135,6 @@ (provide 'org-mew) +;; arch-tag: 07ccdca7-6020-4941-a593-588a1e51b870 ;;; org-mew.el ends here diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index 1767ddca1ee..c75bed37b8c 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -1,11 +1,12 @@ ;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -82,27 +83,28 @@ supported by MH-E." "Store a link to an MH-E folder or message." (when (or (equal major-mode 'mh-folder-mode) (equal major-mode 'mh-show-mode)) - (let* ((from (org-mhe-get-header "From:")) - (to (org-mhe-get-header "To:")) - (message-id (org-mhe-get-header "Message-Id:")) - (subject (org-mhe-get-header "Subject:")) - (date (org-mhe-get-header "Date:")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) - link desc) - (org-store-link-props :type "mh" :from from :to to - :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq desc (org-email-link-description)) - (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" - (org-remove-angle-brackets message-id))) - (org-add-link-props :link link :description desc) - link))) + (save-window-excursion + (let* ((from (org-mhe-get-header "From:")) + (to (org-mhe-get-header "To:")) + (message-id (org-mhe-get-header "Message-Id:")) + (subject (org-mhe-get-header "Subject:")) + (date (org-mhe-get-header "Date:")) + (date-ts (and date (format-time-string + (org-time-stamp-format t) (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) + link desc) + (org-store-link-props :type "mh" :from from :to to + :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) + (setq desc (org-email-link-description)) + (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" + (org-remove-angle-brackets message-id))) + (org-add-link-props :link link :description desc) + link)))) (defun org-mhe-open (path) "Follow an MH-E message link specified by PATH." @@ -224,5 +226,6 @@ folders." (provide 'org-mhe) +;; arch-tag: dcb05484-8627-491d-a8c1-01dbd2bde4ae ;;; org-mhe.el ends here diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el index e4826f801c0..c71db81b52f 100644 --- a/lisp/org/org-mks.el +++ b/lisp/org/org-mks.el @@ -1,11 +1,11 @@ ;;; org-mks.el --- Multi-key-selection for Org-mode -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -132,5 +132,6 @@ only the bare key is returned." (provide 'org-mks) +;; arch-tag: 4ea90d0e-c6e4-4684-bd61-baf878712f9f ;;; org-mks.el ends here diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index a36f1fc2d5e..40fe7031c6f 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -1,10 +1,10 @@ ;;; org-mobile.el --- Code for asymmetric sync with a mobile device -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -38,6 +38,9 @@ (eval-when-compile (require 'cl)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) + (defgroup org-mobile nil "Options concerning support for a viewer/editor on a mobile device." :tag "Org Mobile" @@ -63,6 +66,11 @@ org-agenda-text-search-extra-files (repeat :inline t :tag "Additional files" (file)))) +(defcustom org-mobile-files-exclude-regexp "" + "A regexp to exclude files from `org-mobile-files'." + :group 'org-mobile + :type 'regexp) + (defcustom org-mobile-directory "" "The WebDAV directory where the interaction with the mobile takes place." :group 'org-mobile @@ -128,7 +136,7 @@ been appended to the file given here. This file should be in This should not be changed, because MobileOrg assumes this name.") (defcustom org-mobile-index-file "index.org" - "The index file with inks to all Org files that should be loaded by MobileOrg. + "The index file with links to all Org files that should be loaded by MobileOrg. Relative to `org-mobile-directory'. The Address field in the MobileOrg setup should point to this file." :group 'org-mobile @@ -241,7 +249,8 @@ using `rsync' or `scp'.") (setq org-mobile-checksum-files nil)) (defun org-mobile-files-alist () - "Expand the list in `org-mobile-files' to a list of existing files." + "Expand the list in `org-mobile-files' to a list of existing files. +Also exclude files matching `org-mobile-files-exclude-regexp'." (let* ((include-archives (and (member 'org-agenda-text-search-extra-files org-mobile-files) (member 'agenda-archives org-agenda-text-search-extra-files) @@ -263,6 +272,13 @@ using `rsync' or `scp'.") (list f)) (t nil))) org-mobile-files))) + (files (delete + nil + (mapcar (lambda (f) + (unless (and (not (string= org-mobile-files-exclude-regexp "")) + (string-match org-mobile-files-exclude-regexp f)) + (identity f))) + files))) (orgdir-uname (file-name-as-directory (file-truename org-directory))) (orgdir-re (concat "\\`" (regexp-quote orgdir-uname))) uname seen rtn file link-name) @@ -292,9 +308,9 @@ create all custom agenda views, for upload to the mobile phone." (org-agenda-redo-command org-agenda-redo-command)) (save-excursion (save-window-excursion + (run-hooks 'org-mobile-pre-push-hook) (org-mobile-check-setup) (org-mobile-prepare-file-lists) - (run-hooks 'org-mobile-pre-push-hook) (message "Creating agendas...") (let ((inhibit-redisplay t)) (org-mobile-create-sumo-agenda)) (message "Creating agendas...done") @@ -562,8 +578,9 @@ The table of checksums is written to the file mobile-checksums." " " match "</after>")) settings)) (push (list type match settings) new)) - ((symbolp (nth 2 e)) - ;; A user-defined function, not sure how to handle that yet + ((or (functionp (nth 2 e)) (symbolp (nth 2 e))) + ;; A user-defined function, which can do anything, so simply + ;; ignore it. ) (t ;; a block agenda @@ -617,12 +634,12 @@ The table of checksums is written to the file mobile-checksums." (get-text-property (point) 'org-marker))) (setq sexp (member (get-text-property (point) 'type) '("diary" "sexp"))) - (if (setq pl (get-text-property (point) 'prefix-length)) + (if (setq pl (text-property-any (point) (point-at-eol) 'org-heading t)) (progn (setq prefix (org-trim (buffer-substring - (point) (+ (point) pl))) + (point) pl)) line (org-trim (buffer-substring - (+ (point) pl) + pl (point-at-eol)))) (delete-region (point-at-bol) (point-at-eol)) (insert line "<before>" prefix "</before>") @@ -660,7 +677,7 @@ The table of checksums is written to the file mobile-checksums." (org-mobile-escape-olp (nth 4 (org-heading-components)))))) (defun org-mobile-escape-olp (s) - (let ((table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f")))) + (let ((table '(?: ?/))) (org-link-escape s table))) ;;;###autoload @@ -895,7 +912,7 @@ If BEG and END are given, only do this in that region." (buffer-file-name (current-buffer)))))) (error (setq org-mobile-error msg)))) (when org-mobile-error - (switch-to-buffer (marker-buffer marker)) + (org-pop-to-buffer-same-window (marker-buffer marker)) (goto-char marker) (incf cnt-error) (insert (if (stringp (nth 1 org-mobile-error)) @@ -969,11 +986,10 @@ is currently a noop.") (if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link)) nil (let ((file (match-string 1 link)) - (path (match-string 2 link)) - (table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f")))) - (setq file (org-link-unescape file table)) + (path (match-string 2 link))) + (setq file (org-link-unescape file)) (setq file (expand-file-name file org-directory)) - (setq path (mapcar (lambda (x) (org-link-unescape x table)) + (setq path (mapcar 'org-link-unescape (org-split-string path "/"))) (org-find-olp (cons file path)))))) @@ -1083,6 +1099,7 @@ A and B must be strings or nil." (provide 'org-mobile) +;; arch-tag: ace0e26c-58f2-4309-8a61-05ec1535f658 ;;; org-mobile.el ends here diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index ddd476e98b2..8d59073ce40 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -1,10 +1,10 @@ ;;; org-mouse.el --- Better mouse support for org-mode -;; Copyright (C) 2006-2011 Free Software Foundation +;; 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.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -149,6 +149,8 @@ (newhead hdmarker &optional fixface just-this)) (declare-function org-verify-change-for-undo "org-agenda" (l1 l2)) (declare-function org-apply-on-list "org-list" (function init-value &rest args)) +(declare-function org-agenda-earlier "org-agenda" (arg)) +(declare-function org-agenda-later "org-agenda" (arg)) (defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " "Regular expression that matches a plain list.") @@ -476,11 +478,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (defun org-mouse-agenda-type (type) (case type - (tags "Tags: ") - (todo "TODO: ") - (tags-tree "Tags tree: ") - (todo-tree "TODO tree: ") - (occur-tree "Occur tree: ") + ('tags "Tags: ") + ('todo "TODO: ") + ('tags-tree "Tags tree: ") + ('todo-tree "TODO tree: ") + ('occur-tree "Occur tree: ") (t "Agenda command ???"))) @@ -526,7 +528,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ("Check Tags" ,@(org-mouse-keyword-menu (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) - (lambda (tag) (org-tags-sparse-tree nil tag))) + #'(lambda (tag) (org-tags-sparse-tree nil tag))) "--" ["Custom Tag ..." org-tags-sparse-tree t]) ["Check Phrase ..." org-occur] @@ -537,18 +539,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ("Display Tags" ,@(org-mouse-keyword-menu (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) - (lambda (tag) (org-tags-view nil tag))) + #'(lambda (tag) (org-tags-view nil tag))) "--" ["Custom Tag ..." org-tags-view t]) ["Display Calendar" org-goto-calendar t] "--" ,@(org-mouse-keyword-menu (mapcar 'car org-agenda-custom-commands) - (lambda (key) + #'(lambda (key) (eval `(flet ((read-char-exclusive () (string-to-char ,key))) (org-agenda nil)))) nil - (lambda (key) + #'(lambda (key) (let ((entry (assoc key org-agenda-custom-commands))) (org-mouse-clip-text (cond @@ -580,8 +582,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (defun org-mouse-for-each-item (funct) ;; Functions called by `org-apply-on-list' need an argument (let ((wrap-fun (lambda (c) (funcall funct)))) - (when (org-in-item-p) - (org-apply-on-list wrap-fun nil)))) + (when (ignore-errors (goto-char (org-in-item-p))) + (save-excursion (org-apply-on-list wrap-fun nil))))) (defun org-mouse-bolp () "Return true if there only spaces, tabs, and '*' before point. @@ -614,12 +616,12 @@ This means, between the beginning of line and the point." (beginning-of-line)) (defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate) - (if (eq major-mode 'org-mode) + (if (org-mode-p) (org-mouse-insert-item text) ad-do-it)) (defadvice dnd-open-file (around org-mouse-dnd-open-file activate) - (if (eq major-mode 'org-mode) + (if (org-mode-p) (org-mouse-insert-item uri) ad-do-it)) @@ -633,7 +635,7 @@ This means, between the beginning of line and the point." (defun org-mouse-match-todo-keyword () (save-excursion (org-back-to-heading) - (if (looking-at outline-regexp) (goto-char (match-end 0))) + (if (looking-at org-outline-regexp) (goto-char (match-end 0))) (or (looking-at (concat " +" org-todo-regexp " *")) (looking-at " \\( *\\)")))) @@ -832,7 +834,7 @@ This means, between the beginning of line and the point." ("Tags and Priorities" ,@(org-mouse-keyword-menu (org-mouse-priority-list) - (lambda (keyword) + #'(lambda (keyword) (org-mouse-set-priority (string-to-char keyword))) priority "Priority %s") "--" @@ -905,7 +907,7 @@ This means, between the beginning of line and the point." (mouse-drag-region event))) (add-hook 'org-mode-hook - (lambda () + #'(lambda () (setq org-mouse-context-menu-function 'org-mouse-context-menu) (when (memq 'context-menu org-mouse-features) @@ -925,7 +927,7 @@ This means, between the beginning of line and the point." (when (memq 'activate-stars org-mouse-features) (font-lock-add-keywords nil - `((,outline-regexp + `((,org-outline-regexp 0 `(face org-link mouse-face highlight keymap ,org-mouse-map) 'prepend)) t)) @@ -997,7 +999,7 @@ This means, between the beginning of line and the point." (end-of-line) (if (eobp) (newline) (forward-char))) - (when (looking-at outline-regexp) + (when (looking-at org-outline-regexp) (let ((level (- (match-end 0) (match-beginning 0)))) (when (> end (match-end 0)) (outline-end-of-subtree) @@ -1017,11 +1019,11 @@ This means, between the beginning of line and the point." (replace-text (concat (match-string 0) "* "))) (beginning-of-line 2) (save-excursion - (while (not (or (eobp) (looking-at outline-regexp))) + (while (not (or (eobp) (looking-at org-outline-regexp))) (when (looking-at org-mouse-plain-list-regexp) (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1))))) (forward-line))) - (while (not (or (eobp) (looking-at outline-regexp))) + (while (not (or (eobp) (looking-at org-outline-regexp))) (when (and (looking-at org-mouse-plain-list-regexp) (eq minlevel (- (match-end 1) (match-beginning 1)))) (replace-match replace-text)) @@ -1128,20 +1130,22 @@ This means, between the beginning of line and the point." ; (setq org-agenda-mode-hook nil) +(defvar org-agenda-mode-map) (add-hook 'org-agenda-mode-hook - (lambda () + #'(lambda () (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) (org-defkey org-agenda-mode-map [drag-mouse-3] - (lambda (event) (interactive "e") + #'(lambda (event) (interactive "e") (case (org-mouse-get-gesture event) (:left (org-agenda-earlier 1)) (:right (org-agenda-later 1))))))) (provide 'org-mouse) +;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f ;;; org-mouse.el ends here diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el new file mode 100644 index 00000000000..e34ab38e4e5 --- /dev/null +++ b/lisp/org/org-pcomplete.el @@ -0,0 +1,282 @@ +;;; org-pcomplete.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.7 +;; +;; 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-pcomplete-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-pcomplete-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 + (copy-sequence + (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 (copy-sequence 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 + (copy-sequence + (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-pcomplete-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-pcomplete) + +;; arch-tag: + +;;; org-pcomplete.el ends here diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 10722403f7e..7f1bbac06b6 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -1,11 +1,11 @@ ;;; org-plot.el --- Support for plotting from Org-mode -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: tables, plotting ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -206,18 +206,18 @@ manner suitable for prepending to a user-specified script." (y-labels (plist-get params :ylabels)) (plot-str "'%s' using %s%d%s with %s title '%s'") (plot-cmd (case type - (2d "plot") - (3d "splot") - (grid "splot"))) + ('2d "plot") + ('3d "splot") + ('grid "splot"))) (script "reset") plot-lines) (flet ((add-to-script (line) (setf script (format "%s\n%s" script line)))) (when file ;; output file (add-to-script (format "set term %s" (file-name-extension file))) (add-to-script (format "set output '%s'" file))) (case type ;; type - (2d ()) - (3d (if map (add-to-script "set map"))) - (grid (if map + ('2d ()) + ('3d (if map (add-to-script "set map"))) + ('grid (if map (add-to-script "set pm3d map") (add-to-script "set pm3d")))) (when title (add-to-script (format "set title '%s'" title))) ;; title @@ -243,7 +243,7 @@ manner suitable for prepending to a user-specified script." "%Y-%m-%d-%H:%M:%S") "\""))) (unless preface (case type ;; plot command - (2d (dotimes (col num-cols) + ('2d (dotimes (col num-cols) (unless (and (equal type '2d) (or (and ind (equal (+ 1 col) ind)) (and deps (not (member (+ 1 col) deps))))) @@ -258,10 +258,10 @@ manner suitable for prepending to a user-specified script." with (or (nth col col-labels) (format "%d" (+ 1 col)))) plot-lines))))) - (3d + ('3d (setq plot-lines (list (format "'%s' matrix with %s title ''" data-file with)))) - (grid + ('grid (setq plot-lines (list (format "'%s' with %s title ''" data-file with))))) (add-to-script @@ -305,9 +305,9 @@ line directly before or after the table." (setf params (org-plot/collect-options params)))) ;; dump table to datafile (very different for grid) (case (plist-get params :plot-type) - (2d (org-plot/gnuplot-to-data table data-file params)) - (3d (org-plot/gnuplot-to-data table data-file params)) - (grid (let ((y-labels (org-plot/gnuplot-to-grid-data + ('2d (org-plot/gnuplot-to-data table data-file params)) + ('3d (org-plot/gnuplot-to-data table data-file params)) + ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data table data-file params))) (when y-labels (plist-put params :ylabels y-labels))))) ;; check for timestamp ind column @@ -350,4 +350,5 @@ line directly before or after the table." (provide 'org-plot) +;; arch-tag: 5763f7c6-0c75-416d-b070-398ee4ec0eca ;;; org-plot.el ends here diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 018eadf9a23..42a71224aea 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -1,6 +1,7 @@ ;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. ;; -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Author: Daniel M German <dmg AT uvic DOT org> @@ -8,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.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. ;; @@ -129,6 +130,18 @@ (filename &optional up)) (declare-function server-edit "server" (&optional arg)) +(define-obsolete-function-alias + 'org-protocol-unhex-compound 'org-link-unescape-compound + "2011-02-17") + +(define-obsolete-function-alias + 'org-protocol-unhex-string 'org-link-unescape + "2011-02-17") + +(define-obsolete-function-alias + 'org-protocol-unhex-single-byte-sequence + 'org-link-unescape-single-byte-sequence + "2011-02-17") (defgroup org-protocol nil "Intercept calls from emacsclient to trigger custom actions. @@ -151,7 +164,6 @@ for `org-protocol-the-protocol' and sub-procols defined in "Default protocols to use. See `org-protocol-protocol-alist' for a description of this variable.") - (defconst org-protocol-the-protocol "org-protocol" "This is the protocol to detect if org-protocol.el is loaded. `org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold @@ -159,11 +171,10 @@ the sub-protocols that trigger the required action. You will have to define just one protocol handler OS-wide (MS-Windows) or per application (Linux). That protocol handler should call emacsclient.") - ;;; User variables: (defcustom org-protocol-reverse-list-of-files t - "* Non-nil means re-reverse the list of filenames passed on the command line. + "Non-nil means re-reverse the list of filenames passed on the command line. The filenames passed on the command line are passed to the emacs-server in reverse order. Set to t (default) to re-reverse the list, i.e. use the sequence on the command line. If nil, the sequence of the filenames is @@ -171,9 +182,8 @@ unchanged." :group 'org-protocol :type 'boolean) - (defcustom org-protocol-project-alist nil - "* Map URLs to local filenames for `org-protocol-open-source' (open-source). + "Map URLs to local filenames for `org-protocol-open-source' (open-source). Each element of this list must be of the form: @@ -216,7 +226,6 @@ Consider using the interactive functions `org-protocol-create' and :group 'org-protocol :type 'alist) - (defcustom org-protocol-protocol-alist nil "* Register custom handlers for org-protocol. @@ -260,7 +269,9 @@ Here is an example: :type '(alist)) (defcustom org-protocol-default-template-key nil - "The default org-remember-templates key to use." + "The default template key to use. +This is usually a single character string but can also be a +string with two characters." :group 'org-protocol :type 'string) @@ -274,95 +285,27 @@ Slashes are sanitized to double slashes here." (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/"))))) uri) - -(defun org-protocol-split-data(data &optional unhexify separator) - "Split, what an org-protocol handler function gets as only argument. -DATA is that one argument. DATA is split at each occurrence of -SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is +(defun org-protocol-split-data (data &optional unhexify separator) + "Split what an org-protocol handler function gets as only argument. +DATA is that one argument. DATA is split at each occurrence of +SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is nil, assume \"/+\". The results of that splitting are returned -as a list. If UNHEXIFY is non-nil, hex-decode each split part. If -UNHEXIFY is a function, use that function to decode each split +as a list. If UNHEXIFY is non-nil, hex-decode each split part. +If UNHEXIFY is a function, use that function to decode each split part." (let* ((sep (or separator "/+")) (split-parts (split-string data sep))) (if unhexify (if (fboundp unhexify) (mapcar unhexify split-parts) - (mapcar 'org-protocol-unhex-string split-parts)) + (mapcar 'org-link-unescape split-parts)) split-parts))) -;; This inline function is needed in org-protocol-unhex-compound to do -;; the right thing to decode UTF-8 char integer values. -(eval-when-compile - (if (>= emacs-major-version 23) - (defsubst org-protocol-char-to-string(c) - "Defsubst to decode UTF-8 character values in emacs 23 and beyond." - (char-to-string c)) - (defsubst org-protocol-char-to-string (c) - "Defsubst to decode UTF-8 character values in emacs 22." - (string (decode-char 'ucs c))))) - -(defun org-protocol-unhex-string(str) - "Unhex hexified unicode strings as returned from the JavaScript function -encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'." - (setq str (or str "")) - (let ((tmp "") - (case-fold-search t)) - (while (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str) - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (hex (match-string 0 str)) - (replacement (org-protocol-unhex-compound (upcase hex)))) - (setq tmp (concat tmp (substring str 0 start) replacement)) - (setq str (substring str end)))) - (setq tmp (concat tmp str)) - tmp)) - - -(defun org-protocol-unhex-compound (hex) - "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ü'." - (let* ((bytes (remove "" (split-string hex "%"))) - (ret "") - (eat 0) - (sum 0)) - (while bytes - (let* ((b (pop bytes)) - (a (elt b 0)) - (b (elt b 1)) - (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0))) - (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0))) - (val (+ (lsh c1 4) c2)) - (shift - (if (= 0 eat) ;; new byte - (if (>= val 252) 6 - (if (>= val 248) 5 - (if (>= val 240) 4 - (if (>= val 224) 3 - (if (>= val 192) 2 0))))) - 6)) - (xor - (if (= 0 eat) ;; new byte - (if (>= val 252) 252 - (if (>= val 248) 248 - (if (>= val 240) 240 - (if (>= val 224) 224 - (if (>= val 192) 192 0))))) - 128))) - (if (>= val 192) (setq eat shift)) - (setq val (logxor val xor)) - (setq sum (+ (lsh sum shift) val)) - (if (> eat 0) (setq eat (- eat 1))) - (when (= 0 eat) - (setq ret (concat ret (org-protocol-char-to-string sum))) - (setq sum 0)) - )) ;; end (while bytes - ret )) - (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) "Greedy handlers might receive a list like this from emacsclient: - '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") + '((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") where \"/dir/\" is the absolute path to emacsclients working directory. This -function transforms it into a flat list utilizing `org-protocol-flatten' and +function transforms it into a flat list using `org-protocol-flatten' and transforms the elements of that list as follows: If strip-path is non-nil, remove the \"/dir/\" prefix from all members of @@ -402,7 +345,6 @@ returned list." ret) l))) - (defun org-protocol-flatten (l) "Greedy handlers might receive a list like this from emacsclient: '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") @@ -413,6 +355,7 @@ This function transforms it into a flat list." (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) (list l)))) + ;;; Standard protocol handlers: (defun org-protocol-store-link (fname) @@ -444,7 +387,7 @@ The sub-protocol used to reach this function is set in uri)) nil) -(defun org-protocol-remember (info) +(defun org-protocol-remember (info) "Process an org-protocol://remember:// style url. The location for a browser's bookmark has to look like this: @@ -457,12 +400,12 @@ The location for a browser's bookmark has to look like this: See the docs for `org-protocol-capture' for more information." (if (and (boundp 'org-stored-links) - (or (fboundp 'org-capture)) + (fboundp 'org-capture) (org-protocol-do-capture info 'org-remember)) - (message "Org-mode not loaded.")) + (message "Item remembered.")) nil) -(defun org-protocol-capture (info) +(defun org-protocol-capture (info) "Process an org-protocol://capture:// style url. The sub-protocol used to reach this function is set in @@ -484,21 +427,21 @@ But you may prepend the encoded URL with a character and a slash like so: Now template ?b will be used." (if (and (boundp 'org-stored-links) - (or (fboundp 'org-capture)) + (fboundp 'org-capture) (org-protocol-do-capture info 'org-capture)) - (message "Org-mode not loaded.")) + (message "Item captured.")) nil) (defun org-protocol-do-capture (info capture-func) "Support `org-capture' and `org-remember' alike. CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." (let* ((parts (org-protocol-split-data info t)) - (template (or (and (= 1 (length (car parts))) (pop parts)) + (template (or (and (>= 2 (length (car parts))) (pop parts)) org-protocol-default-template-key)) (url (org-protocol-sanitize-uri (car parts))) (type (if (string-match "^\\([a-z]+\\):" url) (match-string 1 url))) - (title(or (cadr parts) "")) + (title (or (cadr parts) "")) (region (or (caddr parts) "")) (orglink (org-make-link-string url (if (string-match "[^[:space:]]" title) title url))) @@ -515,7 +458,6 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." (raise-frame) (funcall capture-func nil template))) - (defun org-protocol-open-source (fname) "Process an org-protocol://open-source:// style url. @@ -526,11 +468,10 @@ The location for a browser's bookmark should look like this: javascript:location.href='org-protocol://open-source://'+ \\ encodeURIComponent(location.href)" - ;; As we enter this function for a match on our protocol, the return value ;; defaults to nil. (let ((result nil) - (f (org-protocol-unhex-string fname))) + (f (org-link-unescape fname))) (catch 'result (dolist (prolist org-protocol-project-alist) (let* ((base-url (plist-get (cdr prolist) :base-url)) @@ -595,12 +536,14 @@ function returns nil, the filename is removed from the list of filenames passed from emacsclient to the server. If the function returns a non nil value, that value is passed to the server as filename." - (let ((sub-protocols (append org-protocol-protocol-alist org-protocol-protocol-alist-default))) + (let ((sub-protocols (append org-protocol-protocol-alist + org-protocol-protocol-alist-default))) (catch 'fname (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+"))) (when (string-match the-protocol fname) (dolist (prolist sub-protocols) - (let ((proto (concat the-protocol (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) + (let ((proto (concat the-protocol + (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) (when (string-match proto fname) (let* ((func (plist-get (cdr prolist) :function)) (greedy (plist-get (cdr prolist) :greedy)) @@ -617,7 +560,6 @@ as filename." ;; (message "fname: %s" fname) fname))) - (defadvice server-visit-files (before org-protocol-detect-protocol-server activate) "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'." (let ((flist (if org-protocol-reverse-list-of-files @@ -626,16 +568,17 @@ as filename." (client (ad-get-arg 1))) (catch 'greedy (dolist (var flist) - (let ((fname (expand-file-name (car var)))) ;; `\' to `/' on windows. FIXME: could this be done any better? - (setq fname (org-protocol-check-filename-for-protocol fname (member var flist) client)) + ;; `\' to `/' on windows. FIXME: could this be done any better? + (let ((fname (expand-file-name (car var)))) + (setq fname (org-protocol-check-filename-for-protocol + fname (member var flist) client)) (if (eq fname t) ;; greedy? We need the `t' return value. (progn (ad-set-arg 0 nil) (throw 'greedy t)) (if (stringp fname) ;; probably filename (setcar var fname) - (ad-set-arg 0 (delq var (ad-get-arg 0)))))) - )))) + (ad-set-arg 0 (delq var (ad-get-arg 0)))))))))) ;;; Org specific functions: @@ -651,8 +594,7 @@ most of the work." (message "Not in an org-project. Did mean %s?" (substitute-command-keys"\\[org-protocol-create]"))))) - -(defun org-protocol-create(&optional project-plist) +(defun org-protocol-create (&optional project-plist) "Create a new org-protocol project interactively. An org-protocol project is an entry in `org-protocol-project-alist' which is used by `org-protocol-open-source'. @@ -660,15 +602,15 @@ Optionally use project-plist to initialize the defaults for this project. If project-plist is the CDR of an element in `org-publish-project-alist', reuse :base-directory, :html-extension and :base-extension." (interactive) - (let ((working-dir (expand-file-name(or (plist-get project-plist :base-directory) default-directory))) + (let ((working-dir (expand-file-name + (or (plist-get project-plist :base-directory) + default-directory))) (base-url "http://orgmode.org/worg/") (strip-suffix (or (plist-get project-plist :html-extension) ".html")) (working-suffix (if (plist-get project-plist :base-extension) (concat "." (plist-get project-plist :base-extension)) ".org")) - (worglet-buffer nil) - (insert-default-directory t) (minibuffer-allow-text-properties nil)) @@ -684,12 +626,12 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse (setq strip-suffix (read-string - (concat "Extension to strip from published URLs ("strip-suffix"): ") + (concat "Extension to strip from published URLs (" strip-suffix "): ") strip-suffix nil strip-suffix t)) (setq working-suffix (read-string - (concat "Extension of editable files ("working-suffix"): ") + (concat "Extension of editable files (" working-suffix "): ") working-suffix nil working-suffix t)) (when (yes-or-no-p "Save the new org-protocol-project to your init file? ") @@ -703,4 +645,5 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse (provide 'org-protocol) +;; arch-tag: b5c5c2ac-77cf-4a94-a649-2163dff95846 ;;; org-protocol.el ends here diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el index 7451587ba2f..67bccae15a2 100644 --- a/lisp/org/org-publish.el +++ b/lisp/org/org-publish.el @@ -1,10 +1,11 @@ ;;; org-publish.el --- publish related org-mode files as a website -;; Copyright (C) 2006-2011 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: David O'Toole <dto@gnu.org> ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> ;; Keywords: hypermedia, outlines, wp -;; Version: 7.4 +;; Version: 7.7 ;; This file is part of GNU Emacs. ;; @@ -40,25 +41,27 @@ ;;; Code: -(defun org-publish-sanitize-plist (plist) - (mapcar (lambda (x) - (or (cdr (assq x '((:index-filename . :sitemap-filename) - (:index-title . :sitemap-title) - (:index-function . :sitemap-function) - (:index-style . :sitemap-style) - (:auto-index . :auto-sitemap)))) - x)) - plist)) - (eval-when-compile (require 'cl)) (require 'org) (require 'org-exp) +(require 'format-spec) (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (fn file &optional arglist fileonly)))) +(defvar org-publish-initial-buffer nil + "The buffer `org-publish' has been called from.") + +(defvar org-publish-temp-files nil + "Temporary list of files to be published.") + +;; Here, so you find the variable right before it's used the first time: +(defvar org-publish-cache nil + "This will cache timestamps and titles for files in publishing projects. +Blocks could hash sha1 values here.") + (defgroup org-publish nil "Options for publishing a set of Org-mode and related files." :tag "Org Publishing" @@ -154,10 +157,8 @@ learn more about their use and default values. :expand-quoted-html `org-export-html-expand' :timestamp `org-export-html-with-timestamp' :publishing-directory `org-export-publishing-directory' - :preamble `org-export-html-preamble' - :postamble `org-export-html-postamble' - :auto-preamble `org-export-html-auto-preamble' - :auto-postamble `org-export-html-auto-postamble' + :html-preamble `org-export-html-preamble' + :html-postamble `org-export-html-postamble' :author `user-full-name' :email `user-mail-address' @@ -178,6 +179,11 @@ sitemap of files or summary page for a given project. `tree' (the directory structure of the source files is reflected in the sitemap). Defaults to `tree'. + :sitemap-sans-extension Remove extension from sitemap's + filenames. Useful to have cool + URIs (see + http://www.w3.org/Provider/Style/URI). + Defaults to nil. If you create a sitemap file, adjust the sorting like this: @@ -185,8 +191,9 @@ sitemap of files or summary page for a given project. Set this to `first' (default) or `last' to display folders first or last, respectively. Any other value will mix files and folders. - :sitemap-alphabetically The site map is normally sorted alphabetically. - Set this explicitly to nil to turn off sorting. + :sitemap-sort-files The site map is normally sorted alphabetically. + You can change this behaviour setting this to + `chronologically', `anti-chronologically' or nil. :sitemap-ignore-case Should sorting be case-sensitive? Default nil. The following properties control the creation of a concept index. @@ -196,8 +203,8 @@ The following properties control the creation of a concept index. Other properties affecting publication. :body-only Set this to 't' to publish only the body of the - documents, excluding everything outside and - including the <body> tags in HTML, or + documents, excluding everything outside and + including the <body> tags in HTML, or \begin{document}..\end{document} in LaTeX." :group 'org-publish :type 'alist) @@ -232,13 +239,18 @@ Any changes made by this hook will be saved." :group 'org-publish :type 'hook) -(defcustom org-publish-sitemap-sort-alphabetically t - "Should sitemaps be sorted alphabetically by default? +(defcustom org-publish-sitemap-sort-files 'alphabetically + "How sitemaps files should be sorted by default? +Possible values are `alphabetically', `chronologically', `anti-chronologically' and nil. +If `alphabetically', files will be sorted alphabetically. +If `chronologically', files will be sorted with older modification time first. +If `anti-chronologically', files will be sorted with newer modification time first. +nil won't sort files. You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-alphabetically'." +`org-publish-project-alist', using `:sitemap-sort-files'." :group 'org-publish - :type 'boolean) + :type 'symbol) (defcustom org-publish-sitemap-sort-folders 'first "A symbol, denoting if folders are sorted first in sitemaps. @@ -260,6 +272,37 @@ You can overwrite this default per project in your :group 'org-publish :type 'boolean) +(defcustom org-publish-sitemap-date-format "%Y-%m-%d" + "Format for `format-time-string' which is used to print a date +in the sitemap." + :group 'org-publish + :type 'string) + +(defcustom org-publish-sitemap-file-entry-format "%t" + "How a sitemap file entry is formated. +You could use brackets to delimit on what part the link will be. + +%t is the title. +%a is the author. +%d is the date formated using `org-publish-sitemap-date-format'." + :group 'org-publish + :type 'string) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Sanitize-plist (FIXME why?) + +(defun org-publish-sanitize-plist (plist) + ;; FIXME document + (mapcar (lambda (x) + (or (cdr (assq x '((:index-filename . :sitemap-filename) + (:index-title . :sitemap-title) + (:index-function . :sitemap-function) + (:index-style . :sitemap-style) + (:auto-index . :auto-sitemap)))) + x)) + plist)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Timestamp-related functions @@ -273,7 +316,7 @@ You can overwrite this default per project in your "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC. TRUE-PUB-DIR is where the file will truly end up. Currently we are not using this - maybe it can eventually be used to check if the file is present at -the target location, and how old it is. Right ow we cannot do this, because +the target location, and how old it is. Right now we cannot do this, because we do not know under what file name the file will be stored - the publishing function can still decide about that independently." (let ((rtn @@ -306,20 +349,6 @@ If there is no timestamp, create one." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; - -(defvar org-publish-initial-buffer nil - "The buffer `org-publish' has been called from.") -(defvar org-publish-temp-files nil - "Temporary list of files to be published.") - -;; Here, so you find the variable right before it's used the first time: -(defvar org-publish-cache nil - "This will cache timestamps and titles for files in publishing projects. -Blocks could hash sha1 values here.") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Compatibility aliases ;; Delete-dups is not in Emacs <22 @@ -341,6 +370,8 @@ This is a compatibility function for Emacsen without `delete-dups'." (declare-function org-publish-delete-dups "org-publish" (list)) (declare-function find-lisp-find-files "find-lisp" (directory regexp)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Getting project information out of org-publish-project-alist @@ -358,40 +389,50 @@ This splices all the components into the list." (push p rtn))) (nreverse (org-publish-delete-dups (delq nil rtn))))) - -(defvar sitemap-alphabetically) -(defvar sitemap-sort-folders) -(defvar sitemap-ignore-case) -(defvar sitemap-requested) +(defvar org-sitemap-sort-files) +(defvar org-sitemap-sort-folders) +(defvar org-sitemap-ignore-case) +(defvar org-sitemap-requested) +(defvar org-sitemap-date-format) +(defvar org-sitemap-file-entry-format) (defun org-publish-compare-directory-files (a b) - "Predicate for `sort', that sorts folders-first/last and alphabetically." + "Predicate for `sort', that sorts folders and files for sitemap." (let ((retval t)) - (when (or sitemap-alphabetically sitemap-sort-folders) - ;; First we sort alphabetically: - (when sitemap-alphabetically - (let* ((adir (file-directory-p a)) - (aorg (and (string-match "\\.org$" a) (not adir))) - (bdir (file-directory-p b)) - (borg (and (string-match "\\.org$" b) (not bdir))) - (A (if aorg - (concat (file-name-directory a) - (org-publish-find-title a)) a)) - (B (if borg - (concat (file-name-directory b) - (org-publish-find-title b)) b))) - (setq retval (if sitemap-ignore-case - (not (string-lessp (upcase B) (upcase A))) - (not (string-lessp B A)))))) - + (when (or org-sitemap-sort-files org-sitemap-sort-folders) + ;; First we sort files: + (when org-sitemap-sort-files + (cond ((equal org-sitemap-sort-files 'alphabetically) + (let* ((adir (file-directory-p a)) + (aorg (and (string-match "\\.org$" a) (not adir))) + (bdir (file-directory-p b)) + (borg (and (string-match "\\.org$" b) (not bdir))) + (A (if aorg + (concat (file-name-directory a) + (org-publish-find-title a)) a)) + (B (if borg + (concat (file-name-directory b) + (org-publish-find-title b)) b))) + (setq retval (if org-sitemap-ignore-case + (not (string-lessp (upcase B) (upcase A))) + (not (string-lessp B A)))))) + ((or (equal org-sitemap-sort-files 'chronologically) + (equal org-sitemap-sort-files 'anti-chronologically)) + (let* ((adate (org-publish-find-date a)) + (bdate (org-publish-find-date b)) + (A (+ (lsh (car adate) 16) (cadr adate))) + (B (+ (lsh (car bdate) 16) (cadr bdate)))) + (setq retval (if (equal org-sitemap-sort-files 'chronologically) + (<= A B) + (>= A B))))))) ;; Directory-wise wins: - (when sitemap-sort-folders + (when org-sitemap-sort-folders ;; a is directory, b not: (cond ((and (file-directory-p a) (not (file-directory-p b))) - (setq retval (equal sitemap-sort-folders 'first))) + (setq retval (equal org-sitemap-sort-folders 'first))) ;; a is not a directory, but b is: ((and (not (file-directory-p a)) (file-directory-p b)) - (setq retval (equal sitemap-sort-folders 'last)))))) + (setq retval (equal org-sitemap-sort-folders 'last)))))) retval)) (defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir) @@ -414,7 +455,7 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR." (not (string-match match fnd))) (pushnew f org-publish-temp-files))))) - (if sitemap-requested + (if org-sitemap-requested (sort (directory-files base-dir t (unless recurse match)) 'org-publish-compare-directory-files) (directory-files base-dir t (unless recurse match))))) @@ -431,28 +472,38 @@ matching filenames." (extension (or (plist-get project-plist :base-extension) "org")) ;; sitemap-... variables are dynamically scoped for ;; org-publish-compare-directory-files: - (sitemap-requested + (org-sitemap-requested (plist-get project-plist :auto-sitemap)) - (sitemap-sort-folders + (sitemap-filename + (or (plist-get project-plist :sitemap-filename) + "sitemap.org")) + (org-sitemap-sort-folders (if (plist-member project-plist :sitemap-sort-folders) (plist-get project-plist :sitemap-sort-folders) org-publish-sitemap-sort-folders)) - (sitemap-alphabetically - (if (plist-member project-plist :sitemap-alphabetically) - (plist-get project-plist :sitemap-alphabetically) - org-publish-sitemap-sort-alphabetically)) - (sitemap-ignore-case + (org-sitemap-sort-files + (cond ((plist-member project-plist :sitemap-sort-files) + (plist-get project-plist :sitemap-sort-files)) + ;; For backward compatibility: + ((plist-member project-plist :sitemap-alphabetically) + (if (plist-get project-plist :sitemap-alphabetically) + 'alphabetically nil)) + (t org-publish-sitemap-sort-files))) + (org-sitemap-ignore-case (if (plist-member project-plist :sitemap-ignore-case) (plist-get project-plist :sitemap-ignore-case) org-publish-sitemap-sort-ignore-case)) (match (if (eq extension 'any) "^[^\\.]" (concat "^[^\\.].*\\.\\(" extension "\\)$")))) - ;; Make sure sitemap-sort-folders' has an accepted value - (unless (memq sitemap-sort-folders '(first last)) - (setq sitemap-sort-folders nil)) + ;; Make sure `org-sitemap-sort-folders' has an accepted value + (unless (memq org-sitemap-sort-folders '(first last)) + (setq org-sitemap-sort-folders nil)) (setq org-publish-temp-files nil) + (if org-sitemap-requested + (pushnew (expand-file-name (concat base-dir sitemap-filename)) + org-publish-temp-files)) (org-publish-get-base-files-1 base-dir recurse match ;; FIXME distinguish exclude regexp ;; for skip-file and skip-dir? @@ -480,11 +531,11 @@ matching filenames." (e (plist-get (cdr prj) :exclude)) (i (plist-get (cdr prj) :include)) (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) - (when (or - (and - i - (member filename - (mapcar + (when + (or + (and + i (member filename + (mapcar (lambda (file) (expand-file-name file b)) i))) (and @@ -511,7 +562,7 @@ PUB-DIR is the publishing directory." (make-directory pub-dir t)) (let ((visiting (find-buffer-visiting filename))) (save-excursion - (switch-to-buffer (or visiting (find-file filename))) + (org-pop-to-buffer-same-window (or visiting (find-file filename))) (let* ((plist (cons :buffer-will-be-killed (cons t plist))) (init-buf (current-buffer)) (init-point (point)) @@ -523,8 +574,8 @@ PUB-DIR is the publishing directory." (setq export-buf-or-file (funcall (intern (concat "org-export-as-" format)) (plist-get plist :headline-levels) - nil plist nil - (plist-get plist :body-only) + nil plist nil + (plist-get plist :body-only) pub-dir)) (when (and (bufferp export-buf-or-file) (buffer-live-p export-buf-or-file)) @@ -598,10 +649,10 @@ See `org-publish-org-to' to the list of arguments." "Publish a file with no transformation of any kind. See `org-publish-org-to' to the list of arguments." ;; make sure eshell/cp code is loaded - (unless (file-directory-p pub-dir) - (make-directory pub-dir t)) - (or (equal (expand-file-name (file-name-directory filename)) - (file-name-as-directory (expand-file-name pub-dir))) + (unless (file-directory-p pub-dir) + (make-directory pub-dir t)) + (or (equal (expand-file-name (file-name-directory filename)) + (file-name-as-directory (expand-file-name pub-dir))) (copy-file filename (expand-file-name (file-name-nondirectory filename) pub-dir) t))) @@ -677,6 +728,10 @@ If :makeindex is set, also produce a file theindex.org." "sitemap.org")) (sitemap-function (or (plist-get project-plist :sitemap-function) 'org-publish-org-sitemap)) + (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format) + org-publish-sitemap-date-format)) + (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format) + org-publish-sitemap-file-entry-format)) (preparation-function (plist-get project-plist :preparation-function)) (completion-function (plist-get project-plist :completion-function)) (files (org-publish-get-base-files project exclude-regexp)) file) @@ -685,7 +740,7 @@ If :makeindex is set, also produce a file theindex.org." (while (setq file (pop files)) (org-publish-file file project t)) (when (plist-get project-plist :makeindex) - (org-publish-index-generate-theindex.inc + (org-publish-index-generate-theindex (plist-get project-plist :base-directory)) (org-publish-file (expand-file-name "theindex.org" @@ -711,6 +766,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (concat "Sitemap for project " (car project)))) (sitemap-style (or (plist-get project-plist :sitemap-style) 'tree)) + (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension)) (visiting (find-buffer-visiting sitemap-filename)) (ifn (file-name-nondirectory sitemap-filename)) file sitemap-buffer) @@ -722,6 +778,8 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (let ((fn (file-name-nondirectory file)) (link (file-relative-name file dir)) (oldlocal localdir)) + (when sitemap-sans-extension + (setq link (file-name-sans-extension link))) ;; sitemap shouldn't list itself (unless (equal (file-truename sitemap-filename) (file-truename file)) @@ -752,32 +810,68 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (setq indent-str (make-string (+ (length indent-str) 2) ?\ ))))))) ;; This is common to 'flat and 'tree - (insert (concat indent-str " + [[file:" link "][" - (org-publish-find-title file) - "]]\n"))))) + (let ((entry + (org-publish-format-file-entry org-sitemap-file-entry-format + file project-plist)) + (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) + (cond ((string-match-p regexp entry) + (string-match regexp entry) + (insert (concat indent-str " + " (match-string 1 entry) + "[[file:" link "][" + (match-string 2 entry) + "]]" (match-string 3 entry) "\n"))) + (t + (insert (concat indent-str " + [[file:" link "][" + entry + "]]\n")))))))) (save-buffer)) (or visiting (kill-buffer sitemap-buffer)))) -(defun org-publish-find-title (file) +(defun org-publish-format-file-entry (fmt file project-plist) + (format-spec fmt + `((?t . ,(org-publish-find-title file t)) + (?d . ,(format-time-string org-sitemap-date-format + (org-publish-find-date file))) + (?a . ,(or (plist-get project-plist :author) user-full-name))))) + +(defun org-publish-find-title (file &optional reset) "Find the title of FILE in project." (or - (org-publish-cache-get-file-property file :title nil t) + (and (not reset) (org-publish-cache-get-file-property file :title nil t)) (let* ((visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file))) - title) - (with-current-buffer buffer - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist)))) - (setq title - (or (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (file-name-nondirectory (file-name-sans-extension file)))))) - (unless visiting - (kill-buffer buffer)) - (org-publish-cache-set-file-property file :title title) - title))) + (buffer (or visiting (find-file-noselect file))) + title) + (with-current-buffer buffer + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + (org-infile-export-plist)))) + (setq title + (or (plist-get opt-plist :title) + (and (not + (plist-get opt-plist :skip-before-1st-heading)) + (org-export-grab-title-from-buffer)) + (file-name-nondirectory (file-name-sans-extension file)))))) + (unless visiting + (kill-buffer buffer)) + (org-publish-cache-set-file-property file :title title) + title))) + +(defun org-publish-find-date (file) + "Find the date of FILE in project. +If FILE provides a #+date keyword use it else use the file +system's modification time. + +It returns time in `current-time' format." + (let ((visiting (find-buffer-visiting file))) + (save-excursion + (org-pop-to-buffer-same-window (or visiting (find-file-noselect file nil t))) + (let* ((plist (org-infile-export-plist)) + (date (plist-get plist :date))) + (unless visiting + (kill-buffer (current-buffer))) + (if date + (org-time-string-to-time date) + (when (file-exists-p file) + (nth 5 (file-attributes file)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Interactive publishing functions @@ -848,7 +942,6 @@ the project." ;;; Index generation -(defvar backend) ; dynamically scoped (defun org-publish-aux-preprocess () "Find index entries and write them to an .orgx file." (let ((case-fold-search t) @@ -859,7 +952,7 @@ the project." (re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t) (> (match-end 1) (match-beginning 1))) (setq entry (match-string 1)) - (when (eq backend 'latex) + (when (eq org-export-current-backend 'latex) (replace-match (format "\\index{%s}" entry) t t)) (save-excursion (ignore-errors (org-back-to-heading t)) @@ -869,12 +962,15 @@ the project." target "")) (push (cons entry target) index))) (with-temp-file - (concat (file-name-sans-extension org-current-export-file) ".orgx") + (concat + (file-name-directory org-current-export-file) "." + (file-name-sans-extension + (file-name-nondirectory org-current-export-file)) ".orgx") (dolist (entry (nreverse index)) (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry))))))) -(defun org-publish-index-generate-theindex.inc (directory) - "Generate the index from all .orgx files in the current directory and below." +(defun org-publish-index-generate-theindex (directory) + "Generate the index from all .orgx files in DIRECTORY." (require 'find-lisp) (let* ((fulldir (file-name-as-directory (expand-file-name directory))) @@ -889,7 +985,7 @@ the project." main last-main letter last-letter file sub link tgext) ;; `files' contains the list of relative file names (dolist (file files) - (setq origfile (substring file 0 -1)) + (setq origfile (substring file 1 -1)) (setq buf (find-file-noselect file)) (with-current-buffer buf (goto-char (point-min)) @@ -900,7 +996,7 @@ the project." (kill-buffer buf)) (setq index (sort index (lambda (a b) (string< (downcase (car a)) (downcase (car b)))))) - (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory))) + (setq ibuffer (find-file-noselect (expand-file-name "theindex.org" directory))) (with-current-buffer ibuffer (erase-buffer) (insert "* Index\n") @@ -927,17 +1023,7 @@ the project." (insert " - " link "\n") (insert " - " link "\n"))) (save-buffer)) - (kill-buffer ibuffer) - - (let ((index-file (expand-file-name "theindex.org" directory))) - (unless (file-exists-p index-file) - (setq ibuffer (find-file-noselect index-file)) - (with-current-buffer ibuffer - (erase-buffer) - (insert "\n\n#+include: \"theindex.inc\"\n\n") - (save-buffer)) - (kill-buffer ibuffer))))) - + (kill-buffer ibuffer))) ;; Caching functions: @@ -1006,15 +1092,33 @@ If FREE-CACHE, empty the cache." (defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func) "Check the timestamp of the last publishing of FILENAME. -Return `t', if the file needs publishing" +Return `t', if the file needs publishing. The function also +checks if any included files have been more recently published, +so that the file including them will be republished as well." (unless org-publish-cache (error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present")) (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) - (pstamp (org-publish-cache-get key))) + (pstamp (org-publish-cache-get key)) + (visiting (find-buffer-visiting filename)) + included-files-ctime buf) + + (when (equal (file-name-extension filename) "org") + (setq buf (find-file (expand-file-name filename))) + (with-current-buffer buf + (goto-char (point-min)) + (while (re-search-forward "^#\\+INCLUDE:[ \t]+\"?\\([^ \t\"]*\\)\"?[ \t]*.*$" nil t) + (let* ((included-file (expand-file-name (match-string 1)))) + (add-to-list 'included-files-ctime + (org-publish-cache-ctime-of-src included-file) t)))) + ;; FIXME don't kill current buffer + (unless visiting (kill-buffer buf))) (if (null pstamp) t (let ((ctime (org-publish-cache-ctime-of-src filename))) - (< pstamp ctime))))) + (or (< pstamp ctime) + (when included-files-ctime + (not (null (delq nil (mapcar (lambda(ct) (< ctime ct)) + included-files-ctime)))))))))) (defun org-publish-cache-set-file-property (filename property value &optional project-name) "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. @@ -1066,15 +1170,19 @@ Returns value on success, else nil." (puthash key value org-publish-cache)) (defun org-publish-cache-ctime-of-src (filename) - "Get the files ctime as integer." - (let ((src-attr (file-attributes filename))) + "Get the FILENAME ctime as an integer." + (let* ((symlink-maybe (or (file-symlink-p filename) filename)) + (src-attr (file-attributes (if (file-name-absolute-p symlink-maybe) + symlink-maybe + (expand-file-name + symlink-maybe + (file-name-directory filename)))))) (+ (lsh (car (nth 5 src-attr)) 16) (cadr (nth 5 src-attr))))) - - (provide 'org-publish) +;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb ;;; org-publish.el ends here diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index fd3064a709c..40bf6888dff 100644 --- a/lisp/org/org-remember.el +++ b/lisp/org/org-remember.el @@ -1,11 +1,12 @@ ;;; org-remember.el --- Fast note taking in Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -33,12 +34,16 @@ (eval-when-compile (require 'cl)) (require 'org) +(require 'org-compat) (require 'org-datetree) (declare-function remember-mode "remember" ()) (declare-function remember "remember" (&optional initial)) (declare-function remember-buffer-desc "remember" ()) (declare-function remember-finalize "remember" ()) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) + (defvar remember-save-after-remembering) (defvar remember-register) (defvar remember-buffer) @@ -214,11 +219,7 @@ The remember buffer is still current when this hook runs." :group 'org-remember :type 'hook) -(defvar org-remember-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'org-remember-finalize) - (define-key map "\C-c\C-k" 'org-remember-kill) - map) +(defvar org-remember-mode-map (make-sparse-keymap) "Keymap for `org-remember-mode', a minor mode. Use this map to set additional keybindings for when Org-mode is used for a Remember buffer.") @@ -227,7 +228,10 @@ for a Remember buffer.") (define-minor-mode org-remember-mode "Minor mode for special key bindings in a remember buffer." - nil " Rem" org-remember-mode-map) + nil " Rem" org-remember-mode-map + (run-hooks 'org-remember-mode-hook)) +(define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize) +(define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill) (defcustom org-remember-clock-out-on-exit 'query "Non-nil means stop the clock when exiting a clocking remember buffer. @@ -785,7 +789,7 @@ The user is queried for the template." (setq heading org-remember-default-headline)) (setq visiting (org-find-base-buffer-visiting file)) (if (not visiting) (find-file-noselect file)) - (switch-to-buffer (or visiting (get-file-buffer file))) + (org-pop-to-buffer-same-window (or visiting (get-file-buffer file))) (widen) (goto-char (point-min)) (if (re-search-forward @@ -1004,7 +1008,7 @@ See also the variable `org-reverse-note-order'." ((eq org-remember-interactive-interface 'outline-path-completion) (let ((org-refile-targets '((nil . (:maxlevel . 10)))) (org-refile-use-outline-path t)) - (setq spos (org-refile-get-location "Heading: ") + (setq spos (org-refile-get-location "Heading") exitcmd 'return spos (nth 3 spos)))) (t (error "This should not happen"))) @@ -1072,7 +1076,7 @@ See also the variable `org-reverse-note-order'." (save-restriction (widen) (goto-char (point-min)) - (re-search-forward "^\\*+ " nil t) + (re-search-forward org-outline-regexp-bol nil t) (beginning-of-line 1) (org-paste-subtree 1 txt) (and org-auto-align-tags (org-set-tags nil t)) @@ -1149,6 +1153,7 @@ See also the variable `org-reverse-note-order'." (provide 'org-remember) +;; arch-tag: 497f30d0-4bc3-4097-8622-2d27ac5f2698 ;;; org-remember.el ends here diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index 6e984fda687..cbb63365985 100644 --- a/lisp/org/org-rmail.el +++ b/lisp/org/org-rmail.el @@ -1,11 +1,12 @@ ;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -114,5 +115,6 @@ (provide 'org-rmail) +;; arch-tag: c6cf4a8b-6639-4b7f-821f-bdf10746b173 ;;; org-rmail.el ends here diff --git a/lisp/org/org-special-blocks.el b/lisp/org/org-special-blocks.el new file mode 100644 index 00000000000..4f4d5e8e561 --- /dev/null +++ b/lisp/org/org-special-blocks.el @@ -0,0 +1,99 @@ +;;; org-special-blocks.el --- Turn blocks into LaTeX envs and HTML divs + +;; Copyright (C) 2009 Chris Gray + +;; Author: Chris Gray <chrismgray@gmail.com> + +;; This file is part of GNU Emacs. + +;; 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 2, 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 this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; + +;; This package generalizes the #+begin_foo and #+end_foo tokens. + +;; To use, put the following in your init file: +;; +;; (require 'org-special-blocks) + +;; The tokens #+begin_center, #+begin_verse, etc. existed previously. +;; This package generalizes them (at least for the LaTeX and html +;; exporters). When a #+begin_foo token is encountered by the LaTeX +;; exporter, it is expanded into \begin{foo}. The text inside the +;; environment is not protected, as text inside environments generally +;; is. When #+begin_foo is encountered by the html exporter, a div +;; with class foo is inserted into the HTML file. It is up to the +;; user to add this class to his or her stylesheet if this div is to +;; mean anything. + +(require 'org-compat) + +(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$" + "A regexp indicating the names of blocks that should be ignored +by org-special-blocks. These blocks will presumably be +interpreted by other mechanisms.") + +(defvar org-export-current-backend) ; dynamically bound in org-exp.el +(defun org-special-blocks-make-special-cookies () + "Adds special cookies when #+begin_foo and #+end_foo tokens are +seen. This is run after a few special cases are taken care of." + (when (or (eq org-export-current-backend 'html) + (eq org-export-current-backend 'latex)) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t) + (unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2)) + (replace-match + (if (equal (downcase (match-string 1)) "begin") + (concat "ORG-" (match-string 2) "-START") + (concat "ORG-" (match-string 2) "-END")) + t t))))) + +(add-hook 'org-export-preprocess-after-blockquote-hook + 'org-special-blocks-make-special-cookies) + +(defun org-special-blocks-convert-latex-special-cookies () + "Converts the special cookies into LaTeX blocks." + (goto-char (point-min)) + (while (re-search-forward "^ORG-\\([^ \t\n]*\\)[ \t]*\\(.*\\)-\\(START\\|END\\)$" nil t) + (replace-match + (if (equal (match-string 3) "START") + (concat "\\begin{" (match-string 1) "}" (match-string 2)) + (concat "\\end{" (match-string 1) "}")) + t t))) + + +(add-hook 'org-export-latex-after-blockquotes-hook + 'org-special-blocks-convert-latex-special-cookies) + +(defvar line) +(defun org-special-blocks-convert-html-special-cookies () + "Converts the special cookies into div blocks." + ;; Uses the dynamically-bound variable `line'. + (when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" line) +; (org-close-par-maybe) + (message "%s" (match-string 1)) + (if (equal (match-string 2 line) "START") + (insert "<div class=\"" (match-string 1 line) "\">\n") + (insert "</div>\n")) + (throw 'nextline nil))) + +(add-hook 'org-export-html-after-blockquotes-hook + 'org-special-blocks-convert-html-special-cookies) + +(provide 'org-special-blocks) + +;;; org-special-blocks.el ends here diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 5a877963a40..30ffc34a6eb 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -1,13 +1,14 @@ ;;; org-src.el --- Source code examples in Org ;; -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Bastien Guerry <bzg AT altern DOT org> ;; Dan Davison <davison at stats dot ox dot ac dot uk> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -42,6 +43,8 @@ (declare-function org-at-table.el-p "org" ()) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-switch-to-buffer-other-window "org" (&rest args)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) (defcustom org-edit-src-region-extra nil "Additional regexps to identify regions for editing with `org-edit-src-code'. @@ -115,8 +118,7 @@ buffer.") (defcustom org-edit-src-persistent-message t "Non-nil means show persistent exit help message while editing src examples. The message is shown in the header-line, which will be created in the -first line of the window showing the editing buffer. -When nil, the message will only be shown intermittently in the echo area." +first line of the window showing the editing buffer." :group 'org-edit-structure :type 'boolean) @@ -153,7 +155,7 @@ but which mess up the display of a snippet in Org exported files.") (defcustom org-src-lang-modes '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql) - ("calc" . fundamental)) + ("calc" . fundamental) ("C" . c)) "Alist mapping languages to their major mode. The key is the language name, the value is the string that should be inserted as the name of the major mode. For many languages this is @@ -169,10 +171,8 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is ;;; Editing source examples -(defvar org-src-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c'" 'org-edit-src-exit) - map)) +(defvar org-src-mode-map (make-sparse-keymap)) +(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) @@ -200,7 +200,7 @@ This minor mode is turned on in two situations: There is a mode hook, and keybindings for `org-edit-src-exit' and `org-edit-src-save'") -(defun org-edit-src-code (&optional context code edit-buffer-name quietp) +(defun org-edit-src-code (&optional context code edit-buffer-name) "Edit the source code example at point. The example is copied to a separate buffer, and that buffer is switched to the correct language mode. When done, exit with @@ -216,14 +216,13 @@ buffer." (let ((mark (and (org-region-active-p) (mark))) (case-fold-search t) (info (org-edit-src-find-region-and-lang)) - (babel-info (org-babel-get-src-block-info 'light)) - (org-mode-p (eq major-mode 'org-mode)) + (full-info (org-babel-get-src-block-info)) + (org-mode-p (or (org-mode-p) (derived-mode-p 'org-mode))) (beg (make-marker)) (end (make-marker)) - (preserve-indentation org-src-preserve-indentation) (allow-write-back-p (null code)) block-nindent total-nindent ovl lang lang-f single lfmt buffer msg - begline markline markcol line col) + begline markline markcol line col transmitted-variables) (if (not info) nil (setq beg (move-marker beg (nth 0 info)) @@ -237,10 +236,22 @@ buffer." (nth 2 info)) lang (if (symbolp lang) (symbol-name lang) lang) single (nth 3 info) - lfmt (nth 4 info) block-nindent (nth 5 info) lang-f (intern (concat lang "-mode")) - begline (save-excursion (goto-char beg) (org-current-line))) + begline (save-excursion (goto-char beg) (org-current-line)) + transmitted-variables + `((org-edit-src-content-indentation + ,org-edit-src-content-indentation) + (org-edit-src-force-single-line ,single) + (org-edit-src-from-org-mode ,org-mode-p) + (org-edit-src-allow-write-back-p ,allow-write-back-p) + (org-src-preserve-indentation ,org-src-preserve-indentation) + (org-src-babel-info ,(org-babel-get-src-block-info 'light)) + (org-coderef-label-format + ,(or (nth 4 info) org-coderef-label-format)) + (org-edit-src-beg-marker ,beg) + (org-edit-src-end-marker ,end) + (org-edit-src-block-indentation ,block-nindent))) (if (and mark (>= mark beg) (<= mark (1+ end))) (save-excursion (goto-char (min mark end)) (setq markline (org-current-line) @@ -280,27 +291,23 @@ buffer." (define-key map [mouse-1] 'org-edit-src-continue) map)) (overlay-put ovl :read-only "Leave me alone") + (setq transmitted-variables + (append transmitted-variables `((org-edit-src-overlay ,ovl)))) (org-src-switch-to-buffer buffer 'edit) (if (eq single 'macro-definition) (setq code (replace-regexp-in-string "\\\\n" "\n" code t t))) (insert code) (remove-text-properties (point-min) (point-max) '(display nil invisible nil intangible nil)) - (unless preserve-indentation + (unless (cadr (assq 'org-src-preserve-indentation transmitted-variables)) (setq total-nindent (or (org-do-remove-indentation) 0))) (let ((org-inhibit-startup t)) (condition-case e (funcall lang-f) (error (error "Language mode `%s' fails with: %S" lang-f (nth 1 e))))) - (set (make-local-variable 'org-edit-src-force-single-line) single) - (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) - (set (make-local-variable 'org-edit-src-allow-write-back-p) allow-write-back-p) - (set (make-local-variable 'org-src-preserve-indentation) preserve-indentation) - (when babel-info - (set (make-local-variable 'org-src-babel-info) babel-info)) - (when lfmt - (set (make-local-variable 'org-coderef-label-format) lfmt)) + (dolist (pair transmitted-variables) + (org-set-local (car pair) (cadr pair))) (when org-mode-p (goto-char (point-min)) (while (re-search-forward "^," nil t) @@ -309,21 +316,20 @@ buffer." (when markline (org-goto-line (1+ (- markline begline))) (org-move-to-column - (if preserve-indentation markcol (max 0 (- markcol total-nindent)))) + (if org-src-preserve-indentation markcol + (max 0 (- markcol total-nindent)))) (push-mark (point) 'no-message t) (setq deactivate-mark nil)) (org-goto-line (1+ (- line begline))) (org-move-to-column - (if preserve-indentation col (max 0 (- col total-nindent)))) - (org-set-local 'org-edit-src-beg-marker beg) - (org-set-local 'org-edit-src-end-marker end) - (org-set-local 'org-edit-src-overlay ovl) - (org-set-local 'org-edit-src-block-indentation block-nindent) + (if org-src-preserve-indentation col (max 0 (- col total-nindent)))) (org-src-mode) (set-buffer-modified-p nil) (and org-edit-src-persistent-message - (org-set-local 'header-line-format msg))) - (unless quietp (message "%s" msg)) + (org-set-local 'header-line-format msg)) + (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) + (when (fboundp edit-prep-func) + (funcall edit-prep-func full-info)))) t))) (defun org-edit-src-continue (e) @@ -335,31 +341,31 @@ buffer." (defun org-src-switch-to-buffer (buffer context) (case org-src-window-setup - (current-window - (switch-to-buffer buffer)) - (other-window + ('current-window + (org-pop-to-buffer-same-window buffer)) + ('other-window (switch-to-buffer-other-window buffer)) - (other-frame + ('other-frame (case context - (exit + ('exit (let ((frame (selected-frame))) (switch-to-buffer-other-frame buffer) (delete-frame frame))) - (save + ('save (kill-buffer (current-buffer)) - (switch-to-buffer buffer)) + (org-pop-to-buffer-same-window buffer)) (t (switch-to-buffer-other-frame buffer)))) - (reorganize-frame + ('reorganize-frame (if (eq context 'edit) (delete-other-windows)) (org-switch-to-buffer-other-window buffer) (if (eq context 'exit) (delete-other-windows))) - (switch-invisibly + ('switch-invisibly (set-buffer buffer)) (t (message "Invalid value %s for org-src-window-setup" (symbol-name org-src-window-setup)) - (switch-to-buffer buffer)))) + (org-pop-to-buffer-same-window buffer)))) (defun org-src-construct-edit-buffer-name (org-buffer-name lang) "Construct the buffer name for a source editing buffer." @@ -394,7 +400,7 @@ the fragment in the Org-mode buffer." (case-fold-search t) (msg (substitute-command-keys "Edit, then exit with C-c ' (C-c and single quote)")) - (org-mode-p (eq major-mode 'org-mode)) + (org-mode-p (org-mode-p)) (beg (make-marker)) (end (make-marker)) (preserve-indentation org-src-preserve-indentation) @@ -419,7 +425,7 @@ the fragment in the Org-mode buffer." begline (save-excursion (goto-char beg) (org-current-line))) (if (and (setq buffer (org-edit-src-find-buffer beg end)) (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ")) - (switch-to-buffer buffer) + (org-pop-to-buffer-same-window buffer) (when buffer (with-current-buffer buffer (if (boundp 'org-edit-src-overlay) @@ -439,7 +445,7 @@ the fragment in the Org-mode buffer." (define-key map [mouse-1] 'org-edit-src-continue) map)) (overlay-put ovl :read-only "Leave me alone") - (switch-to-buffer buffer) + (org-pop-to-buffer-same-window buffer) (insert code) (remove-text-properties (point-min) (point-max) '(display nil invisible nil intangible nil)) @@ -674,7 +680,7 @@ the language, a switch telling if the content should be in a single line." (defun org-src-mode-configure-edit-buffer () (when (org-bound-and-true-p org-edit-src-from-org-mode) (org-add-hook 'kill-buffer-hook - (lambda () (delete-overlay org-edit-src-overlay)) nil 'local) + #'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local) (if (org-bound-and-true-p org-edit-src-allow-write-back-p) (progn (setq buffer-offer-save t) @@ -760,29 +766,29 @@ This function is called by emacs automatic fontification, as long as `org-src-fontify-natively' is non-nil. For manual fontification of code blocks see `org-src-fontify-block' and `org-src-fontify-buffer'" - (let* ((lang-mode (org-src-get-lang-mode lang)) - (string (buffer-substring-no-properties start end)) - (modified (buffer-modified-p)) - (org-buffer (current-buffer)) pos next) - (remove-text-properties start end '(face nil)) - (with-current-buffer - (get-buffer-create - (concat " org-src-fontification:" (symbol-name lang-mode))) - (delete-region (point-min) (point-max)) - (insert string) - (unless (eq major-mode lang-mode) (funcall lang-mode)) - (font-lock-fontify-buffer) - (setq pos (point-min)) - (while (setq next (next-single-property-change pos 'face)) - (put-text-property - (+ start (1- pos)) (+ start next) 'face - (get-text-property pos 'face) org-buffer) - (setq pos next))) - (add-text-properties - start end - '(font-lock-fontified t fontified t font-lock-multiline t)) - (set-buffer-modified-p modified)) - t) ;; Tell `org-fontify-meta-lines-and-blocks' that we fontified + (let ((lang-mode (org-src-get-lang-mode lang))) + (if (fboundp lang-mode) + (let ((string (buffer-substring-no-properties start end)) + (modified (buffer-modified-p)) + (org-buffer (current-buffer)) pos next) + (remove-text-properties start end '(face nil)) + (with-current-buffer + (get-buffer-create + (concat " org-src-fontification:" (symbol-name lang-mode))) + (delete-region (point-min) (point-max)) + (insert (concat string " ")) ;; so there's a final property change + (unless (eq major-mode lang-mode) (funcall lang-mode)) + (font-lock-fontify-buffer) + (setq pos (point-min)) + (while (setq next (next-single-property-change pos 'face)) + (put-text-property + (+ start (1- pos)) (+ start next) 'face + (get-text-property pos 'face) org-buffer) + (setq pos next))) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified))))) (defun org-src-fontify-block () "Fontify code block at point." @@ -808,4 +814,5 @@ LANG is a string, and the returned major mode is a symbol." (provide 'org-src) +;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8 ;;; org-src.el ends here diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index b56dc6b77c3..82d1e1309b1 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1,11 +1,12 @@ ;;; org-table.el --- The table editor for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -46,11 +47,12 @@ (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized (defvar org-export-html-table-tag) ; defined in org-exp.el (defvar constants-unit-system) +(defvar org-table-follow-field-mode) (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 +to the receiver position, othewise, if table is not sent, the functions are not run.") (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) @@ -161,6 +163,27 @@ Only relevant when `org-enable-table-editor' is equal to `optimized'." :group 'org-table-editing :type 'boolean) +(defcustom org-table-exit-follow-field-mode-when-leaving-table t + "Non-nil means automatically exit the follow mode. +When nil, the follow mode will stay on and be active in any table +the cursor enters. Since the table follow filed mode messes with the +window configuration, it is not recommended to set this variable to nil, +except maybe locally in a special file that has mostly tables with long +fields." + :group 'org-table + :type 'boolean) + +(defcustom org-table-fix-formulas-confirm nil + "Whether the user should confirm when Org fixes formulas." + :group 'org-table-editing + :type '(choice + (const :tag "with yes-or-no" yes-or-no-p) + (const :tag "with y-or-n" y-or-n-p) + (const :tag "no confirmation" nil))) +(put 'org-table-fix-formulas-confirm + 'safe-local-variable + #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) + (defcustom org-table-tab-jumps-over-hlines t "Non-nil means tab in the last column of a table with jump over a hline. If a horizontal separator line is following the current line, @@ -175,17 +198,17 @@ this line." :tag "Org Table Calculation" :group 'org-table) -(defcustom org-table-use-standard-references t +(defcustom org-table-use-standard-references 'from "Should org-mode work with table references like B3 instead of @3$2? Possible values are: nil never use them from accept as input, do not present for editing -t: accept as input and present for editing" +t accept as input and present for editing" :group 'org-table-calculation :type '(choice (const :tag "Never, don't even check user input for them" nil) (const :tag "Always, both as user input, and when editing" t) - (const :tag "Convert user input, don't offer during editing" 'from))) + (const :tag "Convert user input, don't offer during editing" from))) (defcustom org-table-copy-increment t "Non-nil means increment when copying current field with \\[org-table-copy-down]." @@ -208,6 +231,18 @@ relies on the variables to be present in the list." :group 'org-table-calculation :type 'plist) +(defcustom org-table-duration-custom-format 'hours + "Format for the output of calc computations like $1+$2;t. +The default value is 'hours, and will output the results as a +number of hours. Other allowed values are 'seconds, 'minutes and +'days, and the output will be a fraction of seconds, minutes or +days." + :group 'org-table-calculation + :type '(choice (symbol :tag "Seconds" 'seconds) + (symbol :tag "Minutes" 'minutes) + (symbol :tag "Hours " 'hours) + (symbol :tag "Days " 'days))) + (defcustom org-table-formula-evaluate-inline t "Non-nil means TAB and RET evaluate a formula in current table field. If the current field starts with an equal sign, it is assumed to be a formula @@ -315,6 +350,8 @@ available parameters." "Table begin line, non-nil only for the duration of a command.") (defvar org-table-current-begin-pos nil "Table begin position, non-nil only for the duration of a command.") +(defvar org-table-current-ncol nil + "Number of columns in table, non-nil only for the duration of a command.") (defvar org-table-dlines nil "Vector of data line line numbers in the current table.") (defvar org-table-hlines nil @@ -478,7 +515,9 @@ nil When nil, the command tries to be smart and figure out the ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") ((equal separator '(16)) "^\\|\t") ((integerp separator) - (format "^ *\\| *\t *\\| \\{%d,\\}" separator)) + (if (< separator 1) + (error "Number of spaces in separator must be >= 1") + (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) (t (error "This should not happen")))) (while (re-search-forward re end t) (replace-match "| " t t))) @@ -519,14 +558,9 @@ property, locally or anywhere up in the hierarchy." (let* ((beg (org-table-begin)) (end (org-table-end)) (txt (buffer-substring-no-properties beg end)) - (file (or file - (condition-case nil - (org-entry-get beg "TABLE_EXPORT_FILE" t) - (error nil)))) + (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t))) (format (or format - (condition-case nil - (org-entry-get beg "TABLE_EXPORT_FORMAT" t) - (error nil)))) + (org-entry-get beg "TABLE_EXPORT_FORMAT" t))) buf deffmt-readable) (unless file (setq file (read-file-name "Export table to: ")) @@ -984,16 +1018,15 @@ Before doing so, re-align the table if necessary." (defun org-table-copy-down (n) "Copy a field down in the current column. -If the field at the cursor is empty, copy into it the content of the nearest -non-empty field above. With argument N, use the Nth non-empty field. -If the current field is not empty, it is copied down to the next row, and -the cursor is moved with it. Therefore, repeating this command causes the -column to be filled row-by-row. -If the variable `org-table-copy-increment' is non-nil and the field is an -integer or a timestamp, it will be incremented while copying. In the case of -a timestamp, if the cursor is on the year, change the year. If it is on the -month or the day, change that. Point will stay on the current date field -in order to easily repeat the interval." +If the field at the cursor is empty, copy into it the content of +the nearest non-empty field above. With argument N, use the Nth +non-empty field. If the current field is not empty, it is copied +down to the next row, and the cursor is moved with it. +Therefore, repeating this command causes the column to be filled +row-by-row. +If the variable `org-table-copy-increment' is non-nil and the +field is an integer or a timestamp, it will be incremented while +copying. In the case of a timestamp, increment by one day." (interactive "p") (let* ((colpos (org-table-current-column)) (col (current-column)) @@ -1035,7 +1068,7 @@ in order to easily repeat the interval." (org-move-to-column col)) (error "No non-empty field found")))) -(defun org-table-check-inside-data-field () +(defun org-table-check-inside-data-field (&optional noerror) "Is point inside a table data field? I.e. not on a hline or before the first or after the last column? This actually throws an error, so it aborts the current command." @@ -1043,7 +1076,10 @@ This actually throws an error, so it aborts the current command." (= (org-table-current-column) 0) (org-at-table-hline-p) (looking-at "[ \t]*$")) - (error "Not in table data field"))) + (if noerror + nil + (error "Not in table data field")) + t)) (defvar org-table-clip nil "Clipboard for table regions.") @@ -1093,7 +1129,7 @@ Return t when the line exists, nil if it does not exist." "Blank the current table field or active region." (interactive) (org-table-check-inside-data-field) - (if (and (interactive-p) (org-region-active-p)) + (if (and (org-called-interactively-p 'any) (org-region-active-p)) (let (org-table-clip) (org-table-cut-region (region-beginning) (region-end))) (skip-chars-backward "^|") @@ -1118,7 +1154,8 @@ is always the old value." (let* ((pos (match-beginning 0)) (val (buffer-substring (1+ pos) (match-end 0)))) (if replace - (replace-match (concat "|" replace) t t)) + (replace-match (concat "|" (if (equal replace "") " " replace)) + t t)) (goto-char (min (point-at-eol) (+ 2 pos))) val) (forward-char 1) "")) @@ -1133,13 +1170,20 @@ is always the old value." (cname (car (rassoc (int-to-string col) org-table-column-names))) (name (car (rassoc (list (org-current-line) col) org-table-named-field-locations))) - (eql (org-table-get-stored-formulas)) + (eql (org-table-expand-lhs-ranges + (mapcar + (lambda (e) + (cons (org-table-formula-handle-first/last-rc + (car e)) (cdr e))) + (org-table-get-stored-formulas)))) (dline (org-table-current-dline)) (ref (format "@%d$%d" dline col)) (ref1 (org-table-convert-refs-to-an ref)) (fequation (or (assoc name eql) (assoc ref eql))) (cequation (assoc (int-to-string col) eql)) (eqn (or fequation cequation))) + (if (and eqn (get-text-property 0 :orig-eqn (car eqn))) + (setq eqn (get-text-property 0 :orig-eqn (car eqn)))) (goto-char pos) (condition-case nil (org-table-show-reference 'local) @@ -1161,27 +1205,30 @@ is always the old value." (defun org-table-current-column () "Find out which column we are in." (interactive) - (if (interactive-p) (org-table-check-inside-data-field)) + (if (org-called-interactively-p 'any) (org-table-check-inside-data-field)) (save-excursion (let ((cnt 0) (pos (point))) (beginning-of-line 1) (while (search-forward "|" pos t) (setq cnt (1+ cnt))) - (if (interactive-p) (message "In table column %d" cnt)) + (when (org-called-interactively-p 'interactive) + (message "In table column %d" cnt)) cnt))) (defun org-table-current-dline () "Find out what table data line we are in. Only data lines count for this." (interactive) - (if (interactive-p) (org-table-check-inside-data-field)) + (when (org-called-interactively-p 'any) + (org-table-check-inside-data-field)) (save-excursion (let ((cnt 0) (pos (point))) (goto-char (org-table-begin)) (while (<= (point) pos) (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt))) (beginning-of-line 2)) - (if (interactive-p) (message "This is table line %d" cnt)) + (when (org-called-interactively-p 'any) + (message "This is table line %d" cnt)) cnt))) (defun org-table-goto-column (n &optional on-delim force) @@ -1229,8 +1276,10 @@ However, when FORCE is non-nil, create new columns if necessary." (org-goto-line linepos) (org-table-goto-column colpos) (org-table-align) - (org-table-fix-formulas "$" nil (1- col) 1) - (org-table-fix-formulas "$LR" nil (1- col) 1))) + (when (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas "$" nil (1- col) 1) + (org-table-fix-formulas "$LR" nil (1- col) 1)))) (defun org-table-find-dataline () "Find a data line in the current table, which is needed for column commands." @@ -1251,6 +1300,28 @@ However, when FORCE is non-nil, create new columns if necessary." (error "Please position cursor in a data line for column operations"))))) +(defun org-table-line-to-dline (line &optional above) + "Turn a buffer line number into a data line number. +If there is no data line in this line, return nil. +If there is no matchin dline (most likely te refrence was a hline), the +first dline below it is used. When ABOVE is non-nil, the one above is used." + (catch 'exit + (let ((ll (length org-table-dlines)) + i) + (if above + (progn + (setq i (1- ll)) + (while (> i 0) + (if (<= (aref org-table-dlines i) line) + (throw 'exit i)) + (setq i (1- i)))) + (setq i 1) + (while (< i ll) + (if (>= (aref org-table-dlines i) line) + (throw 'exit i)) + (setq i (1+ i))))) + nil)) + (defun org-table-delete-column () "Delete a column from the table." (interactive) @@ -1276,10 +1347,12 @@ However, when FORCE is non-nil, create new columns if necessary." (org-goto-line linepos) (org-table-goto-column colpos) (org-table-align) - (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) - col -1 col) - (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID")) - col -1 col))) + (when (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) + col -1 col) + (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID")) + col -1 col)))) (defun org-table-move-column-right () "Move column to the right." @@ -1320,12 +1393,14 @@ However, when FORCE is non-nil, create new columns if necessary." (org-goto-line linepos) (org-table-goto-column colpos) (org-table-align) - (org-table-fix-formulas - "$" (list (cons (number-to-string col) (number-to-string colpos)) - (cons (number-to-string colpos) (number-to-string col)))) - (org-table-fix-formulas - "$LR" (list (cons (number-to-string col) (number-to-string colpos)) - (cons (number-to-string colpos) (number-to-string col)))))) + (when (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas + "$" (list (cons (number-to-string col) (number-to-string colpos)) + (cons (number-to-string colpos) (number-to-string col)))) + (org-table-fix-formulas + "$LR" (list (cons (number-to-string col) (number-to-string colpos)) + (cons (number-to-string colpos) (number-to-string col))))))) (defun org-table-move-row-down () "Move table row down." @@ -1361,7 +1436,10 @@ However, when FORCE is non-nil, create new columns if necessary." (insert txt) (beginning-of-line 0) (org-move-to-column col) - (unless (or hline1p hline2p) + (unless (or hline1p hline2p + (not (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm + "Fix formulas? ")))) (org-table-fix-formulas "@" (list (cons (number-to-string dline1) (number-to-string dline2)) (cons (number-to-string dline2) (number-to-string dline1))))))) @@ -1383,7 +1461,9 @@ With prefix ARG, insert below the current line." (re-search-forward "| ?" (point-at-eol) t) (and (or org-table-may-need-update org-table-overlay-coordinates) (org-table-align)) - (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))) + (when (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))) (defun org-table-insert-hline (&optional above) "Insert a horizontal-line below the current line into the table. @@ -1444,8 +1524,10 @@ In particular, this does handle wide and invisible characters." (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) (if (not (org-at-table-p)) (beginning-of-line 0)) (org-move-to-column col) - (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) - dline -1 dline))) + (when (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) + dline -1 dline)))) (defun org-table-sort-lines (with-case &optional sorting-type) "Sort table lines according to the column at point. @@ -1473,7 +1555,7 @@ should be done in reverse order." (thiscol (org-table-current-column)) beg end bcol ecol tend tbeg column lns pos) (when (equal thiscol 0) - (if (interactive-p) + (if (org-called-interactively-p 'any) (setq thiscol (string-to-number (read-string "Use column N for sorting: "))) @@ -1724,21 +1806,38 @@ This is mainly useful for fields that contain hidden parts. When called with a \\[universal-argument] prefix, just make the full field visible so that it can be edited in place." (interactive "P") - (if arg - (let ((b (save-excursion (skip-chars-backward "^|") (point))) - (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) - (remove-text-properties b e '(org-cwidth t invisible t - display t intangible t)) - (if (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-fontify-block))) + (cond + ((equal arg '(16)) + (org-table-follow-field-mode (if org-table-follow-field-mode -1 1))) + (arg + (let ((b (save-excursion (skip-chars-backward "^|") (point))) + (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) + (remove-text-properties b e '(org-cwidth t invisible t + display t intangible t)) + (if (and (boundp 'font-lock-mode) font-lock-mode) + (font-lock-fontify-block)))) + (t (let ((pos (move-marker (make-marker) (point))) + (coord + (if (eq org-table-use-standard-references t) + (concat (org-number-to-letters (org-table-current-column)) + (int-to-string (org-table-current-dline))) + (concat "@" (int-to-string (org-table-current-dline)) + "$" (int-to-string (org-table-current-column))))) (field (org-table-get-field)) (cw (current-window-configuration)) p) - (org-switch-to-buffer-other-window "*Org tmp*") + (goto-char pos) + (org-switch-to-buffer-other-window "*Org Table Edit Field*") + (when (and (local-variable-p 'org-field-marker) + (markerp org-field-marker)) + (move-marker org-field-marker nil)) (erase-buffer) - (insert "#\n# Edit field and finish with C-c C-c\n#\n") + (insert "#\n# Edit field " coord " and finish with C-c C-c\n#\n") (let ((org-inhibit-startup t)) (org-mode)) + (auto-fill-mode -1) + (setq truncate-lines nil) + (setq word-wrap t) (goto-char (setq p (point-max))) (insert (org-trim field)) (remove-text-properties p (point-max) @@ -1748,7 +1847,7 @@ it can be edited in place." (org-set-local 'org-finish-function 'org-table-finish-edit-field) (org-set-local 'org-window-configuration cw) (org-set-local 'org-field-marker pos) - (message "Edit and finish with C-c C-c")))) + (message "Edit and finish with C-c C-c"))))) (defun org-table-finish-edit-field () "Finish editing a table data field. @@ -1773,6 +1872,35 @@ the table and kill the editing buffer." (org-table-align) (message "New field value inserted"))) +(define-minor-mode org-table-follow-field-mode + "Minor mode to make the table field editor window follow the cursor. +When this mode is active, the field editor window will always show the +current field. The mode exits automatically when the cursor leaves the +table (but see `org-table-exit-follow-field-mode-when-leaving-table')." + nil " TblFollow" nil + (if org-table-follow-field-mode + (org-add-hook 'post-command-hook 'org-table-follow-fields-with-editor + 'append 'local) + (remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local) + (let* ((buf (get-buffer "*Org Table Edit Field*")) + (win (and buf (get-buffer-window buf)))) + (when win (delete-window win)) + (when buf + (with-current-buffer buf + (move-marker org-field-marker nil)) + (kill-buffer buf))))) + +(defun org-table-follow-fields-with-editor () + (if (and org-table-exit-follow-field-mode-when-leaving-table + (not (org-at-table-p))) + ;; We have left the table, exit the follow mode + (org-table-follow-field-mode -1) + (when (org-table-check-inside-data-field 'noerror) + (let ((win (selected-window))) + (org-table-edit-field nil) + (org-fit-window-to-buffer) + (select-window win))))) + (defvar org-timecnt) ; dynamically scoped parameter (defun org-table-sum (&optional beg end nlast) @@ -1826,7 +1954,7 @@ If NLAST is a number, only the NLAST fields will actually be summed." s diff) (format "%d:%02d:%02d" h m s)))) (kill-new sres) - (if (interactive-p) + (if (org-called-interactively-p 'interactive) (message "%s" (substitute-command-keys (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" @@ -1950,11 +2078,23 @@ When NAMED is non-nil, look for a named equation." "\n"))) (defsubst org-table-formula-make-cmp-string (a) - (when (string-match "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" a) + (when (string-match "\\`$[<>]" a) + (let ((arrow (string-to-char (substring a 1)))) + ;; Fake a high number to make sure this is sorted at the end. + (setq a (org-table-formula-handle-first/last-rc a)) + (setq a (format "$%d" (+ 10000 + (if (= arrow ?<) -1000 0) + (string-to-number (substring a 1))))))) + (when (string-match + "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" + a) (concat - (if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "") - (if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "") - (if (match-end 5) (concat "@@" (match-string 5 a)))))) + (if (match-end 2) + (format "@%05d" (string-to-number (match-string 2 a))) "") + (if (match-end 4) + (format "$%05d" (string-to-number (match-string 4 a))) "") + (if (match-end 5) + (concat "@@" (match-string 5 a)))))) (defun org-table-formula-less-p (a b) "Compare two formulas for sorting." @@ -1969,12 +2109,15 @@ When NAMED is non-nil, look for a named equation." (save-excursion (goto-char (org-table-end)) (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") - (setq strings (org-split-string (match-string 2) " *:: *")) + (setq strings (org-split-string (org-match-string-no-properties 2) + " *:: *")) (while (setq string (pop strings)) - (when (string-match "\\`\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string) + (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string) (setq scol (if (match-end 2) (match-string 2 string) (match-string 1 string)) + scol (if (member (string-to-char scol) '(?< ?>)) + (concat "$" scol) scol) eq (match-string 3 string) eq-alist (cons (cons scol eq) eq-alist)) (if (member scol seen) @@ -2027,7 +2170,8 @@ For all numbers larger than LIMIT, shift them by DELTA." org-table-named-field-locations nil org-table-current-begin-line nil org-table-current-begin-pos nil - org-table-current-line-types nil) + org-table-current-line-types nil + org-table-current-ncol 0) (goto-char beg) (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) (setq names (org-split-string (match-string 1) " *| *") @@ -2083,6 +2227,7 @@ For all numbers larger than LIMIT, shift them by DELTA." "[ \t]*|[ \t]*")) (nfields (length fields)) al al2) + (setq org-table-current-ncol nfields) (loop for i from 1 to nfields do (push (list (format "LR%d" i) l i) al) (push (cons (format "LR%d" i) (nth (1- i) fields)) al2)) @@ -2091,7 +2236,6 @@ For all numbers larger than LIMIT, shift them by DELTA." (setq org-table-local-parameters (append org-table-local-parameters al2)))))) - (defun org-table-maybe-eval-formula () "Check if the current field starts with \"=\" or \":=\". If yes, store the formula and apply it." @@ -2180,7 +2324,8 @@ of the new mark." (org-goto-line l1))) (if (not (= epos (point-at-eol))) (org-table-align)) (org-goto-line l) - (and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks)))))) + (and (org-called-interactively-p 'interactive) + (message "%s" (cdr (assoc new org-recalc-marks)))))) (defun org-table-maybe-recalculate-line () "Recompute the current line if marked for it, and if we haven't just done it." @@ -2264,7 +2409,7 @@ not overwrite the stored one." (modes (copy-sequence org-calc-default-modes)) (numbers nil) ; was a variable, now fixed default (keep-empty nil) - n form form0 bw fmt x ev orig c lispp literal) + n form form0 formrpl formrg bw fmt x ev orig c lispp literal duration) ;; Parse the format string. Since we have a lot of modes, this is ;; a lot of work. However, I think calc still uses most of the time. (if (string-match ";" formula) @@ -2283,8 +2428,17 @@ not overwrite the stored one." (?s . sci) (?e . eng)))) n)))) (setq fmt (replace-match "" t t fmt))) - (if (string-match "[NT]" fmt) - (setq numbers (equal (match-string 0 fmt) "N") + (if (string-match "T" fmt) + (setq duration t numbers t + duration-output-format nil + fmt (replace-match "" t t fmt))) + (if (string-match "t" fmt) + (setq duration t + duration-output-format org-table-duration-custom-format + numbers t + fmt (replace-match "" t t fmt))) + (if (string-match "N" fmt) + (setq numbers t fmt (replace-match "" t t fmt))) (if (string-match "L" fmt) (setq literal t @@ -2305,13 +2459,18 @@ not overwrite the stored one." (org-no-properties (buffer-substring (point-at-bol) (point-at-eol))) " *| *")) + ;; replace fields with duration values if relevant + (if duration + (setq fields + (mapcar (lambda (x) (org-table-time-string-to-seconds x)) + fields))) (if (eq numbers t) (setq fields (mapcar (lambda (x) (number-to-string (string-to-number x))) fields))) (setq ndown (1- ndown)) (setq form (copy-sequence formula) - lispp (and (> (length form) 2)(equal (substring form 0 2) "'("))) + lispp (and (> (length form) 2) (equal (substring form 0 2) "'("))) (if (and lispp literal) (setq lispp 'literal)) ;; Insert row and column number of formula result field @@ -2342,13 +2501,22 @@ not overwrite the stored one." ;; Insert complex ranges (while (and (string-match org-table-range-regexp form) (> (length (match-string 0 form)) 1)) - (setq form - (replace-match - (save-match-data - (org-table-make-reference - (org-table-get-range (match-string 0 form) nil n0) - keep-empty numbers lispp)) - t t form))) + (setq formrg (save-match-data + (org-table-get-range (match-string 0 form) nil n0))) + (setq formrpl + (save-match-data + (org-table-make-reference + ;; possibly handle durations + (if duration + (if (listp formrg) + (mapcar (lambda(x) (org-table-time-string-to-seconds x)) formrg) + (org-table-time-string-to-seconds formrg)) + formrg) + keep-empty numbers lispp))) + (if (not (save-match-data + (string-match (regexp-quote form) formrpl))) + (setq form (replace-match formrpl t t form)) + (error "Spreadsheet error: invalid reference \"%s\"" form))) ;; Insert simple ranges (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) (setq form @@ -2362,9 +2530,10 @@ not overwrite the stored one." t t form))) (setq form0 form) ;; Insert the references to fields in same row - (while (string-match "\\$\\([0-9]+\\)" form) - (setq n (string-to-number (match-string 1 form)) - x (nth (1- (if (= n 0) n0 n)) fields)) + (while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form) + (setq n (+ (string-to-number (match-string 1 form)) + (if (match-end 2) n0 0)) + x (nth (1- (if (= n 0) n0 (max n 1))) fields)) (unless x (error "Invalid field specifier \"%s\"" (match-string 0 form))) (setq form (replace-match @@ -2376,11 +2545,16 @@ not overwrite the stored one." (setq ev (condition-case nil (eval (eval (read form))) (error "#ERROR")) - ev (if (numberp ev) (number-to-string ev) ev)) + ev (if (numberp ev) (number-to-string ev) ev) + ev (if duration (org-table-time-seconds-to-string + (string-to-number ev) + duration-output-format) ev)) (or (fboundp 'calc-eval) (error "Calc does not seem to be installed, and is needed to evaluate the formula")) - (setq ev (calc-eval (cons form modes) - (if numbers 'num)))) + (setq ev (calc-eval (cons form modes) (if numbers 'num)) + ev (if duration (org-table-time-seconds-to-string + (string-to-number ev) + duration-output-format) ev))) (when org-table-formula-debug (with-output-to-temp-buffer "*Substitution History*" @@ -2397,7 +2571,7 @@ $1-> %s\n" orig formula form0 form)) (if fmt (format fmt (string-to-number ev)) ev))))) (setq bw (get-buffer-window "*Substitution History*")) (org-fit-window-to-buffer bw) - (unless (and (interactive-p) (not ndown)) + (unless (and (org-called-interactively-p 'any) (not ndown)) (unless (let (inhibit-redisplay) (y-or-n-p "Debugging Formula. Continue to next? ")) (org-table-align) @@ -2420,11 +2594,16 @@ $1-> %s\n" orig formula form0 form)) (progn (skip-chars-forward "^|") (point)) prop value))) -(defun org-table-get-range (desc &optional tbeg col highlight) +(defun org-table-get-range (desc &optional tbeg col highlight corners-only) "Get a calc vector from a column, according to descriptor DESC. Optional arguments TBEG and COL can give the beginning of the table and the current column, to avoid unnecessary parsing. -HIGHLIGHT means just highlight the range." + +HIGHLIGHT means just highlight the range. + +When CORNERS-ONLY is set, only return the corners of the range as +a list (line1 column1 line2 column2) where line1 and line2 are line numbers +in the buffer and column1 and column2 are table column numbers." (if (not (equal (string-to-char desc) ?@)) (setq desc (concat "@" desc))) (save-excursion @@ -2453,7 +2632,8 @@ HIGHLIGHT means just highlight the range." (if (not r2) (setq r2 thisline)) (if (not c1) (setq c1 col)) (if (not c2) (setq c2 col)) - (if (or (not rangep) (and (= r1 r2) (= c1 c2))) + (if (and (not corners-only) + (or (not rangep) (and (= r1 r2) (= c1 c2)))) ;; just one field (progn (org-goto-line r1) @@ -2465,22 +2645,26 @@ HIGHLIGHT means just highlight the range." ;; First sort the numbers to get a regular ractangle (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp)) (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp)) - (org-goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (org-table-goto-column c1) - (setq beg (point)) - (org-goto-line r2) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 0)) - (org-table-goto-column c2) - (setq end (point)) - (if highlight - (org-table-highlight-rectangle - beg (progn (skip-chars-forward "^|\n") (point)))) - ;; return string representation of calc vector - (mapcar 'org-trim - (apply 'append (org-table-copy-region beg end))))))) + (if corners-only + ;; Only return the corners of the range + (list r1 c1 r2 c2) + ;; Copy the range values into a list + (org-goto-line r1) + (while (not (looking-at org-table-dataline-regexp)) + (beginning-of-line 2)) + (org-table-goto-column c1) + (setq beg (point)) + (org-goto-line r2) + (while (not (looking-at org-table-dataline-regexp)) + (beginning-of-line 0)) + (org-table-goto-column c2) + (setq end (point)) + (if highlight + (org-table-highlight-rectangle + beg (progn (skip-chars-forward "^|\n") (point)))) + ;; return string representation of calc vector + (mapcar 'org-trim + (apply 'append (org-table-copy-region beg end)))))))) (defun org-table-get-descriptor-line (desc &optional cline bline table) "Analyze descriptor DESC and retrieve the corresponding line number. @@ -2596,16 +2780,29 @@ known that the table will be realigned a little later anyway." (org-table-get-specials) (let* ((eqlist (sort (org-table-get-stored-formulas) (lambda (a b) (string< (car a) (car b))))) + (eqlist1 (copy-sequence eqlist)) (inhibit-redisplay (not debug-on-error)) (line-re org-table-dataline-regexp) (thisline (org-current-line)) (thiscol (org-table-current-column)) - beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name) + seen-fields lhs1 + beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1) ;; Insert constants in all formulas (setq eqlist (mapcar (lambda (x) - (setcdr x (org-table-formula-substitute-names (cdr x))) - x) + (when (string-match "\\`$[<>]" (car x)) + (setq lhs1 (car x)) + (setq x (cons (substring + (org-table-formula-handle-first/last-rc + (car x)) 1) + (cdr x))) + (if (assoc (car x) eqlist1) + (error "\"%s=\" formula tries to overwrite existing formula for column %s" + lhs1 (car x)))) + (cons + (org-table-formula-handle-first/last-rc (car x)) + (org-table-formula-substitute-names + (org-table-formula-handle-first/last-rc (cdr x))))) eqlist)) ;; Split the equation list (while (setq eq (pop eqlist)) @@ -2613,6 +2810,10 @@ known that the table will be realigned a little later anyway." (push eq eqlnum) (push eq eqlname))) (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) + ;; Expand ranges in lhs of formulas + (setq eqlname (org-table-expand-lhs-ranges eqlname)) + + ;; Get the correct line range to process (if all (progn (setq end (move-marker (make-marker) (1+ (org-table-end)))) @@ -2631,11 +2832,19 @@ known that the table will be realigned a little later anyway." (goto-char beg) (and all (message "Re-applying formulas to full table...")) - ;; First find the named fields, and mark them untouchable + ;; First find the named fields, and mark them untouchable. + ;; Also check if several field/range formulas try to set the same field. (remove-text-properties beg end '(org-untouchable t)) (while (setq eq (pop eqlname)) (setq name (car eq) a (assoc name org-table-named-field-locations)) + (setq name1 name) + (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a)) + (nth 2 a)))) + (when (member name1 seen-fields) + (error "Several field/range formulas try to set %s" name1)) + (push name1 seen-fields) + (and (not a) (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) (setq a (list name @@ -2651,6 +2860,7 @@ known that the table will be realigned a little later anyway." (org-table-goto-column (nth 2 a)) (push (append a (list (cdr eq))) eqlname1) (org-table-put-field-property :org-untouchable t))) + (setq eqlname1 (nreverse eqlname1)) ;; Now evaluate the column formulas, but skip fields covered by ;; field formulas @@ -2691,7 +2901,9 @@ known that the table will be realigned a little later anyway." (and all (message "Re-applying formulas...done")))))) (defun org-table-iterate (&optional arg) - "Recalculate the table until it does not change anymore." + "Recalculate the table until it does not change anymore. +The maximun number of iterations is 10, but you can chose a different value +with the prefix ARG." (interactive "P") (let ((imax (if arg (prefix-numeric-value arg) 10)) (i 0) @@ -2740,6 +2952,64 @@ known that the table will be realigned a little later anyway." (setq checksum c1))) (error "No convergence after %d iterations" imax)))))) +(defun org-table-expand-lhs-ranges (equations) + "Expand list of formulas. +If some of the RHS in the formulas are ranges or a row reference, expand +them to individual field equations for each field." + (let (e res lhs rhs range r1 r2 c1 c2) + (while (setq e (pop equations)) + (setq lhs (car e) rhs (cdr e)) + (cond + ((string-match "^@-?[-+I0-9]+\\$-?[0-9]+$" lhs) + ;; This just refers to one fixed field + (push e res)) + ((string-match "^[a-zA-Z][a-zA-Z0-9]*$" lhs) + ;; This just refers to one fixed named field + (push e res)) + ((string-match "^@[0-9]+$" lhs) + (loop for ic from 1 to org-table-current-ncol do + (push (cons (format "%s$%d" lhs ic) rhs) res) + (put-text-property 0 (length (caar res)) + :orig-eqn e (caar res)))) + (t + (setq range (org-table-get-range lhs org-table-current-begin-pos + 1 nil 'corners)) + (setq r1 (nth 0 range) c1 (nth 1 range) + r2 (nth 2 range) c2 (nth 3 range)) + (setq r1 (org-table-line-to-dline r1)) + (setq r2 (org-table-line-to-dline r2 'above)) + (loop for ir from r1 to r2 do + (loop for ic from c1 to c2 do + (push (cons (format "@%d$%d" ir ic) rhs) res) + (put-text-property 0 (length (caar res)) + :orig-eqn e (caar res))))))) + (nreverse res))) + +(defun org-table-formula-handle-first/last-rc (s) + "Replace @<, @>, $<, $> with first/last row/column of the table. +So @< and $< will always be replaced with @1 and $1, respectively. +The advantage of these special markers are that structure editing of +the table will not change them, while @1 and $1 will be modified +when a line/row is swaped out of that privileged position. So for +formulas that use a range of rows or columns, it may often be better +to anchor the formula with \"I\" row markers, or to offset from the +borders of the table using the @< @> $< $> makers." + (let (n nmax len char) + (while (string-match "\\([@$]\\)\\(<+\\|>+\\)" s) + (setq nmax (if (equal (match-string 1 s) "@") + (1- (length org-table-dlines)) + org-table-current-ncol) + len (- (match-end 2) (match-beginning 2)) + char (string-to-char (match-string 2 s)) + n (if (= char ?<) + len + (- nmax len -1))) + (if (or (< n 1) (> n nmax)) + (error "Reference \"%s\" in expression \"%s\" points outside table" + (match-string 0 s) s)) + (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s)))) + s) + (defun org-table-formula-substitute-names (f) "Replace $const with values in string F." (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) @@ -2842,7 +3112,7 @@ Parameters get priority." (wc (current-window-configuration)) (sel-win (selected-window)) (titles '((column . "# Column Formulas\n") - (field . "# Field Formulas\n") + (field . "# Field and Range Formulas\n") (named . "# Named Field Formulas\n"))) entry s type title) (org-switch-to-buffer-other-window "*Edit Formulas*") @@ -2860,15 +3130,16 @@ Parameters get priority." (setq startline (org-current-line)) (while (setq entry (pop eql)) (setq type (cond + ((string-match "\\`$[<>]" (car entry)) 'column) ((equal (string-to-char (car entry)) ?@) 'field) ((string-match "^[0-9]" (car entry)) 'column) (t 'named))) (when (setq title (assq type titles)) (or (bobp) (insert "\n")) (insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) - (setq titles (delq title titles))) + (setq titles (remove title titles))) (if (equal key (car entry)) (setq startline (org-current-line))) - (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$") + (setq s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$") (car entry) " = " (cdr entry) "\n")) (remove-text-properties 0 (length s) '(face nil) s) (insert s)) @@ -2899,7 +3170,7 @@ Parameters get priority." s)) (defun org-table-convert-refs-to-rc (s) - "Convert spreadsheet references from AB7 to @7$28. + "Convert spreadsheet references from A7 to @7$28. Works for single references, but also for entire formulas and even the full TBLFM line." (let ((start 0)) @@ -2967,6 +3238,45 @@ For example: 28 -> AB." n (/ (1- n) 26))) s)) +(defun org-table-time-string-to-seconds (s) + "Convert a time string into numerical duration in seconds. +S can be a string matching either -?HH:MM:SS or -?HH:MM. +If S is a string representing a number, keep this number." + (let (hour min sec res) + (cond + ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s)) + (setq minus (< 0 (length (match-string 1 s))) + hour (string-to-number (match-string 2 s)) + min (string-to-number (match-string 3 s)) + sec (string-to-number (match-string 4 s))) + (if minus + (setq res (- (+ (* hour 3600) (* min 60) sec))) + (setq res (+ (* hour 3600) (* min 60) sec)))) + ((and (not (string-match org-ts-regexp-both s)) + (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s)) + (setq minus (< 0 (length (match-string 1 s))) + hour (string-to-number (match-string 2 s)) + min (string-to-number (match-string 3 s))) + (if minus + (setq res (- (+ (* hour 3600) (* min 60)))) + (setq res (+ (* hour 3600) (* min 60))))) + (t (setq res (string-to-number s)))) + (number-to-string res))) + +(defun org-table-time-seconds-to-string (secs &optional output-format) + "Convert a number of seconds to a time string. +If OUTPUT-FORMAT is non-nil, return a number of days, hours, +minutes or seconds." + (cond ((eq output-format 'days) + (format "%.3f" (/ (float secs) 86400))) + ((eq output-format 'hours) + (format "%.2f" (/ (float secs) 3600))) + ((eq output-format 'minutes) + (format "%.1f" (/ (float secs) 60))) + ((eq output-format 'seconds) + (format "%d" secs)) + (t (org-format-seconds "%.2h:%.2m:%.2s" secs)))) + (defun org-table-fedit-convert-buffer (function) "Convert all references in this buffer, using FUNCTION." (let ((line (org-current-line))) @@ -3083,7 +3393,7 @@ With prefix ARG, apply the new formulas to the table." (let ((pos org-pos) (sel-win org-selected-window) eql var form) (goto-char (point-min)) (while (re-search-forward - "^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" + "^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" nil t) (setq var (if (match-end 2) (match-string 2) (match-string 1)) form (match-string 3)) @@ -3172,6 +3482,12 @@ With prefix ARG, apply the new formulas to the table." var name e what match dest) (if local (org-table-get-specials)) (setq what (cond + ((org-at-regexp-p "^@[0-9]+[ \t=]") + (setq match (concat (substring (match-string 0) 0 -1) + "$1.." + (substring (match-string 0) 0 -1) + "$100")) + 'range) ((or (org-at-regexp-p org-table-range-regexp2) (org-at-regexp-p org-table-translate-regexp) (org-at-regexp-p org-table-range-regexp)) @@ -3530,14 +3846,14 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (defun org-table-cleanup-narrow-column-properties () "Remove all properties related to narrow-column invisibility." - (let ((s 1)) + (let ((s (point-min))) (while (setq s (text-property-any s (point-max) 'display org-narrow-column-arrow)) (remove-text-properties s (1+ s) '(display t))) - (setq s 1) + (setq s (point-min)) (while (setq s (text-property-any s (point-max) 'org-cwidth 1)) (remove-text-properties s (1+ s) '(org-cwidth t))) - (setq s 1) + (setq s (point-min)) (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth)) (remove-text-properties s (1+ s) '(invisible t))))) @@ -3720,12 +4036,13 @@ to execute outside of tables." If it is a table to be sent away to a receiver, do it. With prefix arg, also recompute table." (interactive "P") - (let ((pos (point)) action) + (let ((pos (point)) action consts-str consts cst const-str) (save-excursion (beginning-of-line 1) - (setq action (cond ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) - ((looking-at "[ \t]*|") pos) - ((looking-at "[ \t]*#\\+TBLFM:") 'recalc)))) + (setq action (cond + ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) + ((looking-at "[ \t]*|") pos) + ((looking-at "[ \t]*#\\+TBLFM:") 'recalc)))) (cond ((integerp action) (goto-char action) @@ -3738,6 +4055,17 @@ With prefix arg, also recompute table." (run-hooks 'orgtbl-after-send-table-hook))) ((eq action 'recalc) (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t) + (setq const-str (substring-no-properties (match-string 1))) + (setq consts (append consts (org-split-string const-str "[ \t]+"))) + (when consts + (let (e) + (while (setq e (pop consts)) + (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) + (push (cons (match-string 1 e) (match-string 2 e)) cst))) + (setq org-table-formula-constants-local cst))))) + (save-excursion (beginning-of-line 1) (skip-chars-backward " \r\n\t") (if (org-at-table-p) @@ -3792,7 +4120,7 @@ overwritten, and the table is not marked as requiring realignment." (looking-at "[^|\n]* +|")) (let (org-table-may-need-update) (goto-char (1- (match-end 0))) - (delete-backward-char 1) + (delete-char -1) (goto-char (match-beginning 0)) (self-insert-command N)) (setq org-table-may-need-update t) @@ -3910,7 +4238,7 @@ this table." (catch 'exit (unless (org-at-table-p) (error "Not at a table")) ;; when non-interactive, we assume align has just happened. - (when (interactive-p) (org-table-align)) + (when (org-called-interactively-p 'any) (org-table-align)) (let ((dests (orgtbl-gather-send-defs)) (txt (buffer-substring-no-properties (org-table-begin) (org-table-end))) @@ -4080,7 +4408,7 @@ This generic routine can be used for many standard cases. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. PARAMS is a property list of parameters that can influence the conversion. -For the generic converter, some parameters are obligatory: You need to +For the generic converter, some parameters are obligatory: you need to specify either :lfmt, or all of (:lstart :lend :sep). Valid parameters are @@ -4352,6 +4680,7 @@ list of the fields in the rectangle ." org-table-local-parameters org-table-named-field-locations org-table-current-line-types org-table-current-begin-line org-table-current-begin-pos org-table-dlines + org-table-current-ncol org-table-hlines org-table-last-alignment org-table-last-column-widths org-table-last-alignment org-table-last-column-widths tbeg @@ -4392,5 +4721,7 @@ list of the fields in the rectangle ." (provide 'org-table) +;; arch-tag: 4d21cfdd-0268-440a-84b0-09237a0fe0ef ;;; org-table.el ends here + diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el index 94341d80905..8a2ccc8dd83 100644 --- a/lisp/org/org-taskjuggler.el +++ b/lisp/org/org-taskjuggler.el @@ -1,10 +1,10 @@ ;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode ;; -;; Copyright (C) 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; ;; Emacs Lisp Archive Entry ;; Filename: org-taskjuggler.el -;; Version: 7.4 +;; Version: 7.7 ;; Author: Christian Egli ;; Maintainer: Christian Egli ;; Keywords: org, taskjuggler, project planning @@ -74,7 +74,7 @@ ;; TaskJugglerUI. ;; ;; * Resources -;; +;; ;; Next you can define resources and assign those to work on specific ;; tasks. You can group your resources hierarchically. Tag the top ;; node of the resources with "taskjuggler_resource" (or whatever you @@ -107,7 +107,7 @@ ;; etc for tasks. ;; ;; * Dependencies -;; +;; ;; The exporter will handle dependencies that are defined in the tasks ;; either with the ORDERED attribute (see TODO dependencies in the Org ;; mode manual) or with the BLOCKER attribute (see org-depend.el) or @@ -126,18 +126,18 @@ ;; :END: ;; ** Markup Guidelines ;; :PROPERTIES: -;; :Effort: 2.0 +;; :Effort: 2d ;; :END: ;; ** Workflow Guidelines ;; :PROPERTIES: -;; :Effort: 2.0 +;; :Effort: 2d ;; :END: ;; * Presentation ;; :PROPERTIES: -;; :Effort: 2.0 +;; :Effort: 2d ;; :BLOCKER: training_material { gapduration 1d } some_other_task ;; :END: -;; +;; ;;;; * TODO ;; - Use SCHEDULED and DEADLINE information (not just start and end ;; properties). @@ -181,6 +181,11 @@ resources for the project." :group 'org-export-taskjuggler :type 'string) +(defcustom org-export-taskjuggler-target-version 2.4 + "Which version of TaskJuggler the exporter is targeting." + :group 'org-export-taskjuggler + :type 'number) + (defcustom org-export-taskjuggler-default-project-version "1.0" "Default version string for the project." :group 'org-export-taskjuggler @@ -193,7 +198,7 @@ with `org-export-taskjuggler-project-tag'" :group 'org-export-taskjuggler :type 'integer) -(defcustom org-export-taskjuggler-default-reports +(defcustom org-export-taskjuggler-default-reports '("taskreport \"Gantt Chart\" { headline \"Project Gantt Chart\" columns hierarchindex, name, start, end, effort, duration, completed, chart @@ -212,7 +217,7 @@ with `org-export-taskjuggler-project-tag'" :group 'org-export-taskjuggler :type '(repeat (string :tag "Report"))) -(defcustom org-export-taskjuggler-default-global-properties +(defcustom org-export-taskjuggler-default-global-properties "shift s40 \"Part time shift\" { workinghours wed, thu, fri off } @@ -221,7 +226,7 @@ with `org-export-taskjuggler-project-tag'" define global properties such as shifts, accounts, rates, vacation, macros and flags. Any property that is allowed within the TaskJuggler file can be inserted. You could for example -include another TaskJuggler file. +include another TaskJuggler file. The global properties are inserted after the project declaration but before any resource and task declarations." @@ -257,14 +262,15 @@ defined in `org-export-taskjuggler-default-reports'." (setq-default org-done-keywords org-done-keywords) (let* ((tasks (org-taskjuggler-resolve-dependencies - (org-taskjuggler-assign-task-ids - (org-map-entries - '(org-taskjuggler-components) - org-export-taskjuggler-project-tag nil 'archive 'comment)))) + (org-taskjuggler-assign-task-ids + (org-taskjuggler-compute-task-leafiness + (org-map-entries + 'org-taskjuggler-components + org-export-taskjuggler-project-tag nil 'archive 'comment))))) (resources (org-taskjuggler-assign-resource-ids - (org-map-entries - '(org-taskjuggler-components) + (org-map-entries + 'org-taskjuggler-components org-export-taskjuggler-resource-tag nil 'archive 'comment))) (filename (expand-file-name (concat @@ -278,9 +284,9 @@ defined in `org-export-taskjuggler-default-reports'." (error "No tasks specified")) ;; add a default resource (unless resources - (setq resources - `((("resource_id" . ,(user-login-name)) - ("headline" . ,user-full-name) + (setq resources + `((("resource_id" . ,(user-login-name)) + ("headline" . ,user-full-name) ("level" . 1))))) ;; add a default allocation to the first task if none was given (unless (assoc "allocate" (car tasks)) @@ -331,6 +337,10 @@ with the TaskJuggler GUI." (command (concat process-name " " file-name))) (start-process-shell-command process-name nil command))) +(defun org-taskjuggler-targeting-tj3-p () + "Return true if we are targeting TaskJuggler III." + (>= org-export-taskjuggler-target-version 3.0)) + (defun org-taskjuggler-parent-is-ordered-p () "Return true if the parent of the current node has a property \"ORDERED\". Return nil otherwise." @@ -344,7 +354,9 @@ information, all the properties, etc." (let* ((props (org-entry-properties)) (components (org-heading-components)) (level (nth 1 components)) - (headline (nth 4 components)) + (headline + (replace-regexp-in-string + "\"" "\\\"" (nth 4 components) t t)) ; quote double quotes in headlines (parent-ordered (org-taskjuggler-parent-is-ordered-p))) (push (cons "level" level) props) (push (cons "headline" headline) props) @@ -362,16 +374,16 @@ a path to the current task." (dolist (task tasks resolved-tasks) (let ((level (cdr (assoc "level" task)))) (cond - ((< previous-level level) + ((< previous-level level) (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) (dotimes (tmp (- level previous-level)) (push (list unique-id) unique-ids) (push unique-id path))) - ((= previous-level level) + ((= previous-level level) (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) (push unique-id (car unique-ids)) (setcar path unique-id)) - ((> previous-level level) + ((> previous-level level) (dotimes (tmp (- previous-level level)) (pop unique-ids) (pop path)) @@ -383,18 +395,36 @@ a path to the current task." (setq previous-level level) (setq resolved-tasks (append resolved-tasks (list task))))))) -(defun org-taskjuggler-assign-resource-ids (resources &optional unique-ids) +(defun org-taskjuggler-compute-task-leafiness (tasks) + "Figure out if each task is a leaf by looking at it's level, +and the level of its successor. If the successor is higher (ie +deeper), then it's not a leaf." + (let (new-list) + (while (car tasks) + (let ((task (car tasks)) + (successor (car (cdr tasks)))) + (cond + ;; if a task has no successors it is a leaf + ((null successor) + (push (cons (cons "leaf-node" t) task) new-list)) + ;; if the successor has a lower level than task it is a leaf + ((<= (cdr (assoc "level" successor)) (cdr (assoc "level" task))) + (push (cons (cons "leaf-node" t) task) new-list)) + ;; otherwise examine the rest of the tasks + (t (push task new-list)))) + (setq tasks (cdr tasks))) + (nreverse new-list))) + +(defun org-taskjuggler-assign-resource-ids (resources) "Given a list of resources return the same list, assigning a unique id to each resource." - (cond - ((null resources) nil) - (t - (let* ((resource (car resources)) - (unique-id (org-taskjuggler-get-unique-id resource unique-ids))) - (push (cons "unique-id" unique-id) resource) - (cons resource - (org-taskjuggler-assign-resource-ids (cdr resources) - (cons unique-id unique-ids))))))) + (let (unique-ids new-list) + (dolist (resource resources new-list) + (let ((unique-id (org-taskjuggler-get-unique-id resource unique-ids))) + (push (cons "unique-id" unique-id) resource) + (push unique-id unique-ids) + (push resource new-list))) + (nreverse new-list))) (defun org-taskjuggler-resolve-dependencies (tasks) (let ((previous-level 0) @@ -405,24 +435,24 @@ unique id to each resource." (depends (cdr (assoc "depends" task))) (parent-ordered (cdr (assoc "parent-ordered" task))) (blocker (cdr (assoc "BLOCKER" task))) - (blocked-on-previous + (blocked-on-previous (and blocker (string-match "previous-sibling" blocker))) (dependencies (org-taskjuggler-resolve-explicit-dependencies - (append + (append (and depends (org-taskjuggler-tokenize-dependencies depends)) - (and blocker (org-taskjuggler-tokenize-dependencies blocker))) + (and blocker (org-taskjuggler-tokenize-dependencies blocker))) tasks)) previous-sibling) ; update previous sibling info (cond - ((< previous-level level) + ((< previous-level level) (dotimes (tmp (- level previous-level)) (push task siblings))) ((= previous-level level) (setq previous-sibling (car siblings)) (setcar siblings task)) - ((> previous-level level) + ((> previous-level level) (dotimes (tmp (- previous-level level)) (pop siblings)) (setq previous-sibling (car siblings)) @@ -432,7 +462,7 @@ unique id to each resource." (when (or (and previous-sibling parent-ordered) blocked-on-previous) (push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies)) ; store dependency information - (when dependencies + (when dependencies (push (cons "depends" (mapconcat 'identity dependencies ", ")) task)) (setq previous-level level) (setq resolved-tasks (append resolved-tasks (list task))))))) @@ -442,10 +472,10 @@ unique id to each resource." individual dependencies and return them as a list while keeping the optional arguments (such as gapduration) for the dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'." - (cond + (cond ((string-match "^ *$" dependencies) nil) ((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies) - (cons + (cons (substring dependencies (match-beginning 1) (match-end 1)) (org-taskjuggler-tokenize-dependencies (substring dependencies (match-end 0))))) (t (error (format "invalid dependency id %s" dependencies))))) @@ -459,27 +489,27 @@ where a matching tasks was found. If the dependency is `org-taskjuggler-resolve-dependencies'). If there is no matching task the dependency is ignored and a warning is displayed ." (unless (null dependencies) - (let* + (let* ;; the dependency might have optional attributes such as "{ ;; gapduration 5d }", so only use the first string as id for the ;; dependency ((dependency (car dependencies)) (id (car (split-string dependency))) - (optional-attributes + (optional-attributes (mapconcat 'identity (cdr (split-string dependency)) " ")) (path (org-taskjuggler-find-task-with-id id tasks))) - (cond + (cond ;; ignore previous sibling dependencies ((equal (car dependencies) "previous-sibling") (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)) ;; if the id is found in another task use its path - ((not (null path)) + ((not (null path)) (cons (mapconcat 'identity (list path optional-attributes) " ") - (org-taskjuggler-resolve-explicit-dependencies + (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))) ;; warn about dangling dependency but otherwise ignore it - (t (display-warning - 'org-export-taskjuggler + (t (display-warning + 'org-export-taskjuggler (format "No task with matching property \"task_id\" found for id %s" id)) (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)))))) @@ -488,7 +518,7 @@ task the dependency is ignored and a warning is displayed ." return nil." (let ((task-id (cdr (assoc "task_id" (car tasks)))) (path (cdr (assoc "path" (car tasks))))) - (cond + (cond ((null tasks) nil) ((equal task-id id) path) (t (org-taskjuggler-find-task-with-id id (cdr tasks)))))) @@ -509,10 +539,15 @@ finally add more underscore characters (\"_\")." (while (member id unique-ids) (setq id (concat id "_"))) id)) - + (defun org-taskjuggler-clean-id (id) "Clean and return ID to make it acceptable for taskjuggler." - (and id (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" id))) + (and id + ;; replace non-ascii by _ + (replace-regexp-in-string + "[^a-zA-Z0-9_]" "_" + ;; make sure id doesn't start with a number + (replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id)))) (defun org-taskjuggler-open-project (project) "Insert the beginning of a project declaration. All valid @@ -520,11 +555,11 @@ attributes from the PROJECT alist are inserted. If no end date is specified it is calculated `org-export-taskjuggler-default-project-duration' days from now." (let* ((unique-id (cdr (assoc "unique-id" project))) - (headline (cdr (assoc "headline" project))) - (version (cdr (assoc "version" project))) - (start (cdr (assoc "start" project))) - (end (cdr (assoc "end" project)))) - (insert + (headline (cdr (assoc "headline" project))) + (version (cdr (assoc "version" project))) + (start (cdr (assoc "start" project))) + (end (cdr (assoc "end" project)))) + (insert (format "project %s \"%s\" \"%s\" %s +%sd {\n }\n" unique-id headline version start org-export-taskjuggler-default-project-duration)))) @@ -534,16 +569,16 @@ specified it is calculated with separator \"\n\"." (let ((filtered-items (remq nil items))) (and filtered-items (mapconcat 'identity filtered-items "\n")))) - + (defun org-taskjuggler-get-attributes (item attributes) "Return all attribute as a single formated string. ITEM is an alist representing either a resource or a task. ATTRIBUTES is a list of symbols. Only entries from ITEM are considered that are listed in ATTRIBUTES." - (org-taskjuggler-filter-and-join + (org-taskjuggler-filter-and-join (mapcar - (lambda (attribute) - (org-taskjuggler-filter-and-join + (lambda (attribute) + (org-taskjuggler-filter-and-join (org-taskjuggler-get-attribute item attribute))) attributes))) @@ -551,7 +586,7 @@ listed in ATTRIBUTES." "Return a list of strings containing the properly formatted taskjuggler declaration for a given ATTRIBUTE in ITEM (an alist). If the ATTRIBUTE is not in ITEM return nil." - (cond + (cond ((null item) nil) ((equal (symbol-name attribute) (car (car item))) (cons (format "%s %s" (symbol-name attribute) (cdr (car item))) @@ -565,74 +600,77 @@ defines a property \"resource_id\" it will be used as the id for this resource. Otherwise it will use the ID property. If neither is defined it will calculate a unique id for the resource using `org-taskjuggler-get-unique-id'." - (let ((id (org-taskjuggler-clean-id - (or (cdr (assoc "resource_id" resource)) - (cdr (assoc "ID" resource)) + (let ((id (org-taskjuggler-clean-id + (or (cdr (assoc "resource_id" resource)) + (cdr (assoc "ID" resource)) (cdr (assoc "unique-id" resource))))) (headline (cdr (assoc "headline" resource))) (attributes '(limits vacation shift booking efficiency journalentry rate))) - (insert - (concat + (insert + (concat "resource " id " \"" headline "\" {\n " (org-taskjuggler-get-attributes resource attributes) "\n")))) (defun org-taskjuggler-clean-effort (effort) "Translate effort strings into a format acceptable to taskjuggler, -i.e. REAL UNIT. If the effort string is something like 5:30 it -will be assumed to be hours and will be translated into 5.5h. -Otherwise if it contains something like 3.0 it is assumed to be -days and will be translated into 3.0d. Other formats that -taskjuggler supports (like weeks, months and years) are currently -not supported." - (cond +i.e. REAL UNIT. A valid effort string can be anything that is +accepted by `org-duration-string-to-minutes´." + (cond ((null effort) effort) - ((string-match "\\([0-9]+\\):\\([0-9]+\\)" effort) - (let ((hours (string-to-number (match-string 1 effort))) - (minutes (string-to-number (match-string 2 effort)))) - (format "%dh" (+ hours (/ minutes 60.0))))) - ((string-match "\\([0-9]+\\).\\([0-9]+\\)" effort) (concat effort "d")) - (t (error "Not a valid effort (%s)" effort)))) + (t (let* ((minutes (org-duration-string-to-minutes effort)) + (hours (/ minutes 60.0))) + (format "%.1fh" hours))))) (defun org-taskjuggler-get-priority (priority) "Return a priority between 1 and 1000 based on PRIORITY, an org-mode priority string." - (max 1 (/ (* 1000 (- org-lowest-priority (string-to-char priority))) + (max 1 (/ (* 1000 (- org-lowest-priority (string-to-char priority))) (- org-lowest-priority org-highest-priority)))) (defun org-taskjuggler-open-task (task) (let* ((unique-id (cdr (assoc "unique-id" task))) - (headline (cdr (assoc "headline" task))) - (effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task)))) - (depends (cdr (assoc "depends" task))) - (allocate (cdr (assoc "allocate" task))) - (priority-raw (cdr (assoc "PRIORITY" task))) - (priority (and priority-raw (org-taskjuggler-get-priority priority-raw))) - (state (cdr (assoc "TODO" task))) - (complete (or (and (member state org-done-keywords) "100") - (cdr (assoc "complete" task)))) - (parent-ordered (cdr (assoc "parent-ordered" task))) - (previous-sibling (cdr (assoc "previous-sibling" task))) - (attributes - '(account start note duration endbuffer endcredit end - flags journalentry length maxend maxstart milestone - minend minstart period reference responsible - scheduling startbuffer startcredit statusnote))) + (headline (cdr (assoc "headline" task))) + (effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task)))) + (depends (cdr (assoc "depends" task))) + (allocate (cdr (assoc "allocate" task))) + (priority-raw (cdr (assoc "PRIORITY" task))) + (priority (and priority-raw (org-taskjuggler-get-priority priority-raw))) + (state (cdr (assoc "TODO" task))) + (complete (or (and (member state org-done-keywords) "100") + (cdr (assoc "complete" task)))) + (parent-ordered (cdr (assoc "parent-ordered" task))) + (previous-sibling (cdr (assoc "previous-sibling" task))) + (milestone (or (cdr (assoc "milestone" task)) + (and (assoc "leaf-node" task) + (not (or effort + (cdr (assoc "duration" task)) + (cdr (assoc "end" task)) + (cdr (assoc "period" task))))))) + (attributes + '(account start note duration endbuffer endcredit end + flags journalentry length maxend maxstart minend + minstart period reference responsible scheduling + startbuffer startcredit statusnote))) (insert - (concat - "task " unique-id " \"" headline "\" {\n" + (concat + "task " unique-id " \"" headline "\" {\n" (if (and parent-ordered previous-sibling) (format " depends %s\n" previous-sibling) (and depends (format " depends %s\n" depends))) - (and allocate (format " purge allocations\n allocate %s\n" allocate)) + (and allocate (format " purge %s\n allocate %s\n" + (or (and (org-taskjuggler-targeting-tj3-p) "allocate") + "allocations") + allocate)) (and complete (format " complete %s\n" complete)) (and effort (format " effort %s\n" effort)) (and priority (format " priority %s\n" priority)) - + (and milestone (format " milestone\n")) + (org-taskjuggler-get-attributes task attributes) "\n")))) (defun org-taskjuggler-close-maybe (level) - (while (> org-export-taskjuggler-old-level level) + (while (> org-export-taskjuggler-old-level level) (insert "}\n") (setq org-export-taskjuggler-old-level (1- org-export-taskjuggler-old-level))) (when (= org-export-taskjuggler-old-level level) diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index f920062362b..e612d45b145 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -1,11 +1,11 @@ ;;; org-timer.el --- The relative timer code for Org-mode -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -65,6 +65,9 @@ When 0, the user is prompted for a value." (defvar org-timer-pause-hook nil "Hook run before relative timer is paused.") +(defvar org-timer-continue-hook nil + "Hook run after relative timer is continued.") + (defvar org-timer-set-hook nil "Hook run after countdown timer is set.") @@ -128,6 +131,7 @@ With prefix arg STOP, stop it entirely." (org-float-time org-timer-start-time)))) org-timer-pause-time nil) (org-timer-set-mode-line 'on) + (run-hooks 'org-timer-continue-hook) (message "Timer continues at %s" (org-timer-value-string))) (t ;; pause timer @@ -203,22 +207,27 @@ it in the buffer." (defun org-timer-item (&optional arg) "Insert a description-type item with the current timer value." (interactive "P") - (cond - ;; In a timer list, insert with `org-list-insert-item-generic'. - ((and (org-in-item-p) - (save-excursion (org-beginning-of-item) (org-at-item-timer-p))) - (org-list-insert-item-generic - (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) - ;; In a list of another type, don't break anything: throw an error. - ((org-in-item-p) - (error "This is not a timer list")) - ;; Else, insert the timer correctly indented at bol. - (t - (beginning-of-line) - (org-indent-line-function) - (insert "- ") - (org-timer (when arg '(4))) - (insert ":: ")))) + (let ((itemp (org-in-item-p)) (pos (point))) + (cond + ;; In a timer list, insert with `org-list-insert-item', + ;; then fix the list. + ((and itemp (goto-char itemp) (org-at-item-timer-p)) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (s (concat (org-timer (when arg '(4)) t) ":: "))) + (setq struct (org-list-insert-item pos struct prevs nil s)) + (org-list-write-struct struct (org-list-parents-alist struct)) + (looking-at org-list-full-item-re) + (goto-char (match-end 0)))) + ;; In a list of another type, don't break anything: throw an error. + (itemp (goto-char pos) (error "This is not a timer list")) + ;; Else, start a new list. + (t + (beginning-of-line) + (org-indent-line-function) + (insert "- ") + (org-timer (when arg '(4))) + (insert ":: "))))) (defun org-timer-fix-incomplete (hms) "If hms is a H:MM:SS string with missing hour or hour and minute, fix it." @@ -364,7 +373,7 @@ replace any running timer." (org-show-entry) (or (ignore-errors (org-get-heading)) (concat "File:" (file-name-nondirectory (buffer-file-name))))))) - ((eq major-mode 'org-mode) + ((org-mode-p) (or (ignore-errors (org-get-heading)) (concat "File:" (file-name-nondirectory (buffer-file-name))))) (t (error "Not in an Org buffer")))) @@ -394,5 +403,6 @@ replace any running timer." (provide 'org-timer) +;; arch-tag: 97538f8c-3871-4509-8f23-1e7b3ff3d107 ;;; org-timer.el ends here diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el index 7ebeadbc4d9..d7e69e35092 100644 --- a/lisp/org/org-vm.el +++ b/lisp/org/org-vm.el @@ -1,11 +1,12 @@ ;;; org-vm.el --- Support for links to VM messages from within Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -53,8 +54,10 @@ ;; Implementation (defun org-vm-store-link () "Store a link to a VM folder or message." - (when (or (eq major-mode 'vm-summary-mode) - (eq major-mode 'vm-presentation-mode)) + (when (and (or (eq major-mode 'vm-summary-mode) + (eq major-mode 'vm-presentation-mode)) + (save-window-excursion + (vm-select-folder-buffer) buffer-file-name)) (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) (vm-follow-summary-cursor) (save-excursion @@ -137,5 +140,6 @@ (provide 'org-vm) +;; arch-tag: cbc3047b-935e-4d2a-96e7-c5b0117aaa6d ;;; org-vm.el ends here diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index ff839a9b7c2..dcdd02230d8 100644 --- a/lisp/org/org-w3m.el +++ b/lisp/org/org-w3m.el @@ -1,11 +1,11 @@ ;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode -;; Copyright (C) 2008-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -168,5 +168,6 @@ Return t if there is no previous link; otherwise, return nil." (provide 'org-w3m) +;; arch-tag: 851d7447-488d-49f0-a14d-46c092e84352 ;;; org-w3m.el ends here diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index f1616f8001d..1a0a357d4fd 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -1,12 +1,13 @@ ;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; David Maus <dmaus at ictsoc dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -309,5 +310,6 @@ for namazu index." (provide 'org-wl) +;; arch-tag: 29b75a0f-ef2e-430b-8abc-acff75bde54a ;;; org-wl.el ends here diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el index 39a4cc7a447..e81e4e74381 100644 --- a/lisp/org/org-xoxo.el +++ b/lisp/org/org-xoxo.el @@ -1,11 +1,12 @@ ;;; org-xoxo.el --- XOXO export for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -123,4 +124,5 @@ The XOXO buffer is named *xoxo-<source buffer name>*" (provide 'org-xoxo) +;; arch-tag: 16e6a31f-f4f5-46f1-af18-48dc89faa702 ;;; org-xoxo.el ends here diff --git a/lisp/org/org.el b/lisp/org/org.el index 265f02e4b7b..c29ef115400 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -1,11 +1,12 @@ ;;; org.el --- Outline-based notes management and organizer ;; Carstens outline-mode for keeping track of everything. -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 +;; Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.4 +;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -98,10 +99,18 @@ (require 'org-compat) (require 'org-faces) (require 'org-list) -(require 'org-complete) +(require 'org-pcomplete) (require 'org-src) (require 'org-footnote) +(declare-function org-inlinetask-at-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) +(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) +(declare-function org-at-clock-log-p "org-clock" ()) +(declare-function org-clock-timestamps-up "org-clock" ()) +(declare-function org-clock-timestamps-down "org-clock" ()) + ;; babel (require 'ob) (require 'ob-table) @@ -145,6 +154,7 @@ requirements) is loaded." :type '(alist :tag "Babel Languages" :key-type (choice + (const :tag "Awk" awk) (const :tag "C" C) (const :tag "R" R) (const :tag "Asymptote" asymptote) @@ -156,9 +166,12 @@ requirements) is loaded." (const :tag "Emacs Lisp" emacs-lisp) (const :tag "Gnuplot" gnuplot) (const :tag "Haskell" haskell) + (const :tag "Java" java) (const :tag "Javascript" js) (const :tag "Latex" latex) (const :tag "Ledger" ledger) + (const :tag "Lilypond" lilypond) + (const :tag "Maxima" maxima) (const :tag "Matlab" matlab) (const :tag "Mscgen" mscgen) (const :tag "Ocaml" ocaml) @@ -187,7 +200,7 @@ identifier." ;;; Version -(defconst org-version "7.4" +(defconst org-version "7.7" "The version number of the file org.el.") (defun org-version (&optional here) @@ -294,6 +307,7 @@ to add the symbol `xyz', and the package must have a call to (const :tag " mhe: Links to MHE folders/messages" org-mhe) (const :tag " protocol: Intercept calls from emacsclient" org-protocol) (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) + (const :tag " special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks) (const :tag " vm: Links to VM folders/messages" org-vm) (const :tag " wl: Links to Wanderlust folders/messages" org-wl) (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) @@ -306,7 +320,9 @@ to add the symbol `xyz', and the package must have a call to (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) (const :tag "C collector: Collect properties into tables" org-collector) (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) + (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill) (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol) + (const :tag "C eshell Support for links to working directories in eshell" org-eshell) (const :tag "C eval: Include command output as text" org-eval) (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry) @@ -319,16 +335,17 @@ to add the symbol `xyz', and the package must have a call to (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira) (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) + (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch) (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) (const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber) (const :tag "C man: Support for links to manpages in Org-mode" org-man) (const :tag "C mtags: Support for muse-like tags" org-mtags) + (const :tag "C odt: OpenDocumentText exporter for Org-mode" org-odt) (const :tag "C panel: Simple routines for us with bad memory" org-panel) (const :tag "C registry: A registry for Org-mode links" org-registry) (const :tag "C org2rem: Convert org appointments into reminders" org2rem) (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) (const :tag "C secretary: Team management with org-mode" org-secretary) - (const :tag "C special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks) (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) (const :tag "C track: Keep up with Org-mode development" org-track) @@ -1077,10 +1094,10 @@ for the duration of the command." (defcustom org-blank-before-new-entry '((heading . auto) (plain-list-item . auto)) "Should `org-insert-heading' leave a blank line before new heading/item? -The value is an alist, with `heading' and `plain-list-item' as car, -and a boolean flag as cdr. The cdr may lso be the symbol `auto', and then -Org will look at the surrounding headings/items and try to make an -intelligent decision wether to insert a blank line or not. +The value is an alist, with `heading' and `plain-list-item' as CAR, +and a boolean flag as CDR. The cdr may also be the symbol `auto', in +which case Org will look at the surrounding headings/items and try to +make an intelligent decision whether to insert a blank line or not. For plain lists, if the variable `org-empty-line-terminates-plain-lists' is set, the setting here is ignored and no empty line is inserted, to avoid @@ -1320,6 +1337,7 @@ The following %-escapes will be replaced by corresponding information: %c correspondent. Usually \"from NAME\", but if you sent it yourself, it will be \"to NAME\". See also the variable `org-from-is-user-regexp'. %s subject +%d date %m message-id. You may use normal field width specification between the % and the letter. @@ -1385,8 +1403,8 @@ nil Never use an ID to make a link, instead link using a text search for "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'. When this option is t, the entire active region -will be placed in the search string of the file link. If set to a +`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') @@ -1460,7 +1478,7 @@ Changing this requires a restart of Emacs to work correctly." (defcustom org-link-search-must-match-exact-headline 'query-to-create "Non-nil means internal links in Org files must exactly match a headline. -When nil, the link search tries to match a phrase will all words +When nil, the link search tries to match a phrase with all words in the search text." :group 'org-link-follow :type '(choice @@ -1480,6 +1498,7 @@ this link in another window or frame. This variable can be used to set this up for the different types of links. For VM, use any of `vm-visit-folder' + `vm-visit-folder-other-window' `vm-visit-folder-other-frame' For Gnus, use any of `gnus' @@ -1576,7 +1595,12 @@ single keystroke rather than having to type \"yes\"." (const :tag "no confirmation (dangerous)" nil))) (put 'org-confirm-shell-link-function 'safe-local-variable - (lambda (x) (member x '(yes-or-no-p y-or-n-p)))) + #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) + +(defcustom org-confirm-shell-link-not-regexp "" + "A regexp to skip confirmation for shell links." + :group 'org-link-follow + :type 'regexp) (defcustom org-confirm-elisp-link-function 'yes-or-no-p "Non-nil means ask for confirmation before executing Emacs Lisp links. @@ -1596,7 +1620,12 @@ single keystroke rather than having to type \"yes\"." (const :tag "no confirmation (dangerous)" nil))) (put 'org-confirm-shell-link-function 'safe-local-variable - (lambda (x) (member x '(yes-or-no-p y-or-n-p)))) + #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) + +(defcustom org-confirm-elisp-link-not-regexp "" + "A regexp to skip confirmation for Elisp links." + :group 'org-link-follow + :type 'regexp) (defconst org-file-apps-defaults-gnu '((remote . emacs) @@ -1843,7 +1872,7 @@ This is list of cons cells. Each cell contains: - a cons cell (:level . N). Any headline of level N is considered a target. Note that, when `org-odd-levels-only' is set, level corresponds to order in hierarchy, not to the number of stars. - - a cons cell (:maxlevel . N). Any headline with level <= N is a target. + - a cons cell (:maxlevel . N). Any headline with level <= N is a target. Note that, when `org-odd-levels-only' is set, level corresponds to order in hierarchy, not to the number of stars. @@ -1899,7 +1928,7 @@ When the value is `file', also include the file name (without directory) into the path. In this case, you can also stop the completion after the file name, to get entries inserted as top level in the file. - When `full-file-path', include the full file path." +When `full-file-path', include the full file path." :group 'org-refile :type '(choice (const :tag "Not" nil) @@ -1947,8 +1976,7 @@ heading." :group 'org-time) (defvar org-todo-interpretation-widgets - '( - (:tag "Sequence (cycling hits every state)" sequence) + '((:tag "Sequence (cycling hits every state)" sequence) (:tag "Type (cycling directly to DONE)" type)) "The available interpretation symbols for customizing `org-todo-keywords'. Interested libraries should add to this list.") @@ -2353,7 +2381,7 @@ When nil, state changes notes will be inserted after the headline and any scheduling and clock lines, but not inside a drawer. The value of this variable should be the name of the drawer to use. -LOGBOOK is proposed at the default drawer for this purpose, you can +LOGBOOK is proposed as the default drawer for this purpose, you can also set this to a string to define the drawer of your choice. A value of t is also allowed, representing \"LOGBOOK\". @@ -2377,7 +2405,7 @@ a subtree." "Return the value of `org-log-into-drawer', but let properties overrule. If the current entry has or inherits a LOG_INTO_DRAWER property, it will be used instead of the default value." - (let ((p (ignore-errors (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))) + (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit))) (cond ((or (not p) (equal p "nil")) org-log-into-drawer) ((equal p "t") "LOGBOOK") @@ -2418,7 +2446,7 @@ An auto-repeating task is immediately switched back to TODO when marked DONE. If you are not logging state changes (by adding \"@\" or \"!\" to the TODO keyword definition), or set `org-log-done' to record a closing note, there will be no record of the task moving -through DONE. This variable forces taking a note anyway. +through DONE. This variable forces taking a note anyway. nil Don't force a record time Record a time stamp @@ -2466,14 +2494,22 @@ Must have a larger ASCII number than `org-highest-priority'." (defcustom org-default-priority ?B "The default priority of TODO items. -This is the priority an item get if no explicit priority is given." +This is the priority an item gets if no explicit priority is given. +When starting to cycle on an empty priority the first step in the cycle +depends on `org-priority-start-cycle-with-default'. The resulting first +step priority must not exceed the range from `org-highest-priority' to +`org-lowest-priority' which means that `org-default-priority' has to be +in this range exclusive or inclusive the range boundaries. Else the +first step refuses to set the default and the second will fall back +to (depending on the command used) the highest or lowest priority." :group 'org-priorities :type 'character) (defcustom org-priority-start-cycle-with-default t "Non-nil means start with default priority when starting to cycle. When this is nil, the first step in the cycle will be (depending on the -command used) one higher or lower that the default priority." +command used) one higher or lower than the default priority. +See also `org-default-priority'." :group 'org-priorities :type 'boolean) @@ -2519,7 +2555,7 @@ a double prefix argument to a time stamp command like `C-c .' or `C-c !', and by using a prefix arg to `S-up/down' to specify the exact number of minutes to shift." :group 'org-time - :get (lambda (var) ; Make sure both elements are there + :get #'(lambda (var) ; Make sure both elements are there (if (integerp (default-value var)) (list (default-value var) 5) (default-value var))) @@ -2622,7 +2658,7 @@ See also `org-agenda-jump-prefer-future'." (defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future "Should the agenda jump command prefer the future for incomplete dates? The default is to do the same as configured in `org-read-date-prefer-future'. -But you can alse set a deviating value here. +But you can also set a deviating value here. This may t or nil, or the symbol `org-read-date-prefer-future'." :group 'org-agenda :group 'org-time @@ -2632,6 +2668,36 @@ This may t or nil, or the symbol `org-read-date-prefer-future'." (const :tag "Never" nil) (const :tag "Always" t))) +(defcustom org-read-date-force-compatible-dates t + "Should date/time prompt force dates that are guaranteed to work in Emacs? + +Depending on the system Emacs is running on, certain dates cannot +be represented with the type used internally to represent time. +Dates between 1970-1-1 and 2038-1-1 can always be represented +correctly. Some systems allow for earlier dates, some for later, +some for both. One way to find out it to insert any date into an +Org buffer, putting the cursor on the year and hitting S-up and +S-down to test the range. + +When this variable is set to t, the date/time prompt will not let +you specify dates outside the 1970-2037 range, so it is certain that +these dates will work in whatever version of Emacs you are +running, and also that you can move a file from one Emacs implementation +to another. WHenever Org is forcing the year for you, it will display +a message and beep. + +When this variable is nil, Org will check if the date is +representable in the specific Emacs implementation you are using. +If not, it will force a year, usually the current year, and beep +to remind you. Currently this setting is not recommended because +the likelihood that you will open your Org files in an Emacs that +has limited date range is not negligible. + +A workaround for this problem is to use diary sexp dates for time +stamps outside of this range." + :group 'org-time + :type 'boolean) + (defcustom org-read-date-display-live t "Non-nil means display current interpretation of date prompt live. This display will be in an overlay, in the minibuffer." @@ -2790,10 +2856,10 @@ it means that the tags should be flushright to that column. For example, :type 'integer) (defcustom org-auto-align-tags t - "Non-nil means realign tags after pro/demotion of TODO state change. -These operations change the length of a headline and therefore shift -the tags around. With this options turned on, after each such operation -the tags are again aligned to `org-tags-column'." + "Non-nil keeps tags aligned when modifying headlines. +Some operations (i.e. demoting) change the length of a headline and +therefore shift the tags around. With this option turned on, after +each such operation the tags are again aligned to `org-tags-column'." :group 'org-tags :type 'boolean) @@ -3021,7 +3087,7 @@ or contain a special line If the file does not specify a category, then file's base name is used instead.") (make-variable-buffer-local 'org-category) -(put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x)))) +(put 'org-category 'safe-local-variable #'(lambda (x) (or (symbolp x) (stringp x)))) (defcustom org-agenda-files nil "The files to be used for agenda display. @@ -3312,15 +3378,14 @@ lines to the buffer: :type 'boolean) (defcustom org-hidden-keywords nil - "List of keywords that should be hidden when typed in the org buffer. -For example, add #+TITLE to this list in order to make the -document title appear in the buffer without the initial #+TITLE: -keyword." + "List of symbols corresponding to keywords to be hidden the org buffer. +For example, a value '(title) for this list will make the document's title +appear in the buffer without the initial #+TITLE: keyword." :group 'org-appearance :type '(set (const :tag "#+AUTHOR" author) (const :tag "#+DATE" date) (const :tag "#+EMAIL" email) - (const :tag "#+TITLE" title))) + (const :tag "#+TITLE" title))) (defcustom org-fontify-done-headline nil "Non-nil means change the face of a headline if it is marked DONE. @@ -3843,7 +3908,7 @@ If yes, offer to stop it and to save the buffer with the changes." (defun org-clocktable-try-shift (dir n) "Check if this line starts a clock table, if yes, shift the time block." - (when (org-match-line "#\\+BEGIN: clocktable\\>") + (when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>") (org-clocktable-shift dir n))) ;; Autoload org-timer.el @@ -4634,7 +4699,11 @@ This variable is set by `org-before-change-function'. (defvar org-inhibit-logging nil) ; Dynamically-scoped param. (defvar org-inhibit-blocking nil) ; Dynamically-scoped param. (defvar org-table-buffer-is-an nil) -(defconst org-outline-regexp "\\*+ ") + +;; org-outline-regexp ought to be a defconst but is let-binding +;; in some places -- e.g. see the macro org-with-limited-levels +(defvar org-outline-regexp "\\*+ ") +(defconst org-outline-regexp-bol "^\\*+ ") ;;;###autoload (define-derived-mode org-mode outline-mode "Org" @@ -4716,6 +4785,8 @@ The following commands are available: ;; Beginning/end of defun (org-set-local 'beginning-of-defun-function 'org-beginning-of-defun) (org-set-local 'end-of-defun-function 'org-end-of-defun) + ;; Next error for sparse trees + (org-set-local 'next-error-function 'org-occur-next-match) ;; Make sure dependence stuff works reliably, even for users who set it ;; too late :-( (if org-enforce-todo-dependencies @@ -4758,7 +4829,7 @@ The following commands are available: ;; Setup the pcomplete hooks (set (make-local-variable 'pcomplete-command-completion-function) - 'org-complete-initial) + 'org-pcomplete-initial) (set (make-local-variable 'pcomplete-command-name-function) 'org-command-at-point) (set (make-local-variable 'pcomplete-default-completion-function) @@ -4766,10 +4837,12 @@ The following commands are available: (set (make-local-variable 'pcomplete-parse-arguments-function) 'org-parse-arguments) (set (make-local-variable 'pcomplete-termination-string) "") + (set (make-local-variable 'face-remapping-alist) + '((default org-default))) ;; 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) + (org-called-interactively-p 'any) (= (point-min) (point-max))) (insert "# -*- mode: org -*-\n\n")) (unless org-inhibit-startup @@ -4952,13 +5025,13 @@ This should be called after the variable `org-link-types' has changed." (defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>" "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]" +(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?\\)[]>]" "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]-+0-9>\r\n ]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" +(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" "Regular expression matching time strings for analysis. This one does not require the space after the date, so it can be used on a string that terminates immediately after the date.") -(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) +\\([^]-+0-9>\r\n ]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" +(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) +\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" "Regular expression matching time strings for analysis.") (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") "Regular expression matching time stamps, with groups.") @@ -4980,7 +5053,7 @@ The time stamps may be either active or inactive.") (defvar org-emph-face nil) (defun org-do-emphasis-faces (limit) - "Run through the buffer and add overlays to links." + "Run through the buffer and add overlays to emphasised strings." (let (rtn a) (while (and (not rtn) (re-search-forward org-emph-re limit t)) (if (not (= (char-after (match-beginning 3)) @@ -5096,6 +5169,11 @@ will be prompted for." :group 'org-babel) (defun org-fontify-meta-lines-and-blocks (limit) + (condition-case nil + (org-fontify-meta-lines-and-blocks-1 limit) + (error (message "org-mode fontification error")))) + +(defun org-fontify-meta-lines-and-blocks-1 (limit) "Fontify #+ lines and blocks, in the correct ways." (let ((case-fold-search t)) (if (re-search-forward @@ -5108,7 +5186,7 @@ will be prompted for." (beg1 (line-beginning-position 2)) (dc1 (downcase (match-string 2))) (dc3 (downcase (match-string 3))) - end end1 quoting block-type) + end end1 quoting block-type ovl) (cond ((member dc1 '("html:" "ascii:" "latex:" "docbook:")) ;; a single line of backend-specific content @@ -5137,20 +5215,30 @@ will be prompted for." beg end '(font-lock-fontified t font-lock-multiline t)) (add-text-properties beg beg1 '(face org-meta-line)) - (add-text-properties end1 (+ end 1) '(face org-meta-line)) - ; for end_src + (add-text-properties end1 (min (point-max) (1+ end)) + '(face org-meta-line)) ; for end_src (cond - ((and lang org-src-fontify-natively) - (org-src-font-lock-fontify-block lang block-start block-end)) + ((and lang (not (string= lang "")) org-src-fontify-natively) + (org-src-font-lock-fontify-block lang block-start block-end) + ;; remove old background overlays + (mapc (lambda (ov) + (if (eq (overlay-get ov 'face) 'org-block-background) + (delete-overlay ov))) + (overlays-at (/ (+ beg1 block-end) 2))) + ;; add a background overlay + (setq ovl (make-overlay beg1 block-end)) + (overlay-put ovl 'face 'org-block-background) + (overlay-put ovl 'evaporate t)) ;; make it go away when empty (quoting - (add-text-properties beg1 (+ end1 1) '(face - org-block))) - ; end of source block + (add-text-properties beg1 (min (point-max) (1+ end1)) + '(face org-block))) ; end of source block ((not org-fontify-quote-and-verse-blocks)) ((string= block-type "quote") - (add-text-properties beg1 end1 '(face org-quote))) + (add-text-properties beg1 (1+ end1) '(face org-quote))) ((string= block-type "verse") - (add-text-properties beg1 end1 '(face org-verse)))) + (add-text-properties beg1 (1+ end1) '(face org-verse)))) + (add-text-properties beg beg1 '(face org-block-begin-line)) + (add-text-properties (1+ end) (1+ end1) '(face org-block-end-line)) t)) ((member dc1 '("title:" "author:" "email:" "date:")) (add-text-properties @@ -5166,12 +5254,13 @@ will be prompted for." ((not (member (char-after beg) '(?\ ?\t))) ;; just any other in-buffer setting, but not indented (add-text-properties - beg (match-end 0) + beg (1+ (match-end 0)) '(font-lock-fontified t face org-meta-line)) t) ((or (member dc1 '("begin:" "end:" "caption:" "label:" "orgtbl:" "tblfm:" "tblname:" "result:" - "results:" "source:" "srcname:" "call:")) + "results:" "source:" "srcname:" "call:" + "data:" "header:" "headers:")) (and (match-end 4) (equal dc3 "attr"))) (add-text-properties beg (match-end 0) @@ -5195,21 +5284,21 @@ will be prompted for." t))) (defun org-activate-footnote-links (limit) - "Run through the buffer and add overlays to links." - (if (re-search-forward "\\(^\\|[^][]\\)\\(\\[\\([0-9]+\\]\\|fn:[^ \t\r\n:]+?[]:]\\)\\)" - limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 2) (match-end 2) + "Run through the buffer and add overlays to footnotes." + (let ((fn (org-footnote-next-reference-or-definition limit))) + (when fn + (let ((beg (nth 1 fn)) (end (nth 2 fn))) + (org-remove-flyspell-overlays-in beg end) + (add-text-properties beg end (list 'mouse-face 'highlight 'keymap org-mouse-map 'help-echo - (if (= (point-at-bol) (match-beginning 2)) + (if (= (point-at-bol) beg) "Footnote definition" "Footnote reference") - )) - (org-rear-nonsticky-at (match-end 2)) - t))) + 'font-lock-fontified t + 'font-lock-multiline t + 'face 'org-footnote)))))) (defun org-activate-bracket-links (limit) "Run through the buffer and add overlays to bracketed links." @@ -5423,6 +5512,7 @@ between words." "\\<\\(" (mapconcat (lambda (x) + (setq x (regexp-quote x)) (while (string-match " +" x) (setq x (replace-match "\\s-+" t t x))) x) @@ -5445,14 +5535,10 @@ between words." This function assumes that the cursor is at the beginning of a line matched by `outline-regexp'. Otherwise it returns garbage. If this is called at a normal headline, the level is the number of stars. -Use `org-reduced-level' to remove the effect of `org-odd-levels'. -For plain list items, if they are matched by `outline-regexp', this returns -1000 plus the line indentation." +Use `org-reduced-level' to remove the effect of `org-odd-levels'." (save-excursion - (looking-at outline-regexp) - (if (match-beginning 1) - (+ (org-get-string-indentation (match-string 1)) 1000) - (1- (- (match-end 0) (match-beginning 0)))))) + (looking-at org-outline-regexp) + (1- (- (match-end 0) (match-beginning 0))))) (defvar org-font-lock-keywords nil) @@ -5507,8 +5593,7 @@ needs to be inserted at a specific position in the font-lock sequence.") (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) - (if (memq 'footnote lk) '(org-activate-footnote-links - (2 'org-footnote t))) + (if (memq 'footnote lk) '(org-activate-footnote-links)) '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) '(org-hide-wide-columns (0 nil append)) ;; TODO lines @@ -5542,10 +5627,12 @@ needs to be inserted at a specific position in the font-lock sequence.") '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" (0 (org-get-checkbox-statistics-face) t))) ;; Description list items - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(.*? ::\\)" - 2 'bold prepend) + '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)" + 1 'bold prepend) ;; ARCHIVEd headings - (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") + (list (concat + org-outline-regexp-bol + "\\(.*:" org-archive-tag ":.*\\)") '(1 'org-archived prepend)) ;; Specials '(org-do-latex-and-special-faces) @@ -5575,7 +5662,7 @@ needs to be inserted at a specific position in the font-lock sequence.") (org-set-local 'org-pretty-entities (not org-pretty-entities)) (org-restart-font-lock) (if org-pretty-entities - (message "Entities are displayed as UTF8 characters") + (message "Entities are displayed as UTF8 characers") (save-restriction (widen) (org-decompose-region (point-min) (point-max)) @@ -5828,17 +5915,12 @@ in special contexts. (if org-odd-levels-only (and limit-level (1- (* limit-level 2))) limit-level))) - (outline-regexp - (cond - ((not (org-mode-p)) outline-regexp) - ((or (eq org-cycle-include-plain-lists 'integrate) - (and org-cycle-include-plain-lists (org-at-item-p))) - (concat "\\(?:\\*" - (if nstars (format "\\{1,%d\\}" nstars) "+") - " \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)")) - (t (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))) + (org-outline-regexp + (if (not (org-mode-p)) + outline-regexp + (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))) (bob-special (and org-cycle-global-at-bob (not arg) (bobp) - (not (looking-at outline-regexp)))) + (not (looking-at org-outline-regexp)))) (org-cycle-hook (if bob-special (delq 'org-optimize-window-after-visibility-change @@ -5861,8 +5943,8 @@ in special contexts. (show-all) (message "Entire buffer visible, including drawers")) + ;; Table: enter it or move to the next field. ((org-at-table-p 'any) - ;; Enter the table or move to the next field in the table (if (org-at-table.el-p) (message "Use C-c ' to edit table.el tables") (if arg (org-table-edit-field t) @@ -5872,31 +5954,39 @@ in special contexts. ((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook)) - ((eq arg t) ;; Global cycling - (org-cycle-internal-global)) + ;; Global cycling: delegate to `org-cycle-internal-global'. + ((eq arg t) (org-cycle-internal-global)) + ;; Drawers: delegate to `org-flag-drawer'. ((and org-drawers org-drawer-regexp (save-excursion (beginning-of-line 1) (looking-at org-drawer-regexp))) - ;; Toggle block visibility - (org-flag-drawer + (org-flag-drawer ; toggle block visibility (not (get-char-property (match-end 0) 'invisible)))) + ;; Show-subtree, ARG levels up from here. ((integerp arg) - ;; Show-subtree, ARG levels up from here. (save-excursion (org-back-to-heading) (outline-up-heading (if (< arg 0) (- arg) (- (funcall outline-level) arg))) (org-show-subtree))) - ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) + ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. + ((and (featurep 'org-inlinetask) + (org-inlinetask-at-task-p) (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) + (org-inlinetask-toggle-visibility)) + ;; At an item/headline: delegate to `org-cycle-internal-local'. + ((and (or (and org-cycle-include-plain-lists (org-at-item-p)) + (save-excursion (beginning-of-line 1) + (looking-at org-outline-regexp))) + (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) (org-cycle-internal-local)) - ;; TAB emulation and template completion + ;; From there: TAB emulation and template completion. (buffer-read-only (org-back-to-heading)) ((run-hook-with-args-until-success @@ -5911,7 +6001,7 @@ in special contexts. ((and (eq org-cycle-emulate-tab 'exc-hl-bol) (or (not (bolp)) - (not (looking-at outline-regexp)))) + (not (looking-at org-outline-regexp)))) (call-interactively (global-key-binding "\t"))) ((if (and (memq org-cycle-emulate-tab '(white whitestart)) @@ -5961,38 +6051,44 @@ in special contexts. (defun org-cycle-internal-local () "Do the local cycling action." - (let ((goal-column 0) eoh eol eos level has-children children-skipped) - ;; First, some boundaries + (let ((goal-column 0) eoh eol eos has-children children-skipped struct) + ;; First, determine end of headline (EOH), end of subtree or item + ;; (EOS), and if item or heading has children (HAS-CHILDREN). (save-excursion - (org-back-to-heading) - (setq level (funcall outline-level)) - (save-excursion - (beginning-of-line 2) - (if (or (featurep 'xemacs) (<= emacs-major-version 21)) - ; XEmacs does not have `next-single-char-property-change' - ; I'm not sure about Emacs 21. - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) + (if (org-at-item-p) + (progn + (beginning-of-line) + (setq struct (org-list-struct)) + (setq eoh (point-at-eol)) + (setq eos (org-list-get-item-end-before-blank (point) struct)) + (setq has-children (org-list-has-child-p (point) struct))) + (org-back-to-heading) + (setq eoh (save-excursion (outline-end-of-heading) (point))) + (setq eos (save-excursion + (org-end-of-subtree t) + (unless (eobp) + (skip-chars-forward " \t\n")) + (if (eobp) (point) (1- (point))))) + (setq has-children + (or (save-excursion + (let ((level (funcall outline-level))) + (outline-next-heading) + (and (org-at-heading-p t) + (> (funcall outline-level) level)))) + (save-excursion + (org-list-search-forward (org-item-beginning-re) eos t))))) + ;; Determine end invisible part of buffer (EOL) + (beginning-of-line 2) + ;; XEmacs doesn't have `next-single-char-property-change' + (if (featurep 'xemacs) (while (and (not (eobp)) ;; this is like `next-line' (get-char-property (1- (point)) 'invisible)) - (goto-char (next-single-char-property-change (point) 'invisible)) - (and (eolp) (beginning-of-line 2)))) - (setq eol (point))) - (outline-end-of-heading) (setq eoh (point)) - (save-excursion - (outline-next-heading) - (setq has-children (and (org-at-heading-p t) - (> (funcall outline-level) level)))) - ;; if we're in a list, org-end-of-subtree is in fact org-end-of-item. - (if (org-at-item-p) - (setq eos (if (and (org-end-of-item) (bolp)) - (1- (point)) - (point))) - (org-end-of-subtree t) - (unless (eobp) - (skip-chars-forward " \t\n")) - (setq eos (if (eobp) (point) (1- (point)))))) + (beginning-of-line 2)) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (goto-char (next-single-char-property-change (point) 'invisible)) + (and (eolp) (beginning-of-line 2)))) + (setq eol (point))) ;; Find out what to do next and set `this-command' (cond ((= eos eoh) @@ -6003,7 +6099,7 @@ in special contexts. (save-excursion (goto-char eos) (outline-next-heading) - (if (org-invisible-p) (org-flag-heading nil)))) + (if (outline-invisible-p) (org-flag-heading nil)))) ((and (or (>= eol eos) (not (string-match "\\S-" (buffer-substring eol eos)))) (or has-children @@ -6011,13 +6107,27 @@ in special contexts. org-cycle-skip-children-state-if-no-children)))) ;; Entire subtree is hidden in one line: children view (run-hook-with-args 'org-pre-cycle-hook 'children) - (org-show-entry) - (show-children) + (if (org-at-item-p) + (org-list-set-item-visibility (point-at-bol) struct 'children) + (org-show-entry) + (show-children) + ;; Fold every list in subtree to top-level items. + (when (eq org-cycle-include-plain-lists 'integrate) + (save-excursion + (org-back-to-heading) + (while (org-list-search-forward (org-item-beginning-re) eos t) + (beginning-of-line 1) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (end (org-list-get-bottom-point struct))) + (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded)) + (org-list-get-all-items (point) struct prevs)) + (goto-char end)))))) (message "CHILDREN") (save-excursion (goto-char eos) (outline-next-heading) - (if (org-invisible-p) (org-flag-heading nil))) + (if (outline-invisible-p) (org-flag-heading nil))) (setq org-cycle-subtree-status 'children) (run-hook-with-args 'org-cycle-hook 'children)) ((or children-skipped @@ -6113,7 +6223,7 @@ results." (interactive) (let ((level (save-excursion (goto-char (point-min)) - (if (re-search-forward (concat "^" outline-regexp) nil t) + (if (re-search-forward org-outline-regexp-bol nil t) (progn (goto-char (match-beginning 0)) (funcall outline-level)))))) @@ -6132,7 +6242,7 @@ With numerical argument N, show content up to level N." (outline-previous-visible-heading 1) (error (goto-char (point-min)))) t) - (looking-at outline-regexp)) + (looking-at org-outline-regexp)) (if (integerp arg) (show-children (1- arg)) (show-branches)) @@ -6184,9 +6294,9 @@ This function is the default value of the hook `org-cycle-hook'." ;; Properly fold already folded siblings (goto-char (point-min)) (while (re-search-forward re nil t) - (if (and (not (org-invisible-p)) + (if (and (not (outline-invisible-p)) (save-excursion - (goto-char (point-at-eol)) (org-invisible-p))) + (goto-char (point-at-eol)) (outline-invisible-p))) (hide-entry)))) (org-cycle-show-empty-lines 'overview) (org-cycle-hide-drawers 'overview))))) @@ -6252,7 +6362,7 @@ open and agenda-wise Org files." (let ((files (mapcar 'expand-file-name (org-agenda-files)))) (dolist (buf (buffer-list)) (with-current-buffer buf - (if (and (eq major-mode 'org-mode) (buffer-file-name)) + (if (and (org-mode-p) (buffer-file-name)) (let ((file (expand-file-name (buffer-file-name)))) (unless (member file files) (push file files)))))) @@ -6285,8 +6395,7 @@ open and agenda-wise Org files." (save-excursion (beginning-of-line 1) (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") - (let ((b (match-end 0)) - (outline-regexp org-outline-regexp)) + (let ((b (match-end 0))) (if (re-search-forward "^[ \t]*:END:" (save-excursion (outline-next-heading) (point)) t) @@ -6302,7 +6411,7 @@ open and agenda-wise Org files." "Move cursor to the first headline and recenter the headline. Optional argument N means put the headline into the Nth line of the window." (goto-char (point-min)) - (when (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t) + (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t) (beginning-of-line) (recenter (prefix-numeric-value N)))) @@ -6346,8 +6455,7 @@ DATA should have been made by `org-outline-overlay-data'." ;;; Folding of blocks (defconst org-block-regexp - - "^[ \t]*#\\+begin_\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_\\1[ \t]*$" + "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" "Regular expression for hiding blocks.") (defvar org-hide-block-overlays nil @@ -6496,8 +6604,8 @@ in an indirect buffer, in overview mode. You can dive into the tree in that copy, use org-occur and incremental search to find a location. When pressing RET or `Q', the command returns to the original buffer in which the visibility is still unchanged. After RET is will also jump to -the location selected in the indirect buffer and expose -the headline hierarchy above." +the location selected in the indirect buffer and expose the headline +hierarchy above." (interactive "P") (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) (org-refile-use-outline-path t) @@ -6512,14 +6620,14 @@ the headline hierarchy above." (selected-point (if (eq interface 'outline) (car (org-get-location (current-buffer) org-goto-help)) - (let ((pa (org-refile-get-location "Goto: "))) + (let ((pa (org-refile-get-location "Goto"))) (org-refile-check-position pa) (nth 3 pa))))) (if selected-point (progn (org-mark-ring-push org-goto-start-pos) (goto-char selected-point) - (if (or (org-invisible-p) (org-invisible-p2)) + (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'org-goto))) (message "Quit")))) @@ -6544,7 +6652,7 @@ or nil." (save-window-excursion (delete-other-windows) (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (switch-to-buffer + (org-pop-to-buffer-same-window (condition-case nil (make-indirect-buffer (current-buffer) "*org-goto*") (error (make-indirect-buffer (current-buffer) "*org-goto*")))) @@ -6564,7 +6672,7 @@ or nil." (org-show-siblings t) (org-show-following-heading t)) (goto-char org-goto-start-pos) - (and (org-invisible-p) (org-show-context))) + (and (outline-invisible-p) (org-show-context))) (goto-char (point-min))) (let (org-special-ctrl-a/e) (org-beginning-of-line)) (message "Select location and press RET") @@ -6682,7 +6790,7 @@ frame is not changed." (and arg (eq org-indirect-buffer-display 'dedicated-frame))) (select-frame (make-frame)) (delete-other-windows) - (switch-to-buffer ibuf) + (org-pop-to-buffer-same-window ibuf) (org-set-frame-title heading)) ((eq org-indirect-buffer-display 'dedicated-frame) (raise-frame @@ -6691,10 +6799,10 @@ frame is not changed." org-indirect-dedicated-frame) (setq org-indirect-dedicated-frame (make-frame))))) (delete-other-windows) - (switch-to-buffer ibuf) + (org-pop-to-buffer-same-window ibuf) (org-set-frame-title (concat "Indirect: " heading))) ((eq org-indirect-buffer-display 'current-window) - (switch-to-buffer ibuf)) + (org-pop-to-buffer-same-window ibuf)) ((eq org-indirect-buffer-display 'other-window) (pop-to-buffer ibuf)) (t (error "Invalid value"))) @@ -6779,14 +6887,14 @@ This is important for non-interactive uses of the command." (cond ((and (org-on-heading-p) (bolp) (or (bobp) - (save-excursion (backward-char 1) (not (org-invisible-p))))) + (save-excursion (backward-char 1) (not (outline-invisible-p))))) ;; insert before the current line (open-line (if blank 2 1))) ((and (bolp) (not org-insert-heading-respect-content) (or (bobp) (save-excursion - (backward-char 1) (not (org-invisible-p))))) + (backward-char 1) (not (outline-invisible-p))))) ;; insert right here nil) (t @@ -6794,7 +6902,7 @@ This is important for non-interactive uses of the command." (save-excursion (setq previous-pos (point-at-bol)) (end-of-line) - (setq hide-previous (org-invisible-p))) + (setq hide-previous (outline-invisible-p))) (and org-insert-heading-respect-content (org-show-subtree)) (let ((split (and (org-get-alist-option org-M-RET-may-split-line 'headline) @@ -6851,15 +6959,25 @@ This is important for non-interactive uses of the command." (hide-subtree))) (run-hooks 'org-insert-heading-hook))))) -(defun org-get-heading (&optional no-tags) - "Return the heading of the current entry, without the stars." +(defun org-get-heading (&optional no-tags no-todo) + "Return the heading of the current entry, without the stars. +When NO-TAGS is non-nil, don't include tags. +When NO-TODO is non-nil, don't include TODO keywords." (save-excursion (org-back-to-heading t) - (if (looking-at - (if no-tags - (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$") - "\\*+[ \t]+\\([^\r\n]*\\)")) - (match-string 1) ""))) + (cond + ((and no-tags no-todo) + (looking-at org-complex-heading-regexp) + (match-string 4)) + (no-tags + (looking-at "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$") + (match-string 1)) + (no-todo + (looking-at (concat "\\*+[ \t]+" org-todo-regexp " +" + "\\([^\n\r]*?[ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$")) + (match-string 2)) + (t (looking-at "\\*+[ \t]+\\([^\r\n]*\\)") + (match-string 1))))) (defun org-heading-components () "Return the components of the current heading. @@ -6928,7 +7046,7 @@ state (TODO by default). Also with prefix arg, force first state." 'org-todo-get-default-hook new-mark-x nil) new-mark-x))) (beginning-of-line 1) - (and (looking-at "\\*+ ") (goto-char (match-end 0)) + (and (looking-at org-outline-regexp) (goto-char (match-end 0)) (if org-treat-insert-todo-heading-as-state-change (org-todo new-mark) (insert new-mark " ")))) @@ -6970,7 +7088,7 @@ When a subtree is being promoted, the hook will be called for each node.") See also `org-promote'." (interactive) (save-excursion - (org-map-tree 'org-promote)) + (org-with-limited-levels (org-map-tree 'org-promote))) (org-fix-position-after-promote)) (defun org-demote-subtree () @@ -6978,7 +7096,7 @@ See also `org-promote'." See also `org-promote'." (interactive) (save-excursion - (org-map-tree 'org-demote)) + (org-with-limited-levels (org-map-tree 'org-demote))) (org-fix-position-after-promote)) @@ -7019,12 +7137,10 @@ 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 - (let ((outline-regexp (org-get-limited-outline-regexp))) - (condition-case nil - (progn - (org-back-to-heading t) - (funcall outline-level)) - (error nil))))) + (org-with-limited-levels + (ignore-errors + (org-back-to-heading t) + (funcall outline-level))))) (defun org-get-previous-line-level () "Return the outline depth of the last headline before the current line. @@ -7042,7 +7158,10 @@ first headline." (defun org-reduced-level (l) "Compute the effective level of a heading. This takes into account the setting of `org-odd-levels-only'." - (if org-odd-levels-only (1+ (floor (/ l 2))) l)) + (cond + ((zerop l) 0) + (org-odd-levels-only (1+ (floor (/ l 2)))) + (t l))) (defun org-level-increment () "Return the number of stars that will be added or removed at a @@ -7074,6 +7193,8 @@ If the region is active in `transient-mark-mode', promote all headings in the region." (org-back-to-heading t) (let* ((level (save-match-data (funcall outline-level))) + (after-change-functions (remove 'flyspell-after-change-function + after-change-functions)) (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) (diff (abs (- level (length up-head) -1)))) (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) @@ -7089,6 +7210,8 @@ If the region is active in `transient-mark-mode', demote all headings in the region." (org-back-to-heading t) (let* ((level (save-match-data (funcall outline-level))) + (after-change-functions (remove 'flyspell-after-change-function + after-change-functions)) (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) (diff (abs (- level (length down-head) -1)))) (replace-match down-head nil t) @@ -7151,7 +7274,7 @@ After top level, it switches back to sibling level." (save-excursion (setq end (copy-marker end)) (goto-char beg) - (if (and (re-search-forward (concat "^" outline-regexp) nil t) + (if (and (re-search-forward org-outline-regexp-bol nil t) (< (point) end)) (funcall fun)) (while (and (progn @@ -7187,8 +7310,7 @@ This will leave level 1 alone, convert level 2 to level 3, level 3 to level 5 etc." (interactive) (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") - (let ((outline-regexp org-outline-regexp) - (outline-level 'org-outline-level) + (let ((outline-level 'org-outline-level) (org-odd-levels-only nil) n) (save-excursion (goto-char (point-min)) @@ -7241,6 +7363,7 @@ case." 'org-get-last-sibling)) (ins-point (make-marker)) (cnt (abs arg)) + (col (current-column)) beg beg0 end txt folded ne-beg ne-end ne-ins ins-end) ;; Select the tree (org-back-to-heading) @@ -7250,7 +7373,7 @@ case." (setq beg (point))) (save-match-data (save-excursion (outline-end-of-heading) - (setq folded (org-invisible-p))) + (setq folded (outline-invisible-p))) (outline-end-of-subtree)) (outline-next-heading) (setq ne-end (org-back-over-empty-lines)) @@ -7264,7 +7387,7 @@ case." (setq beg (point)))) ;; Find insertion point, with error handling (while (> cnt 0) - (or (and (funcall movfunc) (looking-at outline-regexp)) + (or (and (funcall movfunc) (looking-at org-outline-regexp)) (progn (goto-char beg0) (error "Cannot move past superior level or buffer limit"))) (setq cnt (1- cnt))) @@ -7306,7 +7429,9 @@ case." (org-show-entry) (show-children) (org-cycle-hide-drawers 'children)) - (org-clean-visibility-after-subtree-move))) + (org-clean-visibility-after-subtree-move) + ;; move back to the initial column we were at + (move-to-column col))) (defvar org-subtree-clip "" "Clipboard for cut and paste of subtrees. @@ -7334,7 +7459,7 @@ of some markers in the region, even if CUT is non-nil. This is useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (interactive "p") (let (beg end folded (beg0 (point))) - (if (interactive-p) + (if (org-called-interactively-p 'any) (org-back-to-heading nil) ; take what looks like a subtree (org-back-to-heading t)) ; take what is really there (org-back-over-empty-lines) @@ -7342,7 +7467,7 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (skip-chars-forward " \t\r\n") (save-match-data (save-excursion (outline-end-of-heading) - (setq folded (org-invisible-p))) + (setq folded (outline-invisible-p))) (condition-case nil (org-forward-same-level (1- n) t) (error nil)) @@ -7390,88 +7515,86 @@ the inserted text when done." (error "%s" (substitute-command-keys "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) - (let* ((visp (not (org-invisible-p))) - (txt tree) - (^re (concat "^\\(" outline-regexp "\\)")) - (re (concat "\\(" outline-regexp "\\)")) - (^re_ (concat "\\(\\*+\\)[ \t]*")) - - (old-level (if (string-match ^re txt) - (- (match-end 0) (match-beginning 0) 1) - -1)) - (force-level (cond (level (prefix-numeric-value level)) - ((and (looking-at "[ \t]*$") - (string-match - ^re_ (buffer-substring - (point-at-bol) (point)))) - (- (match-end 1) (match-beginning 1))) - ((and (bolp) - (looking-at org-outline-regexp)) - (- (match-end 0) (point) 1)) - (t nil))) - (previous-level (save-excursion - (condition-case nil - (progn - (outline-previous-visible-heading 1) - (if (looking-at re) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (next-level (save-excursion - (condition-case nil - (progn - (or (looking-at outline-regexp) - (outline-next-visible-heading 1)) - (if (looking-at re) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (new-level (or force-level (max previous-level next-level))) - (shift (if (or (= old-level -1) - (= new-level -1) - (= old-level new-level)) - 0 - (- new-level old-level))) - (delta (if (> shift 0) -1 1)) - (func (if (> shift 0) 'org-demote 'org-promote)) - (org-odd-levels-only nil) - beg end newend) - ;; Remove the forced level indicator - (if force-level - (delete-region (point-at-bol) (point))) - ;; Paste - (beginning-of-line 1) - (unless for-yank (org-back-over-empty-lines)) - (setq beg (point)) - (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) - (insert-before-markers txt) - (unless (string-match "\n\\'" txt) (insert "\n")) - (setq newend (point)) - (org-reinstall-markers-in-region beg) - (setq end (point)) - (goto-char beg) - (skip-chars-forward " \t\n\r") - (setq beg (point)) - (if (and (org-invisible-p) visp) - (save-excursion (outline-show-heading))) - ;; Shift if necessary - (unless (= shift 0) - (save-restriction - (narrow-to-region beg end) - (while (not (= shift 0)) - (org-map-region func (point-min) (point-max)) - (setq shift (+ delta shift))) - (goto-char (point-min)) - (setq newend (point-max)))) - (when (or (interactive-p) for-yank) - (message "Clipboard pasted as level %d subtree" new-level)) - (if (and (not for-yank) ; in this case, org-yank will decide about folding - kill-ring - (eq org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (hide-subtree)) - (and for-yank (goto-char newend)))) + (org-with-limited-levels + (let* ((visp (not (outline-invisible-p))) + (txt tree) + (^re_ (concat "\\(\\*+\\)[ \t]*")) + (old-level (if (string-match org-outline-regexp-bol txt) + (- (match-end 0) (match-beginning 0) 1) + -1)) + (force-level (cond (level (prefix-numeric-value level)) + ((and (looking-at "[ \t]*$") + (string-match + ^re_ (buffer-substring + (point-at-bol) (point)))) + (- (match-end 1) (match-beginning 1))) + ((and (bolp) + (looking-at org-outline-regexp)) + (- (match-end 0) (point) 1)) + (t nil))) + (previous-level (save-excursion + (condition-case nil + (progn + (outline-previous-visible-heading 1) + (if (looking-at re) + (- (match-end 0) (match-beginning 0) 1) + 1)) + (error 1)))) + (next-level (save-excursion + (condition-case nil + (progn + (or (looking-at org-outline-regexp) + (outline-next-visible-heading 1)) + (if (looking-at re) + (- (match-end 0) (match-beginning 0) 1) + 1)) + (error 1)))) + (new-level (or force-level (max previous-level next-level))) + (shift (if (or (= old-level -1) + (= new-level -1) + (= old-level new-level)) + 0 + (- new-level old-level))) + (delta (if (> shift 0) -1 1)) + (func (if (> shift 0) 'org-demote 'org-promote)) + (org-odd-levels-only nil) + beg end newend) + ;; Remove the forced level indicator + (if force-level + (delete-region (point-at-bol) (point))) + ;; Paste + (beginning-of-line 1) + (unless for-yank (org-back-over-empty-lines)) + (setq beg (point)) + (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) + (insert-before-markers txt) + (unless (string-match "\n\\'" txt) (insert "\n")) + (setq newend (point)) + (org-reinstall-markers-in-region beg) + (setq end (point)) + (goto-char beg) + (skip-chars-forward " \t\n\r") + (setq beg (point)) + (if (and (outline-invisible-p) visp) + (save-excursion (outline-show-heading))) + ;; Shift if necessary + (unless (= shift 0) + (save-restriction + (narrow-to-region beg end) + (while (not (= shift 0)) + (org-map-region func (point-min) (point-max)) + (setq shift (+ delta shift))) + (goto-char (point-min)) + (setq newend (point-max)))) + (when (or (org-called-interactively-p 'interactive) for-yank) + (message "Clipboard pasted as level %d subtree" new-level)) + (if (and (not for-yank) ; in this case, org-yank will decide about folding + kill-ring + (eq org-subtree-clip (current-kill 0)) + org-subtree-clip-folded) + ;; The tree was folded before it was killed/copied + (hide-subtree)) + (and for-yank (goto-char newend))))) (defun org-kill-is-subtree-p (&optional txt) "Check if the current kill is an outline subtree, or a set of trees. @@ -7481,18 +7604,19 @@ So this will actually accept several entries of equal levels as well, which is OK for `org-paste-subtree'. If optional TXT is given, check this string instead of the current kill." (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) + (re (org-get-limited-outline-regexp)) + (^re (concat "^" re)) (start-level (and kill - (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" - org-outline-regexp "\\)") - kill) + (string-match + (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)") + kill) (- (match-end 2) (match-beginning 2) 1))) - (re (concat "^" org-outline-regexp)) (start (1+ (or (match-beginning 2) -1)))) (if (not start-level) (progn nil) ;; does not even start with a heading (catch 'exit - (while (setq start (string-match re kill (1+ start))) + (while (setq start (string-match ^re kill (1+ start))) (when (< (- (match-end 0) (match-beginning 0) 1) start-level) (throw 'exit nil))) t)))) @@ -7536,11 +7660,28 @@ If yes, remember the marker and the distance to BEG." (interactive) (save-excursion (save-match-data - (narrow-to-region - (progn (org-back-to-heading t) (point)) - (progn (org-end-of-subtree t t) - (if (and (org-on-heading-p) (not (eobp))) (backward-char 1)) - (point)))))) + (org-with-limited-levels + (narrow-to-region + (progn (org-back-to-heading t) (point)) + (progn (org-end-of-subtree t t) + (if (and (org-on-heading-p) (not (eobp))) (backward-char 1)) + (point))))))) + +(defun org-narrow-to-block () + "Narrow buffer to the current block." + (interactive) + (let ((bstart "^[ \t]*#\\+begin") + (bend "[ \t]*#\\+end") + (case-fold-search t) ;; allow #+BEGIN + b_start b_end) + (if (org-in-regexps-block-p bstart bend) + (progn + (save-excursion (re-search-backward bstart nil t) + (setq b_start (match-beginning 0))) + (save-excursion (re-search-forward bend nil t) + (setq b_end (match-end 0))) + (narrow-to-region b_start b_end)) + (error "Not in a block")))) (eval-when-compile (defvar org-property-drawer-re)) @@ -7594,6 +7735,19 @@ and still retain the repeater to cover future instances of the task." (or (bolp) (insert "\n")) (setq end (point)) (setq template (buffer-substring beg end)) + ;; Remove clocks and empty drawers + (with-temp-buffer + (insert template) + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*CLOCK:.*$" (save-excursion (org-end-of-subtree t t)) t) + (replace-match "") + (kill-whole-line)) + (goto-char (point-min)) + (while (re-search-forward + (concat "^[ \t]*:" (regexp-opt org-drawers) ":[ \t]*$") nil t) + (mapc (lambda(d) (org-remove-empty-drawer-at d (point))) org-drawers)) + (setq template (buffer-substring (point-min) (point-max)))) (when (and doshift (string-match "<[^<>\n]+ \\+[0-9]+[dwmy][^<>\n]*>" template)) (delete-region beg end) @@ -7737,7 +7891,7 @@ WITH-CASE, the sorting considers case as well." (looking-at "\\(\\*+\\)") (setq stars (match-string 1) re (concat "^" (regexp-quote stars) " +") - re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") + re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]") txt (buffer-substring beg end)) (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) (if (and (not (equal stars "*")) (string-match re2 txt)) @@ -8093,8 +8247,7 @@ Possible values in the list of contexts are `table', `headline', and `item'." (prog1 (or (and (memq 'table contexts) (looking-at "[ \t]*|")) (and (memq 'headline contexts) -;;????????? (looking-at "\\*+")) - (looking-at outline-regexp)) + (looking-at org-outline-regexp)) (and (memq 'item contexts) (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)")) (and (memq 'item-body contexts) @@ -8122,6 +8275,18 @@ Possible values in the list of contexts are `table', `headline', and `item'." x nil)) varlist)))) +(defun org-clone-local-variables (from-buffer &optional regexp) + "Clone local variables from FROM-BUFFER. +Optional argument REGEXP selects variables to clone." + (mapc + (lambda (pair) + (and (symbolp (car pair)) + (or (null regexp) + (string-match regexp (symbol-name (car pair)))) + (set (make-local-variable (car pair)) + (cdr pair)))) + (buffer-local-variables from-buffer))) + ;;;###autoload (defun org-run-like-in-org-mode (cmd) "Run a command, pretending that the current buffer is in Org-mode. @@ -8136,9 +8301,13 @@ call CMD." ;;;; Archiving -(defun org-get-category (&optional pos) +(defun org-get-category (&optional pos force-refresh) "Get the category applying to position POS." - (get-text-property (or pos (point)) 'org-category)) + (if force-refresh (org-refresh-category-properties)) + (let ((pos (or pos (point)))) + (or (get-text-property pos 'org-category) + (progn (org-refresh-category-properties) + (get-text-property pos 'org-category))))) (defun org-refresh-category-properties () "Refresh category text properties in the buffer." @@ -8176,7 +8345,7 @@ call CMD." (defun org-link-expand-abbrev (link) "Apply replacements as defined in `org-link-abbrev-alist." - (if (string-match "^\\([a-zA-Z][-_a-zA-Z0-9]*\\)\\(::?\\(.*\\)\\)?$" link) + (if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link) (let* ((key (match-string 1 link)) (as (or (assoc key org-link-abbrev-alist-local) (assoc key org-link-abbrev-alist))) @@ -8241,7 +8410,8 @@ EXPORT should format the link path for export to one of the export formats. It should be a function accepting three arguments: path the path of the link, the text after the prefix (like \"http:\") - desc the description of the link, if any, nil if there was no description + desc the description of the link, if any, or a description added by + org-export-normalize-links if there is none format the export format, a symbol like `html' or `latex' or `ascii'.. The function may use the FORMAT information to return different values @@ -8272,183 +8442,182 @@ For file links, arg negates `org-context-in-file-links'." (interactive "P") (org-load-modules-maybe) (setq org-store-link-plist nil) ; reset - (let ((outline-regexp (org-get-limited-outline-regexp)) - link cpltxt desc description search txt custom-id agenda-link) - (cond - - ((run-hook-with-args-until-success 'org-store-link-functions) - (setq link (plist-get org-store-link-plist :link) - desc (or (plist-get org-store-link-plist :description) link))) - - ((equal (buffer-name) "*Org Edit Src Example*") - (let (label gc) - (while (or (not label) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (regexp-quote (format org-coderef-label-format label)) - nil t)))) - (when label (message "Label exists already") (sit-for 2)) - (setq label (read-string "Code line label: " label))) - (end-of-line 1) - (setq link (format org-coderef-label-format label)) - (setq gc (- 79 (length link))) - (if (< (current-column) gc) (org-move-to-column gc t) (insert " ")) - (insert link) - (setq link (concat "(" label ")") desc nil))) - - ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) - ;; We are in the agenda, link to referenced location - (let ((m (or (get-text-property (point) 'org-hd-marker) - (get-text-property (point) 'org-marker)))) - (when m - (org-with-point-at m - (setq agenda-link - (if (interactive-p) - (call-interactively 'org-store-link) - (org-store-link nil))))))) - - ((eq major-mode 'calendar-mode) - (let ((cd (calendar-cursor-to-date))) - (setq link - (format-time-string - (car org-time-stamp-formats) - (apply 'encode-time - (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) - nil nil nil)))) - (org-store-link-props :type "calendar" :date cd))) - - ((eq major-mode 'w3-mode) - (setq cpltxt (if (and (buffer-name) - (not (string-match "Untitled" (buffer-name)))) - (buffer-name) - (url-view-url t)) - link (org-make-link (url-view-url t))) - (org-store-link-props :type "w3" :url (url-view-url t))) - - ((eq major-mode 'w3m-mode) - (setq cpltxt (or w3m-current-title w3m-current-url) - link (org-make-link w3m-current-url)) - (org-store-link-props :type "w3m" :url (url-view-url t))) - - ((setq search (run-hook-with-args-until-success - 'org-create-file-search-functions)) - (setq link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (setq cpltxt (or description link))) - - ((eq major-mode 'image-mode) - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name)) - link (org-make-link cpltxt)) - (org-store-link-props :type "image" :file buffer-file-name)) - - ((eq major-mode 'dired-mode) - ;; link to the file in the current line - (let ((file (dired-get-filename nil t))) - (setq file (if file - (abbreviate-file-name - (expand-file-name (dired-get-filename nil t))) - ;; otherwise, no file so use current directory. - default-directory)) - (setq cpltxt (concat "file:" file) - link (org-make-link cpltxt)))) - - ((and (buffer-file-name (buffer-base-buffer)) (org-mode-p)) - (setq custom-id (ignore-errors (org-entry-get nil "CUSTOM_ID"))) - (cond - ((org-in-regexp "<<\\(.*?\\)>>") - (setq cpltxt - (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))) - "::" (match-string 1)) - link (org-make-link cpltxt))) - ((and (featurep 'org-id) - (or (eq org-link-to-org-use-id t) - (and (eq org-link-to-org-use-id 'create-if-interactive) - (interactive-p)) - (and (eq org-link-to-org-use-id 'create-if-interactive-and-no-custom-id) - (interactive-p) - (not custom-id)) - (and org-link-to-org-use-id - (condition-case nil - (org-entry-get nil "ID") - (error nil))))) - ;; We can make a link using the ID. - (setq link (condition-case nil - (prog1 (org-id-store-link) - (setq desc (plist-get org-store-link-plist - :description))) - (error - ;; probably before first headline, link to file only - (concat "file:" + (org-with-limited-levels + (let (link cpltxt desc description search txt custom-id agenda-link) + (cond + + ((run-hook-with-args-until-success 'org-store-link-functions) + (setq link (plist-get org-store-link-plist :link) + desc (or (plist-get org-store-link-plist :description) link))) + + ((equal (buffer-name) "*Org Edit Src Example*") + (let (label gc) + (while (or (not label) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (re-search-forward + (regexp-quote (format org-coderef-label-format label)) + nil t)))) + (when label (message "Label exists already") (sit-for 2)) + (setq label (read-string "Code line label: " label))) + (end-of-line 1) + (setq link (format org-coderef-label-format label)) + (setq gc (- 79 (length link))) + (if (< (current-column) gc) (org-move-to-column gc t) (insert " ")) + (insert link) + (setq link (concat "(" label ")") desc nil))) + + ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) + ;; We are in the agenda, link to referenced location + (let ((m (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker)))) + (when m + (org-with-point-at m + (setq agenda-link + (if (org-called-interactively-p 'any) + (call-interactively 'org-store-link) + (org-store-link nil))))))) + + ((eq major-mode 'calendar-mode) + (let ((cd (calendar-cursor-to-date))) + (setq link + (format-time-string + (car org-time-stamp-formats) + (apply 'encode-time + (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) + nil nil nil)))) + (org-store-link-props :type "calendar" :date cd))) + + ((eq major-mode 'w3-mode) + (setq cpltxt (if (and (buffer-name) + (not (string-match "Untitled" (buffer-name)))) + (buffer-name) + (url-view-url t)) + link (org-make-link (url-view-url t))) + (org-store-link-props :type "w3" :url (url-view-url t))) + + ((eq major-mode 'w3m-mode) + (setq cpltxt (or w3m-current-title w3m-current-url) + link (org-make-link w3m-current-url)) + (org-store-link-props :type "w3m" :url (url-view-url t))) + + ((setq search (run-hook-with-args-until-success + 'org-create-file-search-functions)) + (setq link (concat "file:" (abbreviate-file-name buffer-file-name) + "::" search)) + (setq cpltxt (or description link))) + + ((eq major-mode 'image-mode) + (setq cpltxt (concat "file:" + (abbreviate-file-name buffer-file-name)) + link (org-make-link cpltxt)) + (org-store-link-props :type "image" :file buffer-file-name)) + + ((eq major-mode 'dired-mode) + ;; link to the file in the current line + (let ((file (dired-get-filename nil t))) + (setq file (if file + (abbreviate-file-name + (expand-file-name (dired-get-filename nil t))) + ;; otherwise, no file so use current directory. + default-directory)) + (setq cpltxt (concat "file:" file) + link (org-make-link cpltxt)))) + + ((and (buffer-file-name (buffer-base-buffer)) (org-mode-p)) + (setq custom-id (org-entry-get nil "CUSTOM_ID")) + (cond + ((org-in-regexp "<<\\(.*?\\)>>") + (setq cpltxt + (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))) + "::" (match-string 1)) + link (org-make-link cpltxt))) + ((and (featurep 'org-id) + (or (eq org-link-to-org-use-id t) + (and (eq org-link-to-org-use-id 'create-if-interactive) + (org-called-interactively-p 'any)) + (and (eq org-link-to-org-use-id + 'create-if-interactive-and-no-custom-id) + (org-called-interactively-p 'any) + (not custom-id)) + (and org-link-to-org-use-id + (org-entry-get nil "ID")))) + ;; We can make a link using the ID. + (setq link (condition-case nil + (prog1 (org-id-store-link) + (setq desc (plist-get org-store-link-plist + :description))) + (error + ;; probably before first headline, link to file only + (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer)))))))) + (t + ;; Just link to current headline + (setq cpltxt (concat "file:" (abbreviate-file-name - (buffer-file-name (buffer-base-buffer)))))))) - (t - ;; Just link to current headline - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context search string - (when (org-xor org-context-in-file-links arg) - (setq txt (cond - ((org-on-heading-p) nil) - ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))) - (t nil))) - (when (or (null txt) (string-match "\\S-" txt)) - (setq cpltxt - (concat cpltxt "::" - (condition-case nil - (org-make-org-heading-search-string txt) - (error ""))) - desc (or (nth 4 (ignore-errors - (org-heading-components))) "NONE")))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link (org-make-link cpltxt))))) - - ((buffer-file-name (buffer-base-buffer)) - ;; Just link to this file here. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context string - (when (org-xor org-context-in-file-links arg) - (setq txt (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)) - (buffer-substring (point-at-bol) (point-at-eol)))) - ;; Only use search option if there is some text. - (when (string-match "\\S-" txt) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE"))) - (setq link (org-make-link cpltxt))) - - ((interactive-p) - (error "Cannot link to a buffer which is not visiting a file")) - - (t (setq link nil))) - - (if (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt) - desc (or desc cpltxt)) - (if (equal desc "NONE") (setq desc nil)) - - (if (and (or (interactive-p) executing-kbd-macro) link) - (progn - (setq org-stored-links - (cons (list link desc) org-stored-links)) - (message "Stored: %s" (or desc link)) - (when custom-id - (setq link (concat "file:" (abbreviate-file-name (buffer-file-name)) - "::#" custom-id)) - (setq org-stored-links - (cons (list link desc) org-stored-links)))) - (or agenda-link (and link (org-make-link-string link desc)))))) + (buffer-file-name (buffer-base-buffer))))) + ;; Add a context search string + (when (org-xor org-context-in-file-links arg) + (setq txt (cond + ((org-on-heading-p) nil) + ((org-region-active-p) + (buffer-substring (region-beginning) (region-end))) + (t nil))) + (when (or (null txt) (string-match "\\S-" txt)) + (setq cpltxt + (concat cpltxt "::" + (condition-case nil + (org-make-org-heading-search-string txt) + (error ""))) + desc (or (nth 4 (ignore-errors + (org-heading-components))) "NONE")))) + (if (string-match "::\\'" cpltxt) + (setq cpltxt (substring cpltxt 0 -2))) + (setq link (org-make-link cpltxt))))) + + ((buffer-file-name (buffer-base-buffer)) + ;; Just link to this file here. + (setq cpltxt (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) + ;; Add a context string + (when (org-xor org-context-in-file-links arg) + (setq txt (if (org-region-active-p) + (buffer-substring (region-beginning) (region-end)) + (buffer-substring (point-at-bol) (point-at-eol)))) + ;; Only use search option if there is some text. + (when (string-match "\\S-" txt) + (setq cpltxt + (concat cpltxt "::" (org-make-org-heading-search-string txt)) + desc "NONE"))) + (setq link (org-make-link cpltxt))) + + ((org-called-interactively-p 'interactive) + (error "Cannot link to a buffer which is not visiting a file")) + + (t (setq link nil))) + + (if (consp link) (setq cpltxt (car link) link (cdr link))) + (setq link (or link cpltxt) + desc (or desc cpltxt)) + (if (equal desc "NONE") (setq desc nil)) + + (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link) + (progn + (setq org-stored-links + (cons (list link desc) org-stored-links)) + (message "Stored: %s" (or desc link)) + (when custom-id + (setq link (concat "file:" (abbreviate-file-name (buffer-file-name)) + "::#" custom-id)) + (setq org-stored-links + (cons (list link desc) org-stored-links)))) + (or agenda-link (and link (org-make-link-string link desc))))))) (defun org-store-link-props (&rest plist) "Store link properties, extract names and addresses." @@ -8495,6 +8664,7 @@ according to FMT (default from `org-email-link-description-format')." (cons "%T" (plist-get p :to)) (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?")) (cons "%s" (plist-get p :subject)) + (cons "%d" (plist-get p :date)) (cons "%m" (plist-get p :message-id))))) (when (string-match "%c" fmt) ;; Check if the user wrote this message @@ -8549,82 +8719,112 @@ according to FMT (default from `org-email-link-description-format')." (setq description (replace-match "{" t t description))) (while (string-match "\\]" description) (setq description (replace-match "}" t t description)))) - (when (equal (org-link-escape link) description) + (when (equal link description) ;; No description needed, it is identical (setq description nil)) (when (and (not description) + (not (string-match (org-image-file-name-regexp) link)) (not (equal link (org-link-escape link)))) (setq description (org-extract-attributes link))) - (setq link (if (string-match org-link-types-re link) - (concat (match-string 1 link) - (org-link-escape (substring link (match-end 1)))) - (org-link-escape link))) + (setq link + (cond ((string-match (org-image-file-name-regexp) link) link) + ((string-match org-link-types-re link) + (concat (match-string 1 link) + (org-link-escape (substring link (match-end 1))))) + (t (org-link-escape link)))) (concat "[[" link "]" (if description (concat "[" description "]") "") "]")) (defconst org-link-escape-chars - '((?\ . "%20") - (?\[ . "%5B") - (?\] . "%5D") - (?\340 . "%E0") ; `a - (?\342 . "%E2") ; ^a - (?\347 . "%E7") ; ,c - (?\350 . "%E8") ; `e - (?\351 . "%E9") ; 'e - (?\352 . "%EA") ; ^e - (?\356 . "%EE") ; ^i - (?\364 . "%F4") ; ^o - (?\371 . "%F9") ; `u - (?\373 . "%FB") ; ^u - (?\; . "%3B") -;; (?? . "%3F") - (?= . "%3D") - (?+ . "%2B") - ) - "Association list of escapes for some characters problematic in links. + '(?\ ?\[ ?\] ?\; ?\= ?\+) + "List of characters that should be escaped in link. This is the list that is used for internal purposes.") (defvar org-url-encoding-use-url-hexify nil) (defconst org-link-escape-chars-browser - '((?\ . "%20")) ; 32 for the SPC char - "Association list of escapes for some characters problematic in links. + '(?\ ) + "List of escapes for characters that are problematic in links. This is the list that is used before handing over to the browser.") -(defun org-link-escape (text &optional table) - "Escape characters in TEXT that are problematic for links." +(defun org-link-escape (text &optional table merge) + "Return percent escaped representation of TEXT. +TEXT is a string with the text to escape. +Optional argument TABLE is a list with characters that should be +escaped. When nil, `org-link-escape-chars' is used. +If optional argument MERGE is set, merge TABLE into +`org-link-escape-chars'." (if (and org-url-encoding-use-url-hexify (not table)) (url-hexify-string text) - (setq table (or table org-link-escape-chars)) - (when text - (let ((re (mapconcat (lambda (x) (regexp-quote - (char-to-string (car x)))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (cdr (assoc (string-to-char (match-string 0 text)) - table)) - t t text))) - text)))) - -(defun org-link-unescape (text &optional table) - "Reverse the action of `org-link-escape'." - (if (and org-url-encoding-use-url-hexify (not table)) - (url-unhex-string text) - (setq table (or table org-link-escape-chars)) - (when text - (let ((case-fold-search t) - (re (mapconcat (lambda (x) (regexp-quote (downcase (cdr x)))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (char-to-string (car (rassoc (upcase (match-string 0 text)) - table))) - t t text))) - text)))) + (cond + ((and table merge) + (mapc (lambda (defchr) + (unless (member defchr table) + (setq table (cons defchr table)))) org-link-escape-chars)) + ((null table) + (setq table org-link-escape-chars))) + (mapconcat + (lambda (char) + (if (or (member char table) + (< char 32) (= char 37) (> char 126)) + (mapconcat (lambda (sequence-element) + (format "%%%.2X" sequence-element)) + (or (encode-coding-char char 'utf-8) + (error "Unable to percent escape character: %s" + (char-to-string char))) "") + (char-to-string char))) text ""))) + +(defun org-link-unescape (str) + "Unhex hexified unicode strings as returned from the JavaScript function +encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'." + (unless (and (null str) (string= "" str)) + (let ((pos 0) (case-fold-search t) unhexed) + (while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos)) + (setq unhexed (org-link-unescape-compound (match-string 0 str))) + (setq str (replace-match unhexed t t str)) + (setq pos (+ pos (length unhexed)))))) + str) + +(defun org-link-unescape-compound (hex) + "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ö'. +Note: this function also decodes single byte encodings like +`%E1' (\"á\") if not followed by another `%[A-F0-9]{2}' group." + (save-match-data + (let* ((bytes (cdr (split-string hex "%"))) + (ret "") + (eat 0) + (sum 0)) + (while bytes + (let* ((val (string-to-number (pop bytes) 16)) + (shift-xor + (if (= 0 eat) + (cond + ((>= val 252) (cons 6 252)) + ((>= val 248) (cons 5 248)) + ((>= val 240) (cons 4 240)) + ((>= val 224) (cons 3 224)) + ((>= val 192) (cons 2 192)) + (t (cons 0 0))) + (cons 6 128)))) + (if (>= val 192) (setq eat (car shift-xor))) + (setq val (logxor val (cdr shift-xor))) + (setq sum (+ (lsh sum (car shift-xor)) val)) + (if (> eat 0) (setq eat (- eat 1))) + (cond + ((= 0 eat) ;multi byte + (setq ret (concat ret (org-char-to-string sum))) + (setq sum 0)) + ((not bytes) ; single byte(s) + (setq ret (org-link-unescape-single-byte-sequence hex)))) + )) ;; end (while bytes + ret ))) + +(defun org-link-unescape-single-byte-sequence (hex) + "Unhexify hex-encoded single byte character sequences." + (mapconcat (lambda (byte) + (char-to-string (string-to-number byte 16))) + (cdr (split-string hex "%")) "")) (defun org-xor (a b) "Exclusive or." @@ -8672,8 +8872,8 @@ be displayed in the buffer instead of the link. If there is already a link at point, this command will allow you to edit link and description parts. -With a \\[universal-argument] prefix, prompts for a file to link to. The file name can -be selected using completion. The path to the file will be relative to the +With a \\[universal-argument] prefix, prompts for a file to link to. The file name can +be selected using completion. The path to the file will be relative to the current directory if the file is in the current directory or a subdirectory. Otherwise, the link will be the absolute path as completed in the minibuffer \(i.e. normally ~/path/to/file). You can configure this behavior using the @@ -8731,7 +8931,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (reverse org-stored-links) "\n")))) (let ((cw (selected-window))) (select-window (get-buffer-window "*Org Links*" 'visible)) - (setq truncate-lines t) + (with-current-buffer "*Org Links*" (setq truncate-lines) t) (unless (pos-visible-in-window-p (point-max)) (org-fit-window-to-buffer)) (and (window-live-p cw) (select-window cw))) @@ -8885,7 +9085,7 @@ from." (let ((ido-enter-matching-directory nil)) (apply 'ido-completing-read (concat (car args)) (if (consp (car (nth 1 args))) - (mapcar (lambda (x) (car x)) (nth 1 args)) + (mapcar 'car (nth 1 args)) (nth 1 args)) (cddr args))) (if (and org-completion-use-iswitchb @@ -8893,7 +9093,7 @@ from." (listp (second args))) (apply 'org-iswitchb-completing-read (concat (car args)) (if (consp (car (nth 1 args))) - (mapcar (lambda (x) (car x)) (nth 1 args)) + (mapcar 'car (nth 1 args)) (nth 1 args)) (cddr args)) (apply 'completing-read args))))) @@ -8964,7 +9164,7 @@ If the link is in hidden text, expose it." (if (re-search-forward org-any-link-re nil t) (progn (goto-char (match-beginning 0)) - (if (org-invisible-p) (org-show-context))) + (if (outline-invisible-p) (org-show-context))) (goto-char pos) (setq org-link-search-failed t) (error "No further link found")))) @@ -8984,7 +9184,7 @@ If the link is in hidden text, expose it." (if (re-search-backward org-any-link-re nil t) (progn (goto-char (match-beginning 0)) - (if (org-invisible-p) (org-show-context))) + (if (outline-invisible-p) (org-show-context))) (goto-char pos) (setq org-link-search-failed t) (error "No further link found")))) @@ -9074,12 +9274,12 @@ Functions in this hook must return t if they identify and follow a link at point. If they don't find anything interesting at point, they must return nil.") -(defun org-open-at-point (&optional in-emacs reference-buffer) +(defun org-open-at-point (&optional arg reference-buffer) "Open link at or after point. If there is no link at point, this function will search forward up to the end of the current line. Normally, files will be opened by an appropriate application. If the -optional argument IN-EMACS is non-nil, Emacs will visit the file. +optional prefix argument ARG is non-nil, Emacs will visit the file. With a double prefix argument, try to open outside of Emacs, in the application the system uses for this file type." (interactive "P") @@ -9097,7 +9297,7 @@ application the system uses for this file type." org-angle-link-re "\\|" "[ \t]:[^ \t\n]+:[ \t]*$"))) (not (get-text-property (point) 'org-linked-text))) - (or (org-offer-links-in-entry in-emacs) + (or (org-offer-links-in-entry arg) (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)) @@ -9129,8 +9329,10 @@ application the system uses for this file type." pos (if (get-text-property (1+ (point)) 'org-linked-text) (1+ (point)) (point)) path (buffer-substring - (previous-single-property-change pos 'org-linked-text) - (next-single-property-change pos 'org-linked-text))) + (or (previous-single-property-change pos 'org-linked-text) + (point-min)) + (or (next-single-property-change pos 'org-linked-text) + (point-max)))) (throw 'match t)) (save-excursion @@ -9202,7 +9404,7 @@ application the system uses for this file type." (browse-url (concat type ":" path))) ((string= type "tags") - (org-tags-view in-emacs path)) + (org-tags-view arg path)) ((string= type "tree-match") (org-occur (concat "\\[" (regexp-quote path) "\\]"))) @@ -9216,11 +9418,13 @@ application the system uses for this file type." path (substring path 0 (match-beginning 0))))) (if (string-match "[*?{]" (file-name-nondirectory path)) (dired path) - (org-open-file path in-emacs line search))) + (org-open-file path arg line search))) ((string= type "shell") (let ((cmd path)) - (if (or (not org-confirm-shell-link-function) + (if (or (and (not (string= org-confirm-shell-link-not-regexp "")) + (string-match org-confirm-shell-link-not-regexp cmd)) + (not org-confirm-shell-link-function) (funcall org-confirm-shell-link-function (format "Execute \"%s\" in shell? " (org-add-props cmd nil @@ -9232,7 +9436,9 @@ application the system uses for this file type." ((string= type "elisp") (let ((cmd path)) - (if (or (not org-confirm-elisp-link-function) + (if (or (and (not (string= org-confirm-elisp-link-not-regexp "")) + (string-match org-confirm-elisp-link-not-regexp cmd)) + (not org-confirm-elisp-link-function) (funcall org-confirm-elisp-link-function (format "Execute \"%s\" as elisp? " (org-add-props cmd nil @@ -9248,14 +9454,14 @@ application the system uses for this file type." 'org-open-link-functions path))) ((string= type "thisfile") - (if in-emacs + (if arg (switch-to-buffer-other-window (org-get-buffer-for-internal-link (current-buffer))) (org-mark-ring-push)) (let ((cmd `(org-link-search ,path - ,(cond ((equal in-emacs '(4)) 'occur) - ((equal in-emacs '(16)) 'org-occur) + ,(cond ((equal arg '(4)) ''occur) + ((equal arg '(16)) ''org-occur) (t nil)) ,pos))) (condition-case nil (eval cmd) @@ -9628,9 +9834,9 @@ onto the ring." (setq p org-mark-ring)) (setq org-mark-ring-last-goto p) (setq m (car p)) - (switch-to-buffer (marker-buffer m)) + (org-pop-to-buffer-same-window (marker-buffer m)) (goto-char m) - (if (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) + (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) (defun org-remove-angle-brackets (s) (if (equal (substring s 0 1) "<") (setq s (substring s 1))) @@ -9664,6 +9870,10 @@ onto the ring." ;;; Following file links +(declare-function mailcap-parse-mailcaps "mailcap" (&optional path force)) +(declare-function mailcap-extension-to-mime "mailcap" (extn)) +(declare-function mailcap-mime-info + "mailcap" (string &optional request no-decode)) (defvar org-wait nil) (defun org-open-file (path &optional in-emacs line search) "Open the file at PATH. @@ -9894,7 +10104,6 @@ on the system \"/user@host:\"." (defvar org-refile-cache nil "Cache for refile targets.") - (defvar org-refile-markers nil "All the markers used for caching refile locations.") @@ -9943,7 +10152,7 @@ on the system \"/user@host:\"." org-refile-cache)))) (and set (org-refile-cache-check-set set) set))))) -(defun org-get-refile-targets (&optional default-buffer) +(defun org-refile-get-targets (&optional default-buffer excluded-entries) "Produce a table with refile targets." (let ((case-fold-search nil) ;; otherwise org confuses "TODO" as a kw and "Todo" as a word @@ -10006,7 +10215,8 @@ on the system \"/user@host:\"." (save-match-data (or (funcall org-refile-target-verify-function) (throw 'next t)))) - (when (looking-at org-complex-heading-regexp) + (when (and (looking-at org-complex-heading-regexp) + (not (member (match-string 4) excluded-entries))) (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) txt (org-link-display-format (match-string 4)) @@ -10138,25 +10348,24 @@ the *old* location.") (defvar org-capture-last-stored-marker) (defun org-refile (&optional goto default-buffer rfloc) - "Move the entry at point to another heading. + "Move the entry or entries at point to another heading. The list of target headings is compiled using the information in -`org-refile-targets', which see. This list is created before each use -and will therefore always be up-to-date. +`org-refile-targets', which see. -At the target location, the entry is filed as a subitem of the target heading. -Depending on `org-reverse-note-order', the new subitem will either be the -first or the last subitem. +At the target location, the entry is filed as a subitem of the target +heading. Depending on `org-reverse-note-order', the new subitem will +either be the first or the last subitem. If there is an active region, all entries in that region will be moved. However, the region must fulfill the requirement that the first heading is the first one sets the top-level of the moved text - at most siblings below it are allowed. -With prefix arg GOTO, the command will only visit the target location, -not actually move anything. +With prefix arg GOTO, the command will only visit the target location +and not actually move anything. + With a double prefix arg \\[universal-argument] \\[universal-argument], \ -go to the location where the last refiling -operation has put the subtree. +go to the location where the last refiling operation has put the subtree. With a prefix argument of `2', refile to the running clock. RFLOC can be a refile location obtained in a different way. @@ -10165,7 +10374,9 @@ See also `org-refile-use-outline-path' and `org-completion-use-ido'. If you are using target caching (see `org-refile-use-cache'), You have to clear the target cache in order to find new targets. -This can be done with a 0 prefix: `C-0 C-c C-w'" +This can be done with a 0 prefix (`C-0 C-c C-w') or a triple +prefix argument (`C-u C-u C-u C-c C-w')." + (interactive "P") (if (member goto '(0 (64))) (org-refile-cache-clear) @@ -10199,7 +10410,7 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" (setq it (or rfloc (save-excursion (org-refile-get-location - (if goto "Goto: " "Refile to: ") default-buffer + (if goto "Goto" "Refile to") default-buffer org-refile-allow-creating-parent-nodes))))) (setq file (nth 1 it) re (nth 2 it) @@ -10219,7 +10430,7 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" (find-file-noselect file))) (if goto (progn - (switch-to-buffer nbuf) + (org-pop-to-buffer-same-window nbuf) (goto-char pos) (org-show-context 'org-goto)) (if regionp @@ -10236,7 +10447,7 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" (if pos (progn (goto-char pos) - (looking-at outline-regexp) + (looking-at org-outline-regexp) (setq level (org-get-valid-level (funcall outline-level) 1)) (goto-char (if reversed @@ -10280,15 +10491,29 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" (message "This is the location of the last refile")) (defun org-refile-get-location (&optional prompt default-buffer new-nodes) - "Prompt the user for a refile location, using PROMPT." + "Prompt the user for a refile location, using PROMPT. +PROMPT should not be suffixed with a colon and a space, because +this function appends the default value from +`org-refile-history' automatically, if that is not empty." (let ((org-refile-targets org-refile-targets) - (org-refile-use-outline-path org-refile-use-outline-path)) - (setq org-refile-target-table (org-get-refile-targets default-buffer))) + (org-refile-use-outline-path org-refile-use-outline-path) + excluded-entries) + (when (and (eq major-mode 'org-mode) + (not org-refile-use-cache)) + (org-map-tree + (lambda() + (setq excluded-entries + (append excluded-entries (list (org-get-heading t t))))))) + (setq org-refile-target-table + (org-refile-get-targets default-buffer excluded-entries))) (unless org-refile-target-table (error "No refile targets")) - (let* ((cbuf (current-buffer)) - (when (boundp 'partial-completion-mode) - (partial-completion-mode nil)) + (let* ((prompt (concat prompt + (and (car org-refile-history) + (concat " (default " (car org-refile-history) ")")) + ": ")) + (cbuf (current-buffer)) + (partial-completion-mode nil) (cfn (buffer-file-name (buffer-base-buffer cbuf))) (cfunc (if (and org-refile-use-outline-path org-outline-path-complete-in-steps) @@ -10310,7 +10535,7 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" pa answ parent-target child parent old-hist) (setq old-hist org-refile-history) (setq answ (funcall cfunc prompt tbl nil (not new-nodes) - nil 'org-refile-history)) + nil 'org-refile-history (car org-refile-history))) (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl))) (org-refile-check-position pa) (if pa @@ -10357,7 +10582,7 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" (goto-char pos) (beginning-of-line 1) (unless (org-looking-at-p re) - (error "Invalid refile position, please rebuild the cache")))))))) + (error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling")))))))) (defun org-refile-new-child (parent-target child) "Use refile target PARENT-TARGET to add new CHILD below it." @@ -10375,7 +10600,7 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" (goto-char pos) (goto-char (point-max)) (if (not (bolp)) (newline))) - (when (looking-at outline-regexp) + (when (looking-at org-outline-regexp) (setq level (funcall outline-level)) (org-end-of-subtree t t)) (org-back-over-empty-lines) @@ -10425,7 +10650,7 @@ If not found, stay at current position and return nil." (let (pos) (save-excursion (goto-char (point-min)) - (setq pos (and (re-search-forward (concat "^#\\+BEGIN:[ \t]+" name "\\>") + (setq pos (and (re-search-forward (concat "^[ \t]*#\\+BEGIN:[ \t]+" name "\\>") nil t) (match-beginning 0)))) (if pos (goto-char pos)) @@ -10572,7 +10797,7 @@ This function can be used in a hook." "BEGIN_SRC" "END_SRC" "BEGIN_RESULT" "END_RESULT" "SOURCE:" "SRCNAME:" "FUNCTION:" - "RESULTS:" + "RESULTS:" "DATA:" "HEADER:" "HEADERS:" "BABEL:" "CATEGORY:" "COLUMNS:" "PROPERTY:" @@ -10604,14 +10829,17 @@ This function can be used in a hook." "<literal style=\"html\">?</literal>") ("a" "#+begin_ascii\n?\n#+end_ascii") ("A" "#+ascii: ") - ("i" "#+include %file ?" + ("i" "#+index: ?" + "#+index: ?") + ("I" "#+include %file ?" "<include file=%file markup=\"?\">") ) "Structure completion elements. This is a list of abbreviation keys and values. The value gets inserted if you type `<' followed by the key and then press the completion key, usually `M-TAB'. %file will be replaced by a file name after prompting -for the file using completion. +for the file using completion. The cursor will be placed at the position +of the `?` in the template. There are two templates for each key, the first uses the original Org syntax, the second uses Emacs Muse-like syntax tags. These Muse-like tags become the default when the /org-mtags.el/ module has been loaded. See also the @@ -10630,7 +10858,7 @@ expands them." (let ((l (buffer-substring (point-at-bol) (point))) a) (when (and (looking-at "[ \t]*$") - (string-match "^[ \t]*<\\([a-z]+\\)$"l) + (string-match "^[ \t]*<\\([a-zA-Z]+\\)$" l) (setq a (assoc (match-string 1 l) org-structure-template-alist))) (org-complete-expand-structure-template (+ -1 (point-at-bol) (match-beginning 1)) a) @@ -10670,10 +10898,10 @@ expands them." (save-excursion (org-back-to-heading) (let (case-fold-search) - (if (looking-at (concat outline-regexp + (if (looking-at (concat org-outline-regexp "\\( *\\<" org-comment-string "\\>[ \t]*\\)")) (replace-match "" t t nil 1) - (if (looking-at outline-regexp) + (if (looking-at org-outline-regexp) (progn (goto-char (match-end 0)) (insert org-comment-string " "))))))) @@ -10697,6 +10925,32 @@ nil or a string to be used for the todo mark." ) (defvar org-agenda-headline-snapshot-before-repeat) +(defun org-current-effective-time () + "Return current time adjusted for `org-extend-today-until' variable" + (let* ((ct (org-current-time)) + (dct (decode-time ct)) + (ct1 + (if (< (nth 2 dct) org-extend-today-until) + (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) + ct))) + ct1)) + +(defun org-todo-yesterday (&optional arg) + "Like `org-todo' but the time of change will be 23:59 of yesterday" + (interactive "P") + (let* ((hour (third (decode-time + (org-current-time)))) + (org-extend-today-until (1+ hour))) + (org-todo arg))) + +(defun org-agenda-todo-yesterday (&optional arg) + "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday" + (interactive "P") + (let* ((hour (third (decode-time + (org-current-time)))) + (org-extend-today-until (1+ hour))) + (org-agenda-todo arg))) + (defun org-todo (&optional arg) "Change the TODO state of an item. The state of an item is given by a keyword at the start of the heading, @@ -10738,7 +10992,7 @@ For calling through lisp, arg is also interpreted in the following way: (save-excursion (catch 'exit (org-back-to-heading t) - (if (looking-at outline-regexp) (goto-char (1- (match-end 0)))) + (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) (or (looking-at (concat " +" org-todo-regexp "\\( +\\|$\\)")) (looking-at " *")) (let* ((match-data (match-data)) @@ -10831,9 +11085,10 @@ For calling through lisp, arg is also interpreted in the following way: (not (member this org-done-keywords))) (unless (save-excursion (save-match-data - (run-hook-with-args-until-failure - 'org-blocker-hook change-plist))) - (if (interactive-p) + (org-with-wide-buffer + (run-hook-with-args-until-failure + 'org-blocker-hook change-plist)))) + (if (org-called-interactively-p 'interactive) (error "TODO state change from %s to %s blocked" this state) ;; fail silently (message "TODO state change from %s to %s blocked" this state) @@ -10875,7 +11130,7 @@ For calling through lisp, arg is also interpreted in the following way: (org-add-planning-info nil nil 'closed)) (when (and now-done-p org-log-done) ;; It is now done, and it was not done before - (org-add-planning-info 'closed (org-current-time)) + (org-add-planning-info 'closed (org-current-effective-time)) (if (and (not dolog) (eq 'note org-log-done)) (org-add-log-setup 'done state this 'findpos 'note))) (when (and state dolog) @@ -11102,26 +11357,31 @@ This should be called with the cursor in a line with a statistics cookie." When `org-hierarchical-todo-statistics' is nil, statistics will cover the entire subtree and this will travel up the hierarchy and update statistics everywhere." - (interactive) - (let* ((lim 0) prop + (let* ((prop (save-excursion (org-up-heading-safe) + (org-entry-get nil "COOKIE_DATA" 'inherit))) (recursive (or (not org-hierarchical-todo-statistics) - (string-match - "\\<recursive\\>" - (or (setq prop (org-entry-get - nil "COOKIE_DATA" 'inherit)) "")))) - (lim (or (and prop (marker-position - org-entry-property-inherited-from)) - lim)) + (and prop (string-match "\\<recursive\\>" prop)))) + (lim (or (and prop (marker-position org-entry-property-inherited-from)) + 0)) (first t) (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") level ltoggle l1 new ndel - (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present) + (cnt-all 0) (cnt-done 0) is-percent kwd + checkbox-beg ov ovs ove cookie-present) (catch 'exit (save-excursion (beginning-of-line 1) - (if (org-at-heading-p) - (setq ltoggle (funcall outline-level)) - (error "This should not happen")) + (setq ltoggle (funcall outline-level)) + ;; Three situations are to consider: + + ;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up + ;; to the top-level ancestor on the headline; + + ;; 2. If parent has "recursive" property, repeat up to the + ;; headline setting that property, taking inheritance into + ;; account; + + ;; 3. Else, move up to direct parent and proceed only once. (while (and (setq level (org-up-heading-safe)) (or recursive first) (>= (point) lim)) @@ -11129,38 +11389,42 @@ statistics everywhere." (unless (and level (not (string-match "\\<checkbox\\>" - (downcase - (or (org-entry-get - nil "COOKIE_DATA") - ""))))) + (downcase (or (org-entry-get nil "COOKIE_DATA") + ""))))) (throw 'exit nil)) (while (re-search-forward box-re (point-at-eol) t) (setq cnt-all 0 cnt-done 0 cookie-present t) - (setq is-percent (match-end 2)) + (setq is-percent (match-end 2) checkbox-beg (match-beginning 0)) (save-match-data (unless (outline-next-heading) (throw 'exit nil)) (while (and (looking-at org-complex-heading-regexp) - (> (setq l1 (length (match-string 1))) level)) - (setq kwd (and (or recursive (= l1 ltoggle)) - (match-string 2))) - (if (or (eq org-provide-todo-statistics 'all-headlines) - (and (listp org-provide-todo-statistics) - (or (member kwd org-provide-todo-statistics) - (member kwd org-done-keywords)))) - (setq cnt-all (1+ cnt-all)) - (if (eq org-provide-todo-statistics t) - (and kwd (setq cnt-all (1+ cnt-all))))) - (and (member kwd org-done-keywords) - (setq cnt-done (1+ cnt-done))) - (outline-next-heading))) + (> (setq l1 (length (match-string 1))) level)) + (setq kwd (and (or recursive (= l1 ltoggle)) + (match-string 2))) + (if (or (eq org-provide-todo-statistics 'all-headlines) + (and (listp org-provide-todo-statistics) + (or (member kwd org-provide-todo-statistics) + (member kwd org-done-keywords)))) + (setq cnt-all (1+ cnt-all)) + (if (eq org-provide-todo-statistics t) + (and kwd (setq cnt-all (1+ cnt-all))))) + (and (member kwd org-done-keywords) + (setq cnt-done (1+ cnt-done))) + (outline-next-heading))) (setq new - (if is-percent - (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) - (format "[%d/%d]" cnt-done cnt-all)) - ndel (- (match-end 0) (match-beginning 0))) - (goto-char (match-beginning 0)) + (if is-percent + (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) + (format "[%d/%d]" cnt-done cnt-all)) + ndel (- (match-end 0) checkbox-beg)) + ;; handle overlays when updating cookie from column view + (when (setq ov (car (overlays-at checkbox-beg))) + (setq ovs (overlay-start ov) ove (overlay-end ov)) + (delete-overlay ov)) + (goto-char checkbox-beg) (insert new) - (delete-region (point) (+ (point) ndel))) + (delete-region (point) (+ (point) ndel)) + (when org-auto-align-tags (org-fix-tags-on-the-fly)) + (when ov (move-overlay ov ovs ove))) (when cookie-present (run-hook-with-args 'org-after-todo-statistics-hook cnt-done (- cnt-all cnt-done)))))) @@ -11407,7 +11671,7 @@ This function is run automatically after each state change to a DONE state." ((equal (match-string 1 ts) ".") ;; Shift starting date to today (org-timestamp-change - (- (time-to-days (current-time)) (time-to-days time)) + (- (org-today) (time-to-days time)) 'day)) ((equal (match-string 1 ts) "+") (let ((nshiftmax 10) (nshift 0)) @@ -11453,17 +11717,19 @@ of `org-todo-keywords-1'." org-todo-keywords-1))) (t (error "Invalid prefix argument: %s" arg))))) (message "%d TODO entries found" - (org-occur (concat "^" outline-regexp " *" kwd-re ))))) + (org-occur (concat "^" org-outline-regexp " *" kwd-re ))))) (defun org-deadline (&optional remove time) "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. With argument REMOVE, remove any deadline from the item. -When TIME is set, it should be an internal time specification, and the -scheduling will use the corresponding date." +With argument TIME, set the deadline at the corresponding date. TIME +can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") (let* ((old-date (org-entry-get nil "DEADLINE")) (repeater (and old-date - (string-match "\\([.+]+[0-9]+[dwmy]\\) ?" old-date) + (string-match + "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?" + old-date) (match-string 1 old-date)))) (if remove (progn @@ -11496,12 +11762,14 @@ scheduling will use the corresponding date." (defun org-schedule (&optional remove time) "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. With argument REMOVE, remove any scheduling date from the item. -When TIME is set, it should be an internal time specification, and the -scheduling will use the corresponding date." +With argument TIME, scheduled at the corresponding date. TIME can +either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") (let* ((old-date (org-entry-get nil "SCHEDULED")) (repeater (and old-date - (string-match "\\([.+]+[0-9]+[dwmy]\\) ?" old-date) + (string-match + "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?" + old-date) (match-string 1 old-date)))) (if remove (progn @@ -11567,7 +11835,7 @@ nil." (defun org-add-planning-info (what &optional time &rest remove) "Insert new timestamp with keyword in the line directly after the headline. -WHAT indicates what kind of time stamp to add. TIME indicated the time to use. +WHAT indicates what kind of time stamp to add. TIME indicates the time to use. If non is given, the user is prompted for a date. REMOVE indicates what kind of entries to remove. An old WHAT entry will also be removed." @@ -11576,7 +11844,10 @@ be removed." end default-time default-input) (catch 'exit - (when (and (not time) (memq what '(scheduled deadline))) + (when (and (memq what '(scheduled deadline)) + (or (not time) + (and (stringp time) + (string-match "^[-+]+[0-9]" time)))) ;; Try to get a default date/time from existing timestamp (save-excursion (org-back-to-heading t) @@ -11590,9 +11861,16 @@ be removed." (apply 'encode-time (org-parse-time-string ts)) default-input (and ts (org-get-compact-tod ts)))))) (when what - ;; If necessary, get the time from the user - (setq time (or time (org-read-date nil 'to-time nil nil - default-time default-input)))) + (setq time + (if (and (stringp time) + (string-match "^[-+]+[0-9]" time)) + ;; This is a relative time, set the proper date + (apply 'encode-time + (org-read-date-analyze + time default-time (decode-time default-time))) + ;; If necessary, get the time from the user + (or time (org-read-date nil 'to-time nil nil + default-time default-input))))) (when (and org-insert-labeled-timestamps-at-point (member what '(scheduled deadline))) @@ -11605,7 +11883,7 @@ be removed." (save-restriction (let (col list elt ts buffer-invisibility-spec) (org-back-to-heading t) - (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) + (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*")) (goto-char (match-end 1)) (setq col (current-column)) (goto-char (match-end 0)) @@ -11616,7 +11894,7 @@ be removed." org-keyword-time-not-clock-regexp)))) ;; Nothing to add, nothing to remove...... :-) (throw 'exit nil)) - (if (and (not (looking-at outline-regexp)) + (if (and (not (looking-at org-outline-regexp)) (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp "[^\r\n]*")) (not (equal (match-string 1) org-clock-string))) @@ -11629,7 +11907,6 @@ be removed." (setq list (cons what remove)) (while list (setq elt (pop list)) - (goto-char (point-min)) (when (or (and (eq elt 'scheduled) (re-search-forward org-scheduled-time-regexp nil t)) (and (eq elt 'deadline) @@ -11637,10 +11914,8 @@ be removed." (and (eq elt 'closed) (re-search-forward org-closed-time-regexp nil t))) (replace-match "") - (if (looking-at "--+<[^>]+>") (replace-match "")) - (skip-chars-backward " ") - (if (looking-at " +") (replace-match "")))) - (goto-char (point-max)) + (if (looking-at "--+<[^>]+>") (replace-match "")))) + (and (looking-at "^[ \t]+") (replace-match "")) (and org-adapt-indentation (bolp) (org-indent-to-column col)) (when what (insert @@ -11655,6 +11930,10 @@ be removed." (and (eq what 'closed) org-log-done-with-time)) (eq what 'closed) nil nil (list org-end-time-was-given))) + (insert + (if (not (or (bolp) (eq (char-before) ?\ ) + (memq (char-after) '(32 10)) + (eobp))) " " "")) (end-of-line 1)) (goto-char (point-min)) (widen) @@ -11671,6 +11950,11 @@ be removed." (defvar org-log-note-extra nil) (defvar org-log-note-window-configuration nil) (defvar org-log-note-return-to (make-marker)) +(defvar org-log-note-effective-time nil + "Remembered current time so that dynamically scoped +`org-extend-today-until' affects tha timestamps in state change +log") + (defvar org-log-post-message nil "Message to be displayed after a log note has been stored. The auto-repeater uses this.") @@ -11701,7 +11985,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (org-back-to-heading t) (narrow-to-region (point) (save-excursion (outline-next-heading) (point))) - (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*" + (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*" "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp "[^\r\n]*\\)?")) (goto-char (match-end 0)) @@ -11738,17 +12022,19 @@ EXTRA is additional text that will be inserted into the notes buffer." org-log-note-state state org-log-note-previous-state prev-state org-log-note-how how - org-log-note-extra extra) + org-log-note-extra extra + org-log-note-effective-time (org-current-effective-time)) (add-hook 'post-command-hook 'org-add-log-note 'append))))) (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." (if (looking-at "\n[ \t]*- State") (forward-char 1)) - (when (org-in-item-p) - (let ((limit (org-list-bottom-point))) + (when (ignore-errors (goto-char (org-in-item-p))) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct))) (while (looking-at "[ \t]*- State") - (goto-char (or (org-get-next-item (point) limit) - (org-get-end-of-item limit))))))) + (goto-char (or (org-list-get-next-item (point) struct prevs) + (org-list-get-item-end (point) struct))))))) (defun org-add-log-note (&optional purpose) "Pop up a window for taking a note, and add this note later at point." @@ -11756,7 +12042,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (setq org-log-note-window-configuration (current-window-configuration)) (delete-other-windows) (move-marker org-log-note-return-to (point)) - (switch-to-buffer (marker-buffer org-log-note-marker)) + (org-pop-to-buffer-same-window (marker-buffer org-log-note-marker)) (goto-char org-log-note-marker) (org-switch-to-buffer-other-window "*Org Note*") (erase-buffer) @@ -11808,10 +12094,10 @@ EXTRA is additional text that will be inserted into the notes buffer." (cons "%U" user-full-name) (cons "%t" (format-time-string (org-time-stamp-format 'long 'inactive) - (current-time))) + org-log-note-effective-time)) (cons "%T" (format-time-string (org-time-stamp-format 'long nil) - (current-time))) + org-log-note-effective-time)) (cons "%s" (if org-log-note-state (concat "\"" org-log-note-state "\"") "")) @@ -11834,10 +12120,10 @@ EXTRA is additional text that will be inserted into the notes buffer." (end-of-line 1) (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) (setq ind (save-excursion - (if (org-in-item-p) - (progn - (goto-char (org-list-top-point)) - (org-get-indentation)) + (if (ignore-errors (goto-char (org-in-item-p))) + (let ((struct (org-list-struct))) + (org-list-get-ind + (org-list-get-top-point struct) struct)) (skip-chars-backward " \r\t\n") (cond ((and (org-at-heading-p) @@ -11968,10 +12254,36 @@ that the match should indeed be shown." (unless org-sparse-tree-open-archived-trees (org-hide-archived-subtrees (point-min) (point-max))) (run-hooks 'org-occur-hook) - (if (interactive-p) + (if (org-called-interactively-p 'interactive) (message "%d match(es) for regexp %s" cnt regexp)) cnt)) +(defun org-occur-next-match (&optional n reset) + "Function for `next-error-function' to find sparse tree matches. +N is the number of matches to move, when negative move backwards. +RESET is entirely ignored - this function always goes back to the +starting point when no match is found." + (let* ((limit (if (< n 0) (point-min) (point-max))) + (search-func (if (< n 0) + 'previous-single-char-property-change + 'next-single-char-property-change)) + (n (abs n)) + (pos (point)) + p1) + (catch 'exit + (while (setq p1 (funcall search-func (point) 'org-type)) + (when (equal p1 limit) + (goto-char pos) + (error "No more matches")) + (when (equal (get-char-property p1 'org-type) 'org-occur) + (setq n (1- n)) + (when (= n 0) + (goto-char p1) + (throw 'exit (point)))) + (goto-char p1)) + (goto-char p1) + (error "No more matches")))) + (defun org-show-context (&optional key) "Make sure point and context are visible. How much context is shown depends upon the variables @@ -11986,7 +12298,7 @@ How much context is shown depends upon the variables ;; Show heading or entry text (if (and heading-p (not entry-p)) (org-flag-heading nil) ; only show the heading - (and (or entry-p (org-invisible-p) (org-invisible-p2)) + (and (or entry-p (outline-invisible-p) (org-invisible-p2)) (org-show-hidden-entry))) ; show entire entry (when following-p ;; Show next sibling, or heading below text @@ -12035,6 +12347,7 @@ entire tree." "Highlight from BEG to END and mark the highlight is an occur headline." (let ((ov (make-overlay beg end))) (overlay-put ov 'face 'secondary-selection) + (overlay-put ov 'org-type 'org-occur) (push ov org-occur-highlights))) (defun org-remove-occur-highlights (&optional beg end noremove) @@ -12079,8 +12392,7 @@ ACTION can be `set', `up', `down', or a character." (org-back-to-heading t) (if (looking-at org-priority-regexp) (setq current (string-to-char (match-string 2)) - have t) - (setq current org-default-priority)) + have t)) (cond ((eq action 'remove) (setq remove t new ?\ )) @@ -12100,19 +12412,36 @@ ACTION can be `set', `up', `down', or a character." (error "Priority must be between `%c' and `%c'" org-highest-priority org-lowest-priority)))) ((eq action 'up) - (if (and (not have) (eq last-command this-command)) - (setq new org-lowest-priority) - (setq new (if (and org-priority-start-cycle-with-default (not have)) - org-default-priority (1- current))))) + (setq new (if have + (1- current) ; normal cycling + ;; last priority was empty + (if (eq last-command this-command) + org-lowest-priority ; wrap around empty to lowest + ;; default + (if org-priority-start-cycle-with-default + org-default-priority + (1- org-default-priority)))))) ((eq action 'down) - (if (and (not have) (eq last-command this-command)) - (setq new org-highest-priority) - (setq new (if (and org-priority-start-cycle-with-default (not have)) - org-default-priority (1+ current))))) + (setq new (if have + (1+ current) ; normal cycling + ;; last priority was empty + (if (eq last-command this-command) + org-highest-priority ; wrap around empty to highest + ;; default + (if org-priority-start-cycle-with-default + org-default-priority + (1+ org-default-priority)))))) (t (error "Invalid action"))) (if (or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) - (setq remove t)) + (if (and (memq action '(up down)) + (not have) (not (eq last-command this-command))) + ;; `new' is from default priority + (error + "The default can not be set, see `org-default-priority' why") + ;; normal cycling: `new' is beyond highest/lowest priority + ;; and is wrapped around to the empty priority + (setq remove t))) (setq news (format "%c" new)) (if have (if remove @@ -12153,7 +12482,7 @@ Can be set by the action argument to `org-scan-tag's and `org-map-entries'.") (defvar org-scanner-tags nil "The current tag list while the tags scanner is running.") (defvar org-trust-scanner-tags nil - "Should `org-get-tags-at' use the tags fro the scanner. + "Should `org-get-tags-at' use the tags for the scanner. This is for internal dynamical scoping only. When this is non-nil, the function `org-get-tags-at' will return the value of `org-scanner-tags' instead of building the list by itself. This @@ -12175,7 +12504,7 @@ MATCHER is a Lisp form to be evaluated, testing if a given set of tags qualifies a headline for inclusion. When TODO-ONLY is non-nil, only lines with a TODO keyword are included in the output." (require 'org-agenda) - (let* ((re (concat "^" outline-regexp " *\\(\\<\\(" + (let* ((re (concat "^" org-outline-regexp " *\\(\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))) @@ -12238,18 +12567,32 @@ only lines with a TODO keyword are included in the output." org-tags-exclude-from-inheritance)) ;; selective inheritance, remove uninherited ones (setcdr (car tags-alist) - (org-remove-uniherited-tags (cdar tags-alist)))) - (when (and (or (not todo-only) - (and (member todo org-not-done-keywords) - (or (not org-agenda-tags-todo-honor-ignore-options) - (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))) - (let ((case-fold-search t)) (eval matcher)) - (or - (not (member org-archive-tag tags-list)) - ;; we have an archive tag, should we use this anyway? - (or (not org-agenda-skip-archived-trees) - (and (eq action 'agenda) org-agenda-archives-mode)))) - (unless (eq action 'sparse-tree) (org-agenda-skip)) + (org-remove-uninherited-tags (cdar tags-alist)))) + (when (and + + ;; eval matcher only when the todo condition is OK + (and (or (not todo-only) (member todo org-not-done-keywords)) + (let ((case-fold-search t)) (eval matcher))) + + ;; Call the skipper, but return t if it does not skip, + ;; so that the `and' form continues evaluating + (progn + (unless (eq action 'sparse-tree) (org-agenda-skip)) + t) + + ;; Check if timestamps are deselecting this entry + (or (not todo-only) + (and (member todo org-not-done-keywords) + (or (not org-agenda-tags-todo-honor-ignore-options) + (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))) + + ;; Extra check for the archive tag + ;; FIXME: Does the skipper already do this???? + (or + (not (member org-archive-tag tags-list)) + ;; we have an archive tag, should we use this anyway? + (or (not org-agenda-skip-archived-trees) + (and (eq action 'agenda) org-agenda-archives-mode)))) ;; select this headline @@ -12298,7 +12641,7 @@ only lines with a TODO keyword are included in the output." (org-hide-archived-subtrees (point-min) (point-max))) (nreverse rtn))) -(defun org-remove-uniherited-tags (tags) +(defun org-remove-uninherited-tags (tags) "Remove all tags that are not inherited from the list TAGS." (cond ((eq org-use-tag-inheritance t) @@ -12348,7 +12691,9 @@ also TODO lines." (org-entry-properties pom))))))) (defun org-global-tags-completion-table (&optional files) - "Return the list of all tags in all agenda buffer/files." + "Return the list of all tags in all agenda buffer/files. +Optional FILES argument is a list of files to which can be used +instead of the agenda files." (save-excursion (org-uniquify (delq nil @@ -12365,7 +12710,7 @@ also TODO lines." (org-agenda-files)))))))) (defun org-make-tags-matcher (match) - "Create the TAGS//TODO matcher form for the selection string MATCH." + "Create the TAGS/TODO matcher form for the selection string MATCH." ;; todo-only is scoped dynamically into this function, and the function ;; may change it if the matcher asks for it. (unless match @@ -12593,7 +12938,7 @@ ignore inherited ones." (setq ltags (mapcar 'org-add-prop-inherited ltags))) (setq tags (append (if parent - (org-remove-uniherited-tags ltags) + (org-remove-uninherited-tags ltags) ltags) tags))) (or org-use-tag-inheritance (throw 'done t)) @@ -12601,7 +12946,9 @@ ignore inherited ones." (or (org-up-heading-safe) (error nil)) (setq parent t))) (error nil))))) - (append (org-remove-uniherited-tags org-file-tags) tags))))) + (if local + tags + (append (org-remove-uninherited-tags org-file-tags) tags)))))) (defun org-add-prop-inherited (s) (add-text-properties 0 (length s) '(inherited t) s) @@ -12718,7 +13065,7 @@ If DATA is nil or the empty string, any tags will be removed." "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." (interactive "P") - (let* ((re (concat "^" outline-regexp)) + (let* ((re org-outline-regexp-bol) (current (org-get-tags-string)) (col (current-column)) (org-setting-tags t) @@ -12757,15 +13104,14 @@ With prefix ARG, realign all tags in headings in the current buffer." org-todo-key-alist)) (let ((org-add-colon-after-tag-completion t)) (org-trim - (org-without-partial-completion - (org-icompleting-read "Tags: " - 'org-tags-completion-function - nil nil current 'org-tags-history))))))) + (org-icompleting-read "Tags: " + 'org-tags-completion-function + nil nil current 'org-tags-history)))))) (while (string-match "[-+&]+" tags) ;; No boolean logic, just a list (setq tags (replace-match ":" t t tags)))) - (setq tags (replace-regexp-in-string "[ ,]" ":" tags)) + (setq tags (replace-regexp-in-string "[,]" ":" tags)) (if org-tags-sort-function (setq tags (mapconcat 'identity @@ -13026,7 +13372,7 @@ Returns the new tags string, or nil to not change the current settings." (setq exit-after-next (not exit-after-next))) (setq expert nil) (delete-other-windows) - (split-window-vertically) + (set-window-buffer (split-window-vertically) " *Org tags*") (org-switch-to-buffer-other-window " *Org tags*") (org-fit-window-to-buffer))) ((or (= c ?\C-g) @@ -13150,6 +13496,7 @@ SCOPE determines the scope of this command. It can be any of: nil The current buffer, respecting the restriction if any tree The subtree started with the entry at point +region The entries within the active region, if any file The current buffer, without restriction file-with-archives The current buffer, and any archives associated with it @@ -13198,10 +13545,13 @@ a *different* entry, you cannot use these techniques." (save-excursion (save-restriction - (when (eq scope 'tree) - (org-back-to-heading t) - (org-narrow-to-subtree) - (setq scope nil)) + (cond ((eq scope 'tree) + (org-back-to-heading t) + (org-narrow-to-subtree) + (setq scope nil)) + ((and (eq scope 'region) (org-region-active-p)) + (narrow-to-region (region-beginning) (region-end)) + (setq scope nil))) (if (not scope) (progn @@ -13237,7 +13587,7 @@ a *different* entry, you cannot use these techniques." (defconst org-special-properties '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY" - "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED") + "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM") "The special properties valid in Org-mode. These are properties that are not defined in the property drawer, @@ -13247,7 +13597,8 @@ but in some other way.") '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID" "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" - "EXPORT_FILE_NAME" "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" + "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME" + "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE" "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS") "Some properties that are used by Org-mode for various purposes. @@ -13275,6 +13626,11 @@ Being in this list makes sure that they are offered for completion.") org-property-end-re "\\)\n?") "Matches an entire clock drawer.") +(defsubst org-re-property (property) + "Return a regexp matching PROPERTY. +Match group 1 will be set to the value " + (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)")) + (defun org-property-action () "Do an action on properties." (interactive) @@ -13409,6 +13765,8 @@ things up because then unnecessary parsing is avoided." (when (and (or (not specific) (string= specific "PRIORITY")) (looking-at org-priority-regexp)) (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) + (when (or (not specific) (string= specific "FILE")) + (push (cons "FILE" buffer-file-name) props)) (when (and (or (not specific) (string= specific "TAGS")) (setq value (org-get-tags-string)) (string-match "\\S-" value)) @@ -13424,32 +13782,38 @@ things up because then unnecessary parsing is avoided." (member specific '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" "TIMESTAMP" "TIMESTAMP_IA"))) - (while (re-search-forward org-maybe-keyword-time-regexp end t) - (setq key (if (match-end 1) - (substring (org-match-string-no-properties 1) - 0 -1)) - string (if (equal key clockstr) - (org-no-properties - (org-trim - (buffer-substring - (match-beginning 3) (goto-char - (point-at-eol))))) - (substring (org-match-string-no-properties 3) - 1 -1))) - ;; Get the correct property name from the key. This is - ;; necessary if the user has configured time keywords. - (setq key1 (concat key ":")) - (cond - ((not key) - (setq key - (if (= (char-after (match-beginning 3)) ?\[) - "TIMESTAMP_IA" "TIMESTAMP"))) - ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) - ((equal key1 org-deadline-string) (setq key "DEADLINE")) - ((equal key1 org-closed-string) (setq key "CLOSED")) - ((equal key1 org-clock-string) (setq key "CLOCK"))) - (when (or (equal key "CLOCK") (not (assoc key props))) - (push (cons key string) props)))) + (catch 'match + (while (re-search-forward org-maybe-keyword-time-regexp end t) + (setq key (if (match-end 1) + (substring (org-match-string-no-properties 1) + 0 -1)) + string (if (equal key clockstr) + (org-no-properties + (org-trim + (buffer-substring + (match-beginning 3) (goto-char + (point-at-eol))))) + (substring (org-match-string-no-properties 3) + 1 -1))) + ;; Get the correct property name from the key. This is + ;; necessary if the user has configured time keywords. + (setq key1 (concat key ":")) + (cond + ((not key) + (setq key + (if (= (char-after (match-beginning 3)) ?\[) + "TIMESTAMP_IA" "TIMESTAMP"))) + ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) + ((equal key1 org-deadline-string) (setq key "DEADLINE")) + ((equal key1 org-closed-string) (setq key "CLOSED")) + ((equal key1 org-clock-string) (setq key "CLOCK"))) + (if (and specific (equal key specific) (not (equal key "CLOCK"))) + (progn + (push (cons key string) props) + ;; no need to search further if match is found + (throw 'match t)) + (when (or (equal key "CLOCK") (not (assoc key props))) + (push (cons key string) props)))))) ) (when (memq which '(all standard)) @@ -13470,10 +13834,7 @@ things up because then unnecessary parsing is avoided." 'add_times)) props)) (unless (assoc "CATEGORY" props) - (setq value (or (org-get-category) - (progn (org-refresh-category-properties) - (org-get-category)))) - (push (cons "CATEGORY" value) props)) + (push (cons "CATEGORY" (org-get-category)) props)) (append sum-props (nreverse props))))))) (defun org-entry-get (pom property &optional inherit literal-nil) @@ -13497,11 +13858,12 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy." ;; We need a special property. Use `org-entry-properties' to ;; retrieve it, but specify the wanted property (cdr (assoc property (org-entry-properties nil 'special property))) - (let ((range (org-get-property-block))) + (let ((range (unless (org-before-first-heading-p) + (org-get-property-block)))) (if (and range (goto-char (car range)) (re-search-forward - (concat "^[ \t]*:" property ":[ \t]*\\(.*[^ \t\r\n\f\v]\\)?") + (org-re-property property) (cdr range) t)) ;; Found the property, return it. (if (match-end 1) @@ -13527,7 +13889,7 @@ If yes, return this value. If not, return the current value of the variable." (if (and range (goto-char (car range)) (re-search-forward - (concat "^[ \t]*:" property ":[ \t]*\\(.*[^ \t\r\n\f\v]\\)") + (org-re-property property) (cdr range) t)) (progn (delete-region (match-beginning 0) (1+ (point-at-eol))) @@ -13610,21 +13972,22 @@ should be considered as undefined (this is the meaning of nil here). However, if LITERAL-NIL is set, return the string value \"nil\" instead." (move-marker org-entry-property-inherited-from nil) (let (tmp) - (save-excursion - (save-restriction - (widen) - (catch 'ex - (while t - (when (setq tmp (org-entry-get nil property nil 'literal-nil)) - (org-back-to-heading t) - (move-marker org-entry-property-inherited-from (point)) - (throw 'ex tmp)) - (or (org-up-heading-safe) (throw 'ex nil))))) - (setq tmp (or tmp - (cdr (assoc property org-file-properties)) - (cdr (assoc property org-global-properties)) - (cdr (assoc property org-global-properties-fixed)))) - (if literal-nil tmp (org-not-nil tmp))))) + (unless (org-before-first-heading-p) + (save-excursion + (save-restriction + (widen) + (catch 'ex + (while t + (when (setq tmp (org-entry-get nil property nil 'literal-nil)) + (org-back-to-heading t) + (move-marker org-entry-property-inherited-from (point)) + (throw 'ex tmp)) + (or (org-up-heading-safe) (throw 'ex nil))))))) + (setq tmp (or tmp + (cdr (assoc property org-file-properties)) + (cdr (assoc property org-global-properties)) + (cdr (assoc property org-global-properties-fixed)))) + (if literal-nil tmp (org-not-nil tmp)))) (defvar org-property-changed-functions nil "Hook called when the value of a property has changed. @@ -13673,15 +14036,15 @@ and the new value.") (setq range (org-get-property-block beg end 'force)) (goto-char (car range)) (if (re-search-forward - (concat "^[ \t]*:" property ":\\(.*\\)") (cdr range) t) + (org-re-property property) (cdr range) t) (progn - (delete-region (match-beginning 1) (match-end 1)) - (goto-char (match-beginning 1))) + (delete-region (match-beginning 0) (match-end 0)) + (goto-char (match-beginning 0))) (goto-char (cdr range)) (insert "\n") (backward-char 1) - (org-indent-line-function) - (insert ":" property ":")) + (org-indent-line-function)) + (insert ":" property ":") (and value (insert " " value)) (org-indent-line-function))))) (run-hook-with-args 'org-property-changed-functions property value))) @@ -13691,7 +14054,8 @@ and the new value.") With INCLUDE-SPECIALS, also list the special properties that reflect things like tags and TODO state. With INCLUDE-DEFAULTS, also include properties that has special meaning -internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING. +internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING +and others. With INCLUDE-COLUMNS, also include property names given in COLUMN formats in the current buffer." (let (rtn range cfmt s p) @@ -13735,12 +14099,12 @@ formats in the current buffer." (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) (defun org-property-values (key) - "Return a list of all values of property KEY." + "Return a list of all values of property KEY in the current buffer." (save-excursion (save-restriction (widen) (goto-char (point-min)) - (let ((re (concat "^[ \t]*:" key ":[ \t]*\\(\\S-.*\\)")) + (let ((re (org-re-property key)) values) (while (re-search-forward re nil t) (add-to-list 'values (org-trim (match-string 1)))) @@ -13750,7 +14114,7 @@ formats in the current buffer." "Insert a property drawer into the current entry." (interactive) (org-back-to-heading t) - (looking-at outline-regexp) + (looking-at org-outline-regexp) (let ((indent (if org-adapt-indentation (- (match-end 0)(match-beginning 0)) 0)) @@ -13761,7 +14125,7 @@ formats in the current buffer." (setq end (point)) (goto-char beg) (while (re-search-forward re end t)) - (setq hiddenp (org-invisible-p)) + (setq hiddenp (outline-invisible-p)) (end-of-line 1) (and (equal (char-after) ?\n) (forward-char 1)) (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)") @@ -13786,6 +14150,69 @@ formats in the current buffer." (hide-entry)) (org-flag-drawer t)))) +(defvar org-property-set-functions-alist nil + "Property set function alist. +Each entry should have the following format: + + (PROPERTY . READ-FUNCTION) + +The read function will be called with the same argument as +`org-completing-read'.") + +(defun org-set-property-function (property) + "Get the function that should be used to set PROPERTY. +This is computed according to `org-property-set-functions-alist'." + (or (cdr (assoc property org-property-set-functions-alist)) + 'org-completing-read)) + +(defun org-read-property-value (property) + "Read PROPERTY value from user." + (let* ((completion-ignore-case t) + (allowed (org-property-get-allowed-values nil property 'table)) + (cur (org-entry-get nil property)) + (prompt (concat property " value" + (if (and cur (string-match "\\S-" cur)) + (concat " [" cur "]") "") ": ")) + (set-function (org-set-property-function property)) + (val (if allowed + (funcall set-function prompt allowed nil + (not (get-text-property 0 'org-unrestricted + (caar allowed)))) + (let (org-completion-use-ido org-completion-use-iswitchb) + (funcall set-function prompt + (mapcar 'list (org-property-values property)) + nil nil "" nil cur))))) + (if (equal val "") + cur + val))) + +(defvar org-last-set-property nil) +(defun org-read-property-name () + "Read a property name." + (let* ((completion-ignore-case t) + (keys (org-buffer-property-keys nil t t)) + (default-prop (or (save-excursion + (save-match-data + (beginning-of-line) + (and (looking-at "^\\s-*:\\([^:\n]+\\):") + (null (string= (match-string 1) "END")) + (match-string 1)))) + org-last-set-property)) + (property (org-icompleting-read + (concat "Property" + (if default-prop (concat " [" default-prop "]") "") + ": ") + (mapcar 'list keys) + nil nil nil nil + default-prop + ))) + (if (member property keys) + property + (or (cdr (assoc (downcase property) + (mapcar (lambda (x) (cons (downcase x) x)) + keys))) + property)))) + (defun org-set-property (property value) "In the current entry, set PROPERTY to VALUE. When called interactively, this will prompt for a property name, offering @@ -13793,31 +14220,12 @@ completion on existing and default properties. And then it will prompt for a value, offering completion either on allowed values (via an inherited xxx_ALL property) or on existing values in other instances of this property in the current file." - (interactive - (let* ((completion-ignore-case t) - (keys (org-buffer-property-keys nil t t)) - (prop0 (org-icompleting-read "Property: " (mapcar 'list keys))) - (prop (if (member prop0 keys) - prop0 - (or (cdr (assoc (downcase prop0) - (mapcar (lambda (x) (cons (downcase x) x)) - keys))) - prop0))) - (cur (org-entry-get nil prop)) - (prompt (concat prop " value" - (if (and cur (string-match "\\S-" cur)) - (concat " [" cur "]") "") ": ")) - (allowed (org-property-get-allowed-values nil prop 'table)) - (existing (mapcar 'list (org-property-values prop))) - (val (if allowed - (org-completing-read prompt allowed nil - (not (get-text-property 0 'org-unrestricted - (caar allowed)))) - (let (org-completion-use-ido org-completion-use-iswitchb) - (org-completing-read prompt existing nil nil "" nil cur))))) - (list prop (if (equal val "") cur val)))) - (unless (equal (org-entry-get nil property) value) - (org-entry-put nil property value))) + (interactive (list nil nil)) + (let* ((property (or property (org-read-property-name))) + (value (or value (org-read-property-value property)))) + (setq org-last-set-property property) + (unless (equal (org-entry-get nil property) value) + (org-entry-put nil property value)))) (defun org-delete-property (property) "In the current entry, delete PROPERTY." @@ -13845,7 +14253,7 @@ in the current file." (goto-char (point-min)) (let ((cnt 0)) (while (re-search-forward - (concat "^[ \t]*:" (regexp-quote property) ":.*\n?") + (org-re-property property) nil t) (setq cnt (1+ cnt)) (replace-match "")) @@ -13957,7 +14365,7 @@ only headings." (level 1) (lmin 1) (lmax 1) - limit re end found pos heading cnt) + limit re end found pos heading cnt flevel) (unless buffer (error "File not found :%s" file)) (with-current-buffer buffer (save-excursion @@ -13972,13 +14380,13 @@ only headings." (while (re-search-forward re end t) (setq level (- (match-end 1) (match-beginning 1))) (if (and (>= level lmin) (<= level lmax)) - (setq found (match-beginning 0) cnt (1+ cnt)))) + (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) (when (= cnt 0) (error "Heading not found on level %d: %s" lmax heading)) (when (> cnt 1) (error "Heading not unique on level %d: %s" lmax heading)) (goto-char found) - (setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0))) + (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) (setq end (save-excursion (org-end-of-subtree t t)))) (when (org-on-heading-p) (move-marker (make-marker) (point)))))))) @@ -14072,6 +14480,13 @@ at the cursor, it will be modified." (apply 'encode-time (org-parse-time-string (match-string 1))) (current-time))) (default-input (and ts (org-get-compact-tod ts))) + (repeater (save-excursion + (save-match-data + (beginning-of-line) + (when (re-search-forward + "\\([.+-]+[0-9]+[dwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?" + (save-excursion (progn (end-of-line) (point))) t) + (match-string 0))))) org-time-was-given org-end-time-was-given time) (cond ((and (org-at-timestamp-p t) @@ -14091,7 +14506,11 @@ at the cursor, it will be modified." (setq org-last-changed-timestamp (org-insert-time-stamp time (or org-time-was-given arg) - inactive nil nil (list org-end-time-was-given)))) + inactive nil nil (list org-end-time-was-given))) + (when repeater (goto-char (1- (point))) (insert " " repeater) + (setq org-last-changed-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater ">")))) (message "Timestamp updated")) (t (setq time (let ((this-command this-command)) @@ -14139,6 +14558,8 @@ So these are more for recording a certain time/date." (defvar org-dcst nil) ; dynamically scoped (defvar org-read-date-history nil) (defvar org-read-date-final-answer nil) +(defvar org-read-date-analyze-futurep nil) +(defvar org-read-date-analyze-forced-year nil) (defun org-read-date (&optional with-time to-time from-string prompt default-time default-input) @@ -14224,82 +14645,85 @@ user." (save-excursion (save-window-excursion (calendar) - (calendar-forward-day (- (time-to-days def) - (calendar-absolute-from-gregorian - (calendar-current-date)))) - (org-eval-in-calendar nil t) - (let* ((old-map (current-local-map)) - (map (copy-keymap calendar-mode-map)) - (minibuffer-local-map (copy-keymap minibuffer-local-map))) - (org-defkey map (kbd "RET") 'org-calendar-select) - (org-defkey map [mouse-1] 'org-calendar-select-mouse) - (org-defkey map [mouse-2] 'org-calendar-select-mouse) - (org-defkey minibuffer-local-map [(meta shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey minibuffer-local-map [(meta shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey minibuffer-local-map [(meta shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey minibuffer-local-map [(meta shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey minibuffer-local-map [?\e (shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey minibuffer-local-map [?\e (shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey minibuffer-local-map [?\e (shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey minibuffer-local-map [?\e (shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey minibuffer-local-map [(shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-week 1)))) - (org-defkey minibuffer-local-map [(shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-week 1)))) - (org-defkey minibuffer-local-map [(shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-day 1)))) - (org-defkey minibuffer-local-map [(shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-day 1)))) - (org-defkey minibuffer-local-map ">" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-left 1)))) - (org-defkey minibuffer-local-map "<" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-right 1)))) - (org-defkey minibuffer-local-map "\C-v" - (lambda () (interactive) - (org-eval-in-calendar - '(calendar-scroll-left-three-months 1)))) - (org-defkey minibuffer-local-map "\M-v" - (lambda () (interactive) - (org-eval-in-calendar - '(calendar-scroll-right-three-months 1)))) - (run-hooks 'org-read-date-minibuffer-setup-hook) - (unwind-protect - (progn - (use-local-map map) - (add-hook 'post-command-hook 'org-read-date-display) - (setq org-ans0 (read-string prompt default-input - 'org-read-date-history nil)) - ;; org-ans0: from prompt - ;; org-ans1: from mouse click - ;; org-ans2: from calendar motion - (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) - (remove-hook 'post-command-hook 'org-read-date-display) - (use-local-map old-map) - (when org-read-date-overlay - (delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))))) + (unwind-protect + (progn + (calendar-forward-day (- (time-to-days def) + (calendar-absolute-from-gregorian + (calendar-current-date)))) + (org-eval-in-calendar nil t) + (let* ((old-map (current-local-map)) + (map (copy-keymap calendar-mode-map)) + (minibuffer-local-map (copy-keymap minibuffer-local-map))) + (org-defkey map (kbd "RET") 'org-calendar-select) + (org-defkey map [mouse-1] 'org-calendar-select-mouse) + (org-defkey map [mouse-2] 'org-calendar-select-mouse) + (org-defkey minibuffer-local-map [(meta shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey minibuffer-local-map [(meta shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey minibuffer-local-map [(meta shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey minibuffer-local-map [(meta shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey minibuffer-local-map [?\e (shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey minibuffer-local-map [?\e (shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey minibuffer-local-map [?\e (shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey minibuffer-local-map [?\e (shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey minibuffer-local-map [(shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-week 1)))) + (org-defkey minibuffer-local-map [(shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-week 1)))) + (org-defkey minibuffer-local-map [(shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-day 1)))) + (org-defkey minibuffer-local-map [(shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-day 1)))) + (org-defkey minibuffer-local-map ">" + (lambda () (interactive) + (org-eval-in-calendar '(scroll-calendar-left 1)))) + (org-defkey minibuffer-local-map "<" + (lambda () (interactive) + (org-eval-in-calendar '(scroll-calendar-right 1)))) + (org-defkey minibuffer-local-map "\C-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-left-three-months 1)))) + (org-defkey minibuffer-local-map "\M-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-right-three-months 1)))) + (run-hooks 'org-read-date-minibuffer-setup-hook) + (unwind-protect + (progn + (use-local-map map) + (add-hook 'post-command-hook 'org-read-date-display) + (setq org-ans0 (read-string prompt default-input + 'org-read-date-history nil)) + ;; org-ans0: from prompt + ;; org-ans1: from mouse click + ;; org-ans2: from calendar motion + (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) + (remove-hook 'post-command-hook 'org-read-date-display) + (use-local-map old-map) + (when org-read-date-overlay + (delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil))))) + (bury-buffer "*Calendar*"))))) (t ; Naked prompt only (unwind-protect @@ -14311,6 +14735,13 @@ user." (setq final (org-read-date-analyze ans def defdecode)) + (when org-read-date-analyze-forced-year + (message "Year was forced into %s" + (if org-read-date-force-compatible-dates + "compatible range (1970-2037)" + "range representable on this machine")) + (ding)) + ;; One round trip to get rid of 34th of August and stuff like that.... (setq final (decode-time (apply 'encode-time final))) @@ -14327,7 +14758,6 @@ user." (defvar def) (defvar defdecode) (defvar with-time) -(defvar org-read-date-analyze-futurep nil) (defun org-read-date-display () "Display the current date prompt interpretation in the minibuffer." (when org-read-date-display-live @@ -14370,7 +14800,8 @@ user." delta deltan deltaw deltadef year month day hour minute second wday pm h2 m2 tl wday1 iso-year iso-weekday iso-week iso-year iso-date futurep kill-year) - (setq org-read-date-analyze-futurep nil) + (setq org-read-date-analyze-futurep nil + org-read-date-analyze-forced-year nil) (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) (setq ans "+0")) @@ -14404,6 +14835,19 @@ user." (if (< year 100) (setq year (+ 2000 year))) (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) t nil ans))) + + ;; Help matching dottet european dates + (when (string-match + "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\. ?\\([1-9][0-9][0-9][0-9]\\)?" ans) + (setq year (if (match-end 3) + (string-to-number (match-string 3 ans)) + (progn (setq kill-year t) + (string-to-number (format-time-string "%Y")))) + day (string-to-number (match-string 1 ans)) + month (string-to-number (match-string 2 ans)) + ans (replace-match (format "%04d-%02d-%02d\\5" year month day) + t nil ans))) + ;; Help matching american dates, like 5/30 or 5/30/7 (when (string-match "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans) @@ -14528,7 +14972,18 @@ user." (nth 2 tl)) (setq org-time-was-given t)) (if (< year 100) (setq year (+ 2000 year))) - (if (< year 1970) (setq year (nth 5 defdecode))) ; not representable + ;; Check of the date is representable + (if org-read-date-force-compatible-dates + (progn + (if (< year 1970) + (setq year 1970 org-read-date-analyze-forced-year t)) + (if (> year 2037) + (setq year 2037 org-read-date-analyze-forced-year t))) + (condition-case nil + (ignore (encode-time second minute hour day month year)) + (error + (setq year (nth 5 defdecode)) + (setq org-read-date-analyze-forced-year t)))) (setq org-read-date-analyze-futurep futurep) (list second minute hour day month year))) @@ -14892,7 +15347,7 @@ days in order to avoid rounding problems." If there is a specifier for a cyclic time stamp, get the closest date to DAYNR. PREFER and SHOW-ALL are passed through to `org-closest-date'. -the variable date is bound by the calendar when this is called." +The variable date is bound by the calendar when this is called." (cond ((and daynr (string-match "\\`%%\\((.*)\\)" s)) (if (org-diary-sexp-entry (match-string 1 s) "" date) @@ -14983,7 +15438,7 @@ This uses the icalendar.el library." (defun org-closest-date (start current change prefer show-all) "Find the date closest to CURRENT that is consistent with START and CHANGE. -When PREFER is `past' return a date that is either CURRENT or past. +When PREFER is `past', return a date that is either CURRENT or past. When PREFER is `future', return a date that is either CURRENT or future. When SHOW-ALL is nil, only return the current occurrence of a time stamp." ;; Make the proper lists from the dates @@ -15079,16 +15534,16 @@ hour and minute fields will be nil if not given." (defun org-timestamp-up (&optional arg) "Increase the date item at the cursor by one. -If the cursor is on the year, change the year. If it is on the month or -the day, change that. +If the cursor is on the year, change the year. If it is on the month, +the day or the time, change that. With prefix ARG, change by that many units." (interactive "p") (org-timestamp-change (prefix-numeric-value arg) nil 'updown)) (defun org-timestamp-down (&optional arg) "Decrease the date item at the cursor by one. -If the cursor is on the year, change the year. If it is on the month or -the day, change that. +If the cursor is on the year, change the year. If it is on the month, +the day or the time, change that. With prefix ARG, change by that many units." (interactive "p") (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown)) @@ -15159,7 +15614,7 @@ With prefix ARG, change that many days." The date will be changed by N times WHAT. WHAT can be `day', `month', `year', `minute', `second'. If WHAT is not given, the cursor position in the timestamp determines what will be changed." - (let ((pos (point)) + (let ((origin (point)) origin-cat with-hm inactive (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) org-ts-what @@ -15169,6 +15624,10 @@ in the timestamp determines what will be changed." (error "Not at a timestamp")) (if (and (not what) (eq org-ts-what 'bracket)) (org-toggle-timestamp-type) + ;; Point isn't on brackets. Remember the part of the time-stamp + ;; the point was in. Indeed, size of time-stamps may change, + ;; but point must be kept in the same category nonetheless. + (setq origin-cat org-ts-what) (if (and (not what) (not (eq org-ts-what 'day)) org-display-custom-times (get-text-property (point) 'display) @@ -15219,11 +15678,30 @@ in the timestamp determines what will be changed." (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) (setq time (apply 'encode-time time0)))) - (setq org-last-changed-timestamp - (org-insert-time-stamp time with-hm inactive nil nil extra)) + ;; Insert the new time-stamp, and ensure point stays in the same + ;; category as before (i.e. not after the last position in that + ;; category). + (let ((pos (point))) + ;; Stay before inserted string. `save-excursion' is of no use. + (setq org-last-changed-timestamp + (org-insert-time-stamp time with-hm inactive nil nil extra)) + (goto-char pos)) + (save-match-data + (looking-at org-ts-regexp3) + (goto-char (cond + ;; `day' category ends before `hour' if any, or at + ;; the end of the day name. + ((eq origin-cat 'day) + (min (or (match-beginning 7) (1- (match-end 5))) origin)) + ((eq origin-cat 'hour) (min (match-end 7) origin)) + ((eq origin-cat 'minute) (min (1- (match-end 8)) origin)) + ((integerp origin-cat) (min (1- (match-end 0)) origin)) + ;; `year' and `month' have both fixed size: point + ;; couldn't have moved into another part. + (t origin)))) + ;; Update clock if on a CLOCK line. (org-clock-update-time-maybe) - (goto-char pos) - ;; Try to recenter the calendar window, if any + ;; Try to recenter the calendar window, if any. (if (and org-calendar-follow-timestamp-change (get-buffer-window "*Calendar*" t) (memq org-ts-what '(day month year))) @@ -15327,6 +15805,7 @@ In fact, the first hh:mm or number in the string will be taken, there can be extra stuff in the string. If no number is found, the return value is 0." (cond + ((integerp s) s) ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s) (+ (* (string-to-number (match-string 1 s)) 60) (string-to-number (match-string 2 s)))) @@ -15334,6 +15813,45 @@ If no number is found, the return value is 0." (string-to-number (match-string 1 s))) (t 0))) +(defcustom org-effort-durations + `(("h" . 60) + ("d" . ,(* 60 8)) + ("w" . ,(* 60 8 5)) + ("m" . ,(* 60 8 5 4)) + ("y" . ,(* 60 8 5 40))) + "Conversion factor to minutes for an effort modifier. + +Each entry has the form (MODIFIER . MINUTES). + +In an effort string, a number followed by MODIFIER is multiplied +by the specified number of MINUTES to obtain an effort in +minutes. + +For example, if the value of this variable is ((\"hours\" . 60)), then an +effort string \"2hours\" is equivalent to 120 minutes." + :group 'org-agenda + :type '(alist :key-type (string :tag "Modifier") + :value-type (number :tag "Minutes"))) + +(defun org-duration-string-to-minutes (s) + "Convert a duration string S to minutes. + +A bare number is interpreted as minutes, modifiers can be set by +customizing `org-effort-durations' (which see). + +Entries containing a colon are interpreted as H:MM by +`org-hh:mm-string-to-minutes'." + (let ((result 0) + (re (concat "\\([0-9]+\\) *\\(" + (regexp-opt (mapcar 'car org-effort-durations)) + "\\)"))) + (while (string-match re s) + (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations)) + (string-to-number (match-string 1 s)))) + (setq s (replace-match "" nil t s))) + (incf result (org-hh:mm-string-to-minutes s)) + result)) + ;;;; Files (defun org-save-all-org-buffers () @@ -15366,7 +15884,7 @@ changes from another. I believe the procedure must be like this: (lambda (b) (when (and (with-current-buffer b (org-mode-p)) (with-current-buffer b buffer-file-name)) - (switch-to-buffer b) + (org-pop-to-buffer-same-window b) (revert-buffer t 'no-confirm))) (buffer-list)) (when (and (featurep 'org-id) org-id-track-globally) @@ -15390,7 +15908,7 @@ Set `org-completion-use-ido' to make it use ido instead." (org-completion-use-ido org-completion-use-ido)) (unless (or org-completion-use-ido org-completion-use-iswitchb) (setq org-completion-use-iswitchb t)) - (switch-to-buffer + (org-pop-to-buffer-same-window (org-icompleting-read "Org buffer: " (mapcar 'list (mapcar 'buffer-name blist)) nil t)))) @@ -15416,17 +15934,17 @@ If EXCLUDE-TMP is non-nil, ignore temporary buffers." (filter (cond ((eq predicate 'files) - (lambda (b) (with-current-buffer b (eq major-mode 'org-mode)))) + (lambda (b) (with-current-buffer b (org-mode-p)))) ((eq predicate 'export) (lambda (b) (string-match "\*Org .*Export" (buffer-name b)))) ((eq predicate 'agenda) (lambda (b) (with-current-buffer b - (and (eq major-mode 'org-mode) + (and (org-mode-p) (setq bfn (buffer-file-name b)) (member (file-truename bfn) agenda-files))))) (t (lambda (b) (with-current-buffer b - (or (eq major-mode 'org-mode) + (or (org-mode-p) (string-match "\*Org .*Export" (buffer-name b))))))))) (delq nil @@ -15557,7 +16075,7 @@ If the current buffer does not, find the first agenda file." (find-file (car files)) (throw 'exit t)))) (find-file (car fs))) - (if (buffer-base-buffer) (switch-to-buffer (buffer-base-buffer))))) + (if (buffer-base-buffer) (org-pop-to-buffer-same-window (buffer-base-buffer))))) (defun org-agenda-file-to-front (&optional to-end) "Move/add the current file to the top of the agenda file list. @@ -15682,7 +16200,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (if (org-on-heading-p t) (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) (goto-char (point-min)) - (setq re (concat "^\\*+ +" org-comment-string "\\>")) + (setq re (concat org-outline-regexp-bol "+" org-comment-string "\\>")) (while (re-search-forward re nil t) (add-text-properties (match-beginning 0) (org-end-of-subtree t) pc))) @@ -15747,8 +16265,8 @@ sequence appearing also before point. Even though the matchers for math are configurable, this function assumes that \\begin, \\(, \\[, and $$ are always used. Only the single dollar delimiters are skipped when they have been removed by customization. -The return value is nil, or a cons cell with the delimiter -and the position of this delimiter. +The return value is nil, or a cons cell with the delimiter and the +position of this delimiter. This function does a reasonably good job, but can locally be fooled by for example currency specifications. For example it will assume being in @@ -15852,7 +16370,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (cond ((or (equal subtree '(16)) (not (save-excursion - (re-search-backward (concat "^" outline-regexp) nil t)))) + (re-search-backward org-outline-regexp-bol nil t)))) (setq beg (point-min) end (point-max) msg "Creating images for buffer...%s")) ((equal subtree '(4)) @@ -16158,7 +16676,7 @@ BEG and END default to the buffer boundaries." (interactive "P") (unless refresh (org-remove-inline-images) - (clear-image-cache)) + (if (fboundp 'clear-image-cache) (clear-image-cache))) (save-excursion (save-restriction (widen) @@ -16239,6 +16757,8 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) (org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) +(org-defkey org-mode-map [(control shift up)] 'org-shiftcontrolup) +(org-defkey org-mode-map [(control shift down)] 'org-shiftcontroldown) ;; Babel keys (define-key org-mode-map org-babel-key-prefix org-babel-map) @@ -16289,6 +16809,9 @@ BEG and END default to the buffer boundaries." (if (boundp 'narrow-map) (org-defkey narrow-map "s" 'org-narrow-to-subtree) (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)) +(if (boundp 'narrow-map) + (org-defkey narrow-map "b" 'org-narrow-to-block) + (org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block)) (org-defkey org-mode-map "\C-c\C-f" 'org-forward-same-level) (org-defkey org-mode-map "\C-c\C-b" 'org-backward-same-level) (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) @@ -16309,6 +16832,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) (org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) (org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift) +(org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible) (org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content) (org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content) (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) @@ -16499,9 +17023,9 @@ If not, return to the original position and throw an error." (defun org-speed-command-default-hook (keys) "Hook for activating single-letter speed commands. -`org-speed-commands-default' specifies a minimal command set. -Use `org-speed-commands-user' for further customization." - (when (or (and (bolp) (looking-at outline-regexp)) +`org-speed-commands-default' specifies a minimal command set. Use +`org-speed-commands-user' for further customization." + (when (or (and (bolp) (looking-at org-outline-regexp)) (and (functionp org-use-speed-commands) (funcall org-use-speed-commands))) (cdr (assoc keys (append org-speed-commands-user @@ -16522,11 +17046,11 @@ Each hook takes a single argument, a user-pressed command key which is also a `self-insert-command' from the global map. Within the hook, examine the cursor position and the command key -and return nil or a valid handler as appropriate. Handler could +and return nil or a valid handler as appropriate. Handler could be one of an interactive command, a function, or a form. Set `org-use-speed-commands' to non-nil value to enable this -hook. The default setting is `org-speed-command-default-hook'." +hook. The default setting is `org-speed-command-default-hook'." :group 'org-structure :type 'hook) @@ -16567,7 +17091,7 @@ overwritten, and the table is not marked as requiring realignment." (looking-at "[^|\n]* |")) (let (org-table-may-need-update) (goto-char (1- (match-end 0))) - (delete-backward-char 1) + (delete-char -1) (goto-char (match-beginning 0)) (self-insert-command N))) (t @@ -16580,7 +17104,7 @@ overwritten, and the table is not marked as requiring realignment." (if (>= org-self-insert-command-undo-counter 20) (setq org-self-insert-command-undo-counter 1) (and (> org-self-insert-command-undo-counter 0) - buffer-undo-list + buffer-undo-list (listp buffer-undo-list) (not (cadr buffer-undo-list)) ; remove nil entry (setcdr buffer-undo-list (cddr buffer-undo-list))) (setq org-self-insert-command-undo-counter @@ -16683,13 +17207,30 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (org-defkey org-mode-map "|" 'org-force-self-insert)) (defvar org-ctrl-c-ctrl-c-hook nil - "Hook for functions attaching themselves to `C-c C-c'. -This can be used to add additional functionality to the C-c C-c key which -executes context-dependent commands. -Each function will be called with no arguments. The function must check -if the context is appropriate for it to act. If yes, it should do its -thing and then return a non-nil value. If the context is wrong, -just do nothing and return nil.") + "Hook for functions attaching themselves to `C-c C-c'. + +This can be used to add additional functionality to the C-c C-c +key which executes context-dependent commands. This hook is run +before any other test, while `org-ctrl-c-ctrl-c-final-hook' is +run after the last test. + +Each function will be called with no arguments. The function +must check if the context is appropriate for it to act. If yes, +it should do its thing and then return a non-nil value. If the +context is wrong, just do nothing and return nil.") + +(defvar org-ctrl-c-ctrl-c-final-hook nil + "Hook for functions attaching themselves to `C-c C-c'. + +This can be used to add additional functionality to the C-c C-c +key which executes context-dependent commands. This hook is run +after any other test, while `org-ctrl-c-ctrl-c-hook' is run +before the first test. + +Each function will be called with no arguments. The function +must check if the context is appropriate for it to act. If yes, +it should do its thing and then return a non-nil value. If the +context is wrong, just do nothing and return nil.") (defvar org-tab-first-hook nil "Hook for functions to attach themselves to TAB. @@ -16873,13 +17414,17 @@ See the individual commands for more information." (cond ((run-hook-with-args-until-success 'org-metaleft-hook)) ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) - ((or (org-on-heading-p) - (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (org-on-heading-p)))) + ((org-with-limited-levels + (or (org-on-heading-p) + (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (org-on-heading-p))))) (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) (call-interactively 'org-do-promote)) + ;; At an inline task. + ((org-on-heading-p) + (call-interactively 'org-inlinetask-promote)) ((or (org-at-item-p) (and (org-region-active-p) (save-excursion @@ -16898,13 +17443,17 @@ See the individual commands for more information." (cond ((run-hook-with-args-until-success 'org-metaright-hook)) ((org-at-table-p) (call-interactively 'org-table-move-column)) - ((or (org-on-heading-p) - (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (org-on-heading-p)))) + ((org-with-limited-levels + (or (org-on-heading-p) + (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (org-on-heading-p))))) (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) (call-interactively 'org-do-demote)) + ;; At an inline task. + ((org-on-heading-p) + (call-interactively 'org-inlinetask-demote)) ((or (org-at-item-p) (and (org-region-active-p) (save-excursion @@ -16920,8 +17469,8 @@ WHAT can be either `headlines' or `items'. If the current line is an outline or item heading and it has a folded subtree below it, this function returns t, nil otherwise." (let ((re (cond - ((eq what 'headlines) (concat "^" org-outline-regexp)) - ((eq what 'items) (concat "^" (org-item-re t))) + ((eq what 'headlines) org-outline-regexp-bol) + ((eq what 'items) (org-item-beginning-re)) (t (error "This should not happen")))) beg end) (save-excursion @@ -17113,6 +17662,24 @@ Depending on context, this does one of the following: (org-call-for-shift-select 'backward-word)) (t (org-shiftselect-error)))) +(defun org-shiftcontrolup () + "Change timestamps synchronously up in CLOCK log lines." + (interactive) + (cond ((and (not org-support-shift-select) + (org-at-clock-log-p) + (org-at-timestamp-p t)) + (org-clock-timestamps-up)) + (t (org-shiftselect-error)))) + +(defun org-shiftcontroldown () + "Change timestamps synchronously down in CLOCK log lines." + (interactive) + (cond ((and (not org-support-shift-select) + (org-at-clock-log-p) + (org-at-timestamp-p t)) + (org-clock-timestamps-down)) + (t (org-shiftselect-error)))) + (defun org-ctrl-c-ret () "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context." (interactive) @@ -17120,6 +17687,20 @@ Depending on context, this does one of the following: ((org-at-table-p) (call-interactively 'org-table-hline-and-move)) (t (call-interactively 'org-insert-heading)))) +(defun org-copy-visible (beg end) + "Copy the visible parts of the region." + (interactive "r") + (let (snippets s) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (setq s (goto-char (point-min))) + (while (not (= (point) (point-max))) + (goto-char (org-find-invisible)) + (push (buffer-substring s (point)) snippets) + (setq s (goto-char (org-find-visible)))))) + (kill-new (apply 'concat (nreverse snippets))))) + (defun org-copy-special () "Copy region in table or copy current subtree. Calls `org-table-copy' or `org-copy-subtree', depending on context. @@ -17256,13 +17837,52 @@ This command does many different things, depending on context: (org-footnote-at-definition-p)) (call-interactively 'org-footnote-action)) ((org-at-item-checkbox-p) - (call-interactively 'org-list-repair) - (call-interactively 'org-toggle-checkbox) - (org-list-send-list 'maybe)) + ;; Cursor at a checkbox: repair list and update checkboxes. Send + ;; list only if at top item. + (let* ((cbox (match-string 1)) + (struct (org-list-struct)) + (old-struct (copy-tree struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (orderedp (org-entry-get nil "ORDERED")) + (firstp (= (org-list-get-top-point struct) (point-at-bol))) + block-item) + ;; Use a light version of `org-toggle-checkbox' to avoid + ;; computing list structure twice. + (org-list-set-checkbox (point-at-bol) struct + (cond + ((equal arg '(16)) "[-]") + ((equal arg '(4)) nil) + ((equal "[X]" cbox) "[ ]") + (t "[X]"))) + (org-list-struct-fix-ind struct parents) + (org-list-struct-fix-bul struct prevs) + (setq block-item + (org-list-struct-fix-box struct parents prevs orderedp)) + (when block-item + (message + "Checkboxes were removed due to unchecked box at line %d" + (org-current-line block-item))) + (org-list-struct-apply-struct struct old-struct) + (org-update-checkbox-count-maybe) + (when firstp (org-list-send-list 'maybe)))) ((org-at-item-p) - (call-interactively 'org-list-repair) - (when arg (call-interactively 'org-toggle-checkbox)) - (org-list-send-list 'maybe)) + ;; Cursor at an item: repair list. Do checkbox related actions + ;; only if function was called with an argument. Send list only + ;; if at top item. + (let* ((struct (org-list-struct)) + (old-struct (copy-tree struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (firstp (= (org-list-get-top-point struct) (point-at-bol)))) + (org-list-struct-fix-ind struct parents) + (org-list-struct-fix-bul struct prevs) + (when arg + (org-list-set-checkbox (point-at-bol) struct "[ ]") + (org-list-struct-fix-box struct parents prevs)) + (org-list-struct-apply-struct struct old-struct) + (when arg (org-update-checkbox-count-maybe)) + (when firstp (org-list-send-list 'maybe)))) ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) ;; Dynamic block (beginning-of-line 1) @@ -17284,7 +17904,9 @@ This command does many different things, depending on context: (org-save-outline-visibility 'use-markers (org-mode-restart))) (message "Local setup has been refreshed")))) ((org-clock-update-time-maybe)) - (t (error "C-c C-c can do nothing useful at this location"))))) + (t + (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) + (error "C-c C-c can do nothing useful at this location")))))) (defun org-mode-restart () "Restart Org-mode, to scan again for special lines. @@ -17313,6 +17935,18 @@ See the individual commands for more information." ((org-at-table-p) (org-table-justify-field-maybe) (call-interactively 'org-table-next-row)) + ;; when `newline-and-indent' is called within a list, make sure + ;; text moved stays inside the item. + ((and (org-in-item-p) indent) + (if (and (org-at-item-p) (>= (point) (match-end 0))) + (progn + (newline) + (org-indent-line-to (length (match-string 0)))) + (let ((ind (org-get-indentation))) + (newline) + (if (org-looking-back org-list-end-re) + (org-indent-line-function) + (org-indent-line-to ind))))) ((and org-return-follows-link (eq (get-text-property (point) 'face) 'org-link)) (call-interactively 'org-open-at-point)) @@ -17359,103 +17993,229 @@ Calls `org-table-insert-hline', `org-toggle-item', or (t (call-interactively 'org-toggle-item)))) -(defun org-toggle-item () +(defun org-toggle-item (arg) "Convert headings or normal lines to items, items to normal lines. If there is no active region, only the current line is considered. -If the first line in the region is a headline, convert all headlines to items. +If the first non blank line in the region is an headline, convert +all headlines to items, shifting text accordingly. -If the first line in the region is an item, convert all items to normal lines. +If it is an item, convert all items to normal lines. -If the first line is normal text, add an item bullet to each line." - (interactive) - (let (l2 l beg end) +If it is normal text, change region into an item. With a prefix +argument ARG, change each line in region into an item." + (interactive "P") + (let ((shift-text + (function + ;; Shift text in current section to IND, from point to END. + ;; The function leaves point to END line. + (lambda (ind end) + (let ((min-i 1000) (end (copy-marker end))) + ;; First determine the minimum indentation (MIN-I) of + ;; the text. + (save-excursion + (catch 'exit + (while (< (point) end) + (let ((i (org-get-indentation))) + (cond + ;; Skip blank lines and inline tasks. + ((looking-at "^[ \t]*$")) + ((looking-at org-outline-regexp-bol)) + ;; We can't find less than 0 indentation. + ((zerop i) (throw 'exit (setq min-i 0))) + ((< i min-i) (setq min-i i)))) + (forward-line)))) + ;; Then indent each line so that a line indented to + ;; MIN-I becomes indented to IND. Ignore blank lines + ;; and inline tasks in the process. + (let ((delta (- ind min-i))) + (while (< (point) end) + (unless (or (looking-at "^[ \t]*$") + (looking-at org-outline-regexp-bol)) + (org-indent-line-to (+ (org-get-indentation) delta))) + (forward-line))))))) + (skip-blanks + (function + ;; Return beginning of first non-blank line, starting from + ;; line at POS. + (lambda (pos) + (save-excursion + (goto-char pos) + (skip-chars-forward " \r\t\n") + (point-at-bol))))) + beg end) + ;; Determine boundaries of changes. (if (org-region-active-p) - (setq beg (region-beginning) end (region-end)) - (setq beg (point-at-bol) - end (min (1+ (point-at-eol)) (point-max)))) - (save-excursion - (goto-char end) - (setq l2 (org-current-line)) - (goto-char beg) - (beginning-of-line 1) - (setq l (1- (org-current-line))) - (if (org-at-item-p) - ;; We already have items, de-itemize - (while (< (setq l (1+ l)) l2) - (when (org-at-item-p) - (skip-chars-forward " \t") - (delete-region (point) (match-end 0))) - (beginning-of-line 2)) - (if (org-on-heading-p) - ;; Headings, convert to items - (while (< (setq l (1+ l)) l2) - (if (looking-at org-outline-regexp) - (replace-match (org-list-bullet-string "-") t t)) - (beginning-of-line 2)) - ;; normal lines, turn them into items - (while (< (setq l (1+ l)) l2) - (unless (org-at-item-p) - (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match - (concat "\\1" (org-list-bullet-string "-") "\\2")))) - (beginning-of-line 2))))))) + (setq beg (funcall skip-blanks (region-beginning)) + end (copy-marker (region-end))) + (setq beg (funcall skip-blanks (point-at-bol)) + end (copy-marker (point-at-eol)))) + ;; Depending on the starting line, choose an action on the text + ;; between BEG and END. + (org-with-limited-levels + (save-excursion + (goto-char beg) + (cond + ;; Case 1. Start at an item: de-itemize. Note that it only + ;; happens when a region is active: `org-ctrl-c-minus' + ;; would call `org-cycle-list-bullet' otherwise. + ((org-at-item-p) + (while (< (point) end) + (when (org-at-item-p) + (skip-chars-forward " \t") + (delete-region (point) (match-end 0))) + (forward-line))) + ;; Case 2. Start at an heading: convert to items. + ((org-on-heading-p) + (let* ((bul (org-list-bullet-string "-")) + (bul-len (length bul)) + ;; Indentation of the first heading. It should be + ;; relative to the indentation of its parent, if any. + (start-ind (save-excursion + (cond + ((not org-adapt-indentation) 0) + ((not (outline-previous-heading)) 0) + (t (length (match-string 0)))))) + ;; Level of first heading. Further headings will be + ;; compared to it to determine hierarchy in the list. + (ref-level (org-reduced-level (org-outline-level)))) + (while (< (point) end) + (let* ((level (org-reduced-level (org-outline-level))) + (delta (max 0 (- level ref-level)))) + ;; If current headline is less indented than the first + ;; one, set it as reference, in order to preserve + ;; subtrees. + (when (< level ref-level) (setq ref-level level)) + (replace-match bul t t) + (org-indent-line-to (+ start-ind (* delta bul-len))) + ;; Ensure all text down to END (or SECTION-END) belongs + ;; to the newly created item. + (let ((section-end (save-excursion + (or (outline-next-heading) (point))))) + (forward-line) + (funcall shift-text + (+ start-ind (* (1+ delta) bul-len)) + (min end section-end))))))) + ;; Case 3. Normal line with ARG: turn each non-item line into + ;; an item. + (arg + (while (< (point) end) + (unless (or (org-on-heading-p) (org-at-item-p)) + (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) + (forward-line))) + ;; Case 4. Normal line without ARG: make the first line of + ;; region an item, and shift indentation of others + ;; lines to set them as item's body. + (t (let* ((bul (org-list-bullet-string "-")) + (bul-len (length bul)) + (ref-ind (org-get-indentation))) + (skip-chars-forward " \t") + (insert bul) + (forward-line) + (while (< (point) end) + ;; Ensure that lines less indented than first one + ;; still get included in item body. + (funcall shift-text + (+ ref-ind bul-len) + (min end (save-excursion (or (outline-next-heading) + (point))))) + (forward-line))))))))) (defun org-toggle-heading (&optional nstars) "Convert headings to normal text, or items or text to headings. If there is no active region, only the current line is considered. -If the first line is a heading, remove the stars from all headlines -in the region. +If the first non blank line is an headline, remove the stars from +all headlines in the region. -If the first line is a plain list item, turn all plain list items -into headings. +If it is a plain list item, turn all plain list items into headings. -If the first line is a normal line, turn each and every line in the -region into a heading. +If it is a normal line, turn each and every normal line (i.e. not +an heading or an item) in the region into a heading. When converting a line into a heading, the number of stars is chosen such that the lines become children of the current entry. However, when a prefix argument is given, its value determines the number of stars to add." (interactive "P") - (let (l2 l itemp beg end) + (let ((skip-blanks + (function + ;; Return beginning of first non-blank line, starting from + ;; line at POS. + (lambda (pos) + (save-excursion + (goto-char pos) + (skip-chars-forward " \r\t\n") + (point-at-bol))))) + beg end) + ;; Determine boundaries of changes. If region ends at a bol, do + ;; not consider the last line to be in the region. (if (org-region-active-p) - (setq beg (region-beginning) end (region-end)) - (setq beg (point-at-bol) - end (min (1+ (point-at-eol)) (point-max)))) - (save-excursion - (goto-char end) - (setq l2 (org-current-line)) - (goto-char beg) - (beginning-of-line 1) - (setq l (1- (org-current-line))) - (if (org-on-heading-p) - ;; We already have headlines, de-star them - (while (< (setq l (1+ l)) l2) - (when (org-on-heading-p t) - (and (looking-at outline-regexp) (replace-match ""))) - (beginning-of-line 2)) - (setq itemp (org-at-item-p)) - (let* ((stars - (if nstars - (make-string (prefix-numeric-value current-prefix-arg) - ?*) - (save-excursion - (if (re-search-backward org-complex-heading-regexp nil t) - (match-string 1) "")))) - (add-stars (cond (nstars "") - ((equal stars "") "*") - (org-odd-levels-only "**") - (t "*"))) - (rpl (concat stars add-stars " "))) - (while (< (setq l (1+ l)) l2) - (if itemp - (and (org-at-item-p) (replace-match rpl t t)) - (unless (org-on-heading-p) - (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match (concat rpl (match-string 2)))))) - (beginning-of-line 2))))))) + (setq beg (funcall skip-blanks (region-beginning)) + end (copy-marker (save-excursion + (goto-char (region-end)) + (if (bolp) (point) (point-at-eol))))) + (setq beg (funcall skip-blanks (point-at-bol)) + end (copy-marker (point-at-eol)))) + ;; Ensure inline tasks don't count as headings. + (org-with-limited-levels + (save-excursion + (goto-char beg) + (cond + ;; Case 1. Started at an heading: de-star headings. + ((org-on-heading-p) + (while (< (point) end) + (when (org-on-heading-p t) + (looking-at org-outline-regexp) (replace-match "")) + (forward-line))) + ;; Case 2. Started at an item: change items into headlines. + ;; One star will be added by `org-list-to-subtree'. + ((org-at-item-p) + (let* ((stars (make-string + (if nstars + ;; subtract the star that will be added again by + ;; `org-list-to-subtree' + (1- (prefix-numeric-value current-prefix-arg)) + (or (org-current-level) 0)) + ?*)) + (add-stars + (cond (nstars "") ; stars from prefix only + ((equal stars "") "") ; before first heading + (org-odd-levels-only "*") ; inside heading, odd + (t "")))) ; inside heading, oddeven + (while (< (point) end) + (when (org-at-item-p) + ;; Pay attention to cases when region ends before list. + (let* ((struct (org-list-struct)) + (list-end (min (org-list-get-bottom-point struct) (1+ end)))) + (save-restriction + (narrow-to-region (point) list-end) + (insert + (org-list-to-subtree + (org-list-parse-list t) + '(:istart (concat stars add-stars (funcall get-stars depth)) + :icount (concat stars add-stars (funcall get-stars depth)))))))) + (forward-line)))) + ;; Case 3. Started at normal text: make every line an heading, + ;; skipping headlines and items. + (t (let* ((stars (make-string + (if nstars + (prefix-numeric-value current-prefix-arg) + (or (org-current-level) 0)) + ?*)) + (add-stars + (cond (nstars "") ; stars from prefix only + ((equal stars "") "*") ; before first heading + (org-odd-levels-only "**") ; inside heading, odd + (t "*"))) ; inside heading, oddeven + (rpl (concat stars add-stars " "))) + (while (< (point) end) + (when (and (not (org-on-heading-p)) (not (org-at-item-p)) + (looking-at "\\([ \t]*\\)\\(\\S-\\)")) + (replace-match (concat rpl (match-string 2)))) + (forward-line))))))))) (defun org-meta-return (&optional arg) "Insert a new heading or wrap a region in a table. @@ -17561,6 +18321,8 @@ See the individual commands for more information." "--" ["Clone subtree, shift time" org-clone-subtree-with-time-shift t] "--" + ["Copy visible text" org-copy-visible t] + "--" ["Promote Heading" org-metaleft (not (org-at-table-p))] ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] ["Demote Heading" org-metaright (not (org-at-table-p))] @@ -17618,10 +18380,10 @@ See the individual commands for more information." :selected org-enforce-todo-dependencies :style toggle :active t] "Settings for tree at point" ["Do Children sequentially" org-toggle-ordered-property :style radio - :selected (ignore-errors (org-entry-get nil "ORDERED")) + :selected (org-entry-get nil "ORDERED") :active org-enforce-todo-dependencies :keys "C-c C-x o"] ["Do Children parallel" org-toggle-ordered-property :style radio - :selected (ignore-errors (not (org-entry-get nil "ORDERED"))) + :selected (not (org-entry-get nil "ORDERED")) :active org-enforce-todo-dependencies :keys "C-c C-x o"] "--" ["Set Priority" org-priority t] @@ -17750,7 +18512,7 @@ information about your Org-mode version and configuration." (org-version) (let (list) (save-window-excursion - (switch-to-buffer (get-buffer-create "*Warn about privacy*")) + (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) (delete-other-windows) (erase-buffer) (insert "You are about to submit a bug report to the Org-mode mailing list. @@ -17921,6 +18683,12 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (display-buffer buf) (sit-for 0)))) +(defun org-eval (form) + "Eval FORM and return result." + (condition-case error + (eval form) + (error (format "%%![Error: %s]" error)))) + (defun org-in-commented-line () "Is point in a line starting with `#'?" (equal (char-after (point-at-bol)) ?#)) @@ -17941,7 +18709,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (if (and marker (marker-buffer marker) (buffer-live-p (marker-buffer marker))) (progn - (switch-to-buffer (marker-buffer marker)) + (org-pop-to-buffer-same-window (marker-buffer marker)) (if (or (> marker (point-max)) (< marker (point-min))) (widen)) (goto-char marker) @@ -17956,16 +18724,6 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") s)) -(defun org-plist-delete (plist property) - "Delete PROPERTY from PLIST. -This is in contrast to merely setting it to 0." - (let (p) - (while plist - (if (not (eq property (car plist))) - (setq p (plist-put p (car plist) (nth 1 plist)))) - (setq plist (cddr plist))) - p)) - (defun org-force-self-insert (N) "Needed to enforce self-insert under remapping." (interactive "p") @@ -18021,6 +18779,17 @@ When LINE is given, assume it represents a line and compute its indentation." (skip-chars-forward " \t") (current-column)))) +(defun org-get-string-indentation (s) + "What indentation has S due to SPACE and TAB at the beginning of the string?" + (let ((n -1) (i 0) (w tab-width) c) + (catch 'exit + (while (< (setq n (1+ n)) (length s)) + (setq c (aref s n)) + (cond ((= c ?\ ) (setq i (1+ i))) + ((= c ?\t) (setq i (* (/ (+ w i) w) w))) + (t (throw 'exit t))))) + i)) + (defun org-remove-tabs (s &optional width) "Replace tabulators in S with spaces. Assumes that s is a single line, starting in column 0." @@ -18301,11 +19070,11 @@ really on, so that the block visually is on the match." (defun org-in-regexps-block-p (start-re end-re &optional bound) "Return t if the current point is between matches of START-RE and END-RE. This will also return t if point is on one of the two matches or -in an unfinished block. END-RE can be a string or a form +in an unfinished block. END-RE can be a string or a form returning a string. -An optional third argument bounds the search for START-RE. -It defaults to previous heading or `point-min'." +An optional third argument bounds the search for START-RE. It +defaults to previous heading or `point-min'." (let ((pos (point)) (limit (or bound (save-excursion (outline-previous-heading))))) (save-excursion @@ -18316,6 +19085,22 @@ It defaults to previous heading or `point-min'." ;; ... but no end-re between start-re and point. (not (re-search-forward (eval end-re) pos t))))))) +(defun org-in-block-p (names) + "Is point inside any block whose name belongs to NAMES? + +NAMES is a list of strings containing names of blocks." + (save-match-data + (catch 'exit + (let ((case-fold-search t)) + (mapc (lambda (name) + (let ((n (regexp-quote name))) + (when (org-in-regexps-block-p + (concat "^[ \t]*#\\+begin_" n) + (concat "^[ \t]*#\\+end_" n)) + (throw 'exit t)))) + names)) + nil))) + (defun org-occur-in-agenda-files (regexp &optional nlines) "Call `multi-occur' with buffers for all agenda files." (interactive "sOrg-files matching: \np") @@ -18414,7 +19199,9 @@ Taken from `count' in cl-seq.el with all keyword arguments removed." "Move backwards over whitespace, to the beginning of the first empty line. Returns the number of empty lines passed." (let ((pos (point))) - (skip-chars-backward " \t\n\r") + (if (cdr (assoc 'heading org-blank-before-new-entry)) + (skip-chars-backward " \t\n\r") + (forward-line -1)) (beginning-of-line 2) (goto-char (min (point) pos)) (count-lines (point) pos))) @@ -18594,8 +19381,7 @@ If point is in an inline task, mark that task instead." (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)))) + (t (org-with-limited-levels (outline-previous-visible-heading 1)))) (setq beg (point)) ;; Get end of it (if inline-task-p @@ -18617,16 +19403,28 @@ If point is in an inline task, mark that task instead." (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) + (inline-re (and inline-task-p + (org-inlinetask-outline-regexp))) + column) (beginning-of-line 1) (cond ;; Comments ((looking-at "# ") (setq column 0)) ;; Headings - ((looking-at "\\*+ ") (setq column 0)) + ((looking-at org-outline-regexp) (setq column 0)) + ;; Included files + ((looking-at "#\\+include:") (setq column 0)) + ;; Footnote definition + ((looking-at org-footnote-definition-re) (setq column 0)) ;; Literal examples ((looking-at "[ \t]*:[ \t]") (setq column (org-get-indentation))) ; do nothing + ;; Lists + ((ignore-errors (goto-char (org-in-item-p))) + (setq column (if itemp + (org-get-indentation) + (org-list-item-body-column (point)))) + (goto-char pos)) ;; Drawers ((and (looking-at "[ \t]*:END:") (save-excursion (re-search-backward org-drawer-regexp nil t))) @@ -18648,31 +19446,27 @@ If point is in an inline task, mark that task instead." ;; src blocks: let `org-edit-src-exit' handle them (org-get-indentation) (org-get-indentation (match-string 0))))) - ;; Lists - ((org-in-item-p) - (org-beginning-of-item) - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\(:?\\[@\\(:?start:\\)?[0-9]+\\][ \t]*\\)?\\[[- X]\\][ \t]*\\|.*? :: \\)?") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column))) - (if (> tcol (+ bcol org-description-max-indent)) - (setq tcol (+ bcol 5))) - (goto-char pos) - (setq column (if itemp (org-get-indentation) tcol))) ;; This line has nothing special, look at the previous relevant ;; line to compute indentation (t (beginning-of-line 0) (while (and (not (bobp)) (not (looking-at org-drawer-regexp)) - ;; skip comments, verbatim, empty lines, tables, - ;; inline tasks, lists, drawers and blocks + ;; When point started in an inline task, do not move + ;; above task starting line. + (not (and inline-task-p (looking-at inline-re))) + ;; Skip drawers, blocks, empty lines, verbatim, + ;; comments, tables, footnotes definitions, lists, + ;; inline tasks. (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))) + (looking-at org-footnote-definition-re) + (and (ignore-errors (goto-char (org-in-item-p))) + (goto-char + (org-list-get-top-point (org-list-struct)))) (and (not inline-task-p) (featurep 'org-inlinetask) (org-inlinetask-in-task-p) @@ -18726,9 +19520,9 @@ the functionality can be provided as a fall-back.") (concat "\f" "\\|" "[ ]*$" "\\|" - "\\*+ " "\\|" + org-outline-regexp "\\|" "[ \t]*#" "\\|" - "[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)" "\\|" + (org-item-re) "\\|" "[ \t]*[:|]" "\\|" "\\$\\$" "\\|" "\\\\\\(begin\\|end\\|[][]\\)")) @@ -18736,7 +19530,8 @@ the functionality can be provided as a fall-back.") ;; But only if the user has not turned off tables or fixed-width regions (org-set-local 'auto-fill-inhibit-regexp - (concat "\\*+ \\|#\\+" + (concat org-outline-regexp + "\\|#\\+" "\\|[ \t]*" org-keyword-time-regexp (if (or org-enable-table-editor org-enable-fixed-width-editor) (concat @@ -18748,12 +19543,18 @@ the functionality can be provided as a fall-back.") ;; and fixed-width regions are not wrapped. That function will pass ;; through to `fill-paragraph' when appropriate. (org-set-local 'fill-paragraph-function 'org-fill-paragraph) + ;; Prevent auto-fill from inserting unwanted new items. + (org-set-local 'fill-nobreak-predicate + (if (memq 'org-fill-item-nobreak-p fill-nobreak-predicate) + fill-nobreak-predicate + (cons 'org-fill-item-nobreak-p fill-nobreak-predicate))) ;; Adaptive filling: To get full control, first make sure that ;; `adaptive-fill-regexp' never matches. Then install our own matcher. (unless (local-variable-p 'adaptive-fill-regexp (current-buffer)) (org-set-local 'org-adaptive-fill-regexp-backup adaptive-fill-regexp)) (org-set-local 'adaptive-fill-regexp "\000") + (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) (org-set-local @@ -18762,45 +19563,121 @@ the functionality can be provided as a fall-back.") (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") (modes . '(org-mode)))))) +(defun org-fill-item-nobreak-p () + "Non-nil when a line break at point would insert a new item." + (and (looking-at (org-item-re)) (org-list-in-valid-context-p))) + (defun org-fill-paragraph (&optional justify) "Re-align a table, pass through to fill-paragraph if no table." (let ((table-p (org-at-table-p)) - (table.el-p (org-at-table.el-p))) + (table.el-p (org-at-table.el-p)) + (itemp (org-in-item-p))) (cond ((and (equal (char-after (point-at-bol)) ?*) (save-excursion (goto-char (point-at-bol)) - (looking-at outline-regexp))) - t) ; skip headlines - (table.el-p t) ; skip table.el tables - (table-p (org-table-align) t) ; align org-mode tables - (t nil)))) ; call paragraph-fill + (looking-at org-outline-regexp))) + t) ; skip headlines + (table.el-p t) ; skip table.el tables + (table-p (org-table-align) t) ; align Org tables + (itemp ; align text in items + (let* ((struct (save-excursion (goto-char itemp) + (org-list-struct))) + (parents (org-list-parents-alist struct)) + (children (org-list-get-children itemp struct parents)) + beg end prev next prefix) + ;; Determine in which part of item point is: before + ;; first child, after last child, between two + ;; sub-lists, or simply in item if there's no child. + (cond + ((not children) + (setq prefix (make-string (org-list-item-body-column itemp) ?\ ) + beg itemp + end (org-list-get-item-end itemp struct))) + ((< (point) (setq next (car children))) + (setq prefix (make-string (org-list-item-body-column itemp) ?\ ) + beg itemp + end next)) + ((> (point) (setq prev (car (last children)))) + (setq beg (org-list-get-item-end prev struct) + end (org-list-get-item-end itemp struct) + prefix (save-excursion + (goto-char beg) + (skip-chars-forward " \t") + (make-string (current-column) ?\ )))) + (t (catch 'exit + (while (setq next (pop children)) + (if (> (point) next) + (setq prev next) + (setq beg (org-list-get-item-end prev struct) + end next + prefix (save-excursion + (goto-char beg) + (skip-chars-forward " \t") + (make-string (current-column) ?\ ))) + (throw 'exit nil)))))) + ;; Use `fill-paragraph' with buffer narrowed to item + ;; without any child, and with our computed PREFIX. + (flet ((fill-context-prefix (from to &optional flr) prefix)) + (save-restriction + (narrow-to-region beg end) + (save-excursion (fill-paragraph justify)))) t)) + ;; Special case where point is not in a list but is on + ;; a paragraph adjacent to a list: make sure this paragraph + ;; doesn't get merged with the end of the list by narrowing + ;; buffer first. + ((save-excursion (forward-paragraph -1) + (setq itemp (org-in-item-p))) + (let ((struct (save-excursion (goto-char itemp) + (org-list-struct)))) + (save-restriction + (narrow-to-region (org-list-get-bottom-point struct) + (save-excursion (forward-paragraph 1) + (point))) + (fill-paragraph justify) t))) + ;; Else simply call `fill-paragraph'. + (t nil)))) ;; For reference, this is the default value of adaptive-fill-regexp ;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" (defun org-adaptive-fill-function () - "Return a fill prefix for org-mode files. -In particular, this makes sure hanging paragraphs for hand-formatted lists -work correctly." - (cond - ;; Comment line - ((looking-at "#[ \t]+") - (match-string-no-properties 0)) - ;; Description list - ((looking-at "[ \t]*\\([-*+] .*? :: \\)") - (save-excursion - (if (> (match-end 1) (+ (match-beginning 1) - org-description-max-indent)) - (goto-char (+ (match-beginning 1) 5)) - (goto-char (match-end 0))) - (make-string (current-column) ?\ ))) - ;; Ordered or unordered list - ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] ?\\)") - (save-excursion - (goto-char (match-end 0)) - (make-string (current-column) ?\ ))) - ;; Other text - ((looking-at org-adaptive-fill-regexp-backup) - (match-string-no-properties 0)))) + "Return a fill prefix for org-mode files." + (let (itemp) + (save-excursion + (cond + ;; Comment line + ((looking-at "#[ \t]+") + (match-string-no-properties 0)) + ;; Plain list item + ((org-at-item-p) + (make-string (org-list-item-body-column (point-at-bol)) ?\ )) + ;; Point is in a list after `backward-paragraph': original + ;; point wasn't in the list, or filling would have been taken + ;; care of by `org-auto-fill-function', but the list and the + ;; real paragraph are not separated by a blank line. Thus, move + ;; point after the list to go back to real paragraph and + ;; determine fill-prefix. + ((setq itemp (org-in-item-p)) + (goto-char itemp) + (let* ((struct (org-list-struct)) + (bottom (org-list-get-bottom-point struct))) + (goto-char bottom) + (make-string (org-get-indentation) ?\ ))) + ;; Other text + ((looking-at org-adaptive-fill-regexp-backup) + (match-string-no-properties 0)))))) + +(defun org-auto-fill-function () + "Auto-fill function." + (let (itemp prefix) + ;; When in a list, compute an appropriate fill-prefix and make + ;; sure it will be used by `do-auto-fill'. + (if (setq itemp (org-in-item-p)) + (progn + (setq prefix (make-string (org-list-item-body-column itemp) ?\ )) + (flet ((fill-context-prefix (from to &optional flr) prefix)) + (do-auto-fill))) + ;; Else just use `do-auto-fill'. + (do-auto-fill)))) ;;; Other stuff. @@ -18841,10 +19718,10 @@ this line is also exported in fixed-width font." (forward-line 1))) (save-excursion (org-back-to-heading) - (if (looking-at (concat outline-regexp + (if (looking-at (concat org-outline-regexp "\\( *\\<" org-quote-string "\\>[ \t]*\\)")) (replace-match "" t t nil 1) - (if (looking-at outline-regexp) + (if (looking-at org-outline-regexp) (progn (goto-char (match-end 0)) (insert org-quote-string " ")))))))) @@ -18923,12 +19800,12 @@ beyond the end of the headline." ((org-at-item-p) (goto-char (if (eq special t) - (cond ((> pos (match-end 4)) (match-end 4)) - ((= pos (point)) (match-end 4)) + (cond ((> pos (match-end 0)) (match-end 0)) + ((= pos (point)) (match-end 0)) (t (point))) (cond ((> pos (point)) (point)) ((not (eq last-command this-command)) (point)) - (t (match-end 4)))))))) + (t (match-end 0)))))))) (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t))))) @@ -19041,7 +19918,7 @@ plainly yank the text as it is. "Perform some yank-like command. This function implements the behavior described in the `org-yank' -documentation. However, it has been generalized to work for any +documentation. However, it has been generalized to work for any interactive command with similar behavior." ;; pretend to be command COMMAND @@ -19071,17 +19948,18 @@ interactive command with similar behavior." (when (and (bolp) subtreep (not (setq swallowp (org-yank-folding-would-swallow-text beg end)))) - (or (looking-at outline-regexp) - (re-search-forward (concat "^" outline-regexp) end t)) - (while (and (< (point) end) (looking-at outline-regexp)) - (hide-subtree) - (org-cycle-show-empty-lines 'folded) - (condition-case nil - (outline-forward-same-level 1) - (error (goto-char end))))) + (org-with-limited-levels + (or (looking-at org-outline-regexp) + (re-search-forward org-outline-regexp-bol end t)) + (while (and (< (point) end) (looking-at org-outline-regexp)) + (hide-subtree) + (org-cycle-show-empty-lines 'folded) + (condition-case nil + (outline-forward-same-level 1) + (error (goto-char end)))))) (when swallowp (message - "Inserted text not folded because that would swallow text")) + "Inserted text not folded because that would swallow text")) (goto-char end) (skip-chars-forward " \t\n\r") @@ -19097,28 +19975,22 @@ interactive command with similar behavior." (defun org-yank-folding-would-swallow-text (beg end) "Would hide-subtree at BEG swallow any text after END?" (let (level) - (save-excursion - (goto-char beg) - (when (or (looking-at outline-regexp) - (re-search-forward (concat "^" outline-regexp) end t)) - (setq level (org-outline-level))) - (goto-char end) - (skip-chars-forward " \t\r\n\v\f") - (if (or (eobp) - (and (bolp) (looking-at org-outline-regexp) - (<= (org-outline-level) level))) - nil ; Nothing would be swallowed - t)))) ; something would swallow + (org-with-limited-levels + (save-excursion + (goto-char beg) + (when (or (looking-at org-outline-regexp) + (re-search-forward org-outline-regexp-bol end t)) + (setq level (org-outline-level))) + (goto-char end) + (skip-chars-forward " \t\r\n\v\f") + (if (or (eobp) + (and (bolp) (looking-at org-outline-regexp) + (<= (org-outline-level) level))) + nil ; Nothing would be swallowed + t))))) ; something would swallow (define-key org-mode-map "\C-y" 'org-yank) -(defun org-invisible-p () - "Check if point is at a character currently not visible." - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible))) - (defun org-truely-invisible-p () "Check if point is at a character currently not visible. This version does not only check the character property, but also @@ -19126,18 +19998,14 @@ This version does not only check the character property, but also ;; Early versions of noutline don't have `outline-invisible-p'. (if (org-bound-and-true-p visible-mode) nil - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible)))) + (outline-invisible-p))) (defun org-invisible-p2 () "Check if point is at a character currently not visible." (save-excursion (if (and (eolp) (not (bobp))) (backward-char 1)) ;; Early versions of noutline don't have `outline-invisible-p'. - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible)))) + (outline-invisible-p))) (defun org-back-to-heading (&optional invisible-ok) "Call `outline-back-to-heading', but provide a better error message." @@ -19156,7 +20024,8 @@ This version does not only check the character property, but also (defun org-before-first-heading-p () "Before first heading?" (save-excursion - (null (re-search-backward "^\\*+ " nil t)))) + (end-of-line) + (null (re-search-backward org-outline-regexp-bol nil t)))) (defun org-on-heading-p (&optional ignored) (outline-on-heading-p t)) @@ -19170,8 +20039,9 @@ empty." (and (looking-at "[ \t]*$") (save-excursion (beginning-of-line 1) - (looking-at (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp - "\\)?[ \t]*$"))))) + (let ((case-fold-search nil)) + (looking-at (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp + "\\)?[ \t]*$")))))) (defun org-at-heading-or-item-p () (or (org-on-heading-p) (org-at-item-p))) @@ -19207,7 +20077,7 @@ make a significant difference in outlines with very many siblings." (defun org-first-sibling-p () "Is this heading the first child of its parents?" (interactive) - (let ((re (concat "^" outline-regexp)) + (let ((re org-outline-regexp-bol) level l) (unless (org-at-heading-p t) (error "Not at a heading")) @@ -19225,7 +20095,7 @@ when a sibling was found. When none is found, return nil and don't move point." (let ((fun (if previous 're-search-backward 're-search-forward)) (pos (point)) - (re (concat "^" outline-regexp)) + (re org-outline-regexp-bol) level l) (when (condition-case nil (org-back-to-heading t) (error nil)) (setq level (funcall outline-level)) @@ -19248,9 +20118,9 @@ move point." (defun org-goto-first-child () "Goto the first child, even if it is invisible. -Return t when a child was found. Otherwise don't move point and +Return t when a child was found. Otherwise don't move point and return nil." - (let (level (pos (point)) (re (concat "^" outline-regexp))) + (let (level (pos (point)) (re org-outline-regexp-bol)) (when (condition-case nil (org-back-to-heading t) (error nil)) (setq level (outline-level)) (forward-char 1) @@ -19341,12 +20211,31 @@ If there is no such heading, return nil." (defadvice outline-end-of-subtree (around prefer-org-version activate compile) "Use Org version in org-mode, for dramatic speed-up." - (if (eq major-mode 'org-mode) + (if (org-mode-p) (progn (org-end-of-subtree nil t) (unless (eobp) (backward-char 1))) ad-do-it)) +(defun org-end-of-meta-data-and-drawers () + "Jump to the first text after meta data and drawers in the current entry. +This will move over empty lines, lines with planning time stamps, +clocking lines, and drawers." + (org-back-to-heading t) + (let ((end (save-excursion (outline-next-heading) (point))) + (re (concat "\\(" org-drawer-regexp "\\)" + "\\|" "[ \t]*" org-keyword-time-regexp))) + (forward-line 1) + (while (re-search-forward re end t) + (if (not (match-end 1)) + ;; empty or planning line + (forward-line 1) + ;; a drawer, find the end + (re-search-forward "^[ \t]*:END:" end 'move) + (forward-line 1))) + (and (re-search-forward "[^\n]" nil t) (backward-char 1)) + (point))) + (defun org-forward-same-level (arg &optional invisible-ok) "Move forward to the arg'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. @@ -19364,7 +20253,7 @@ it wil also look at invisible ones." (setq l (- (match-end 0) (match-beginning 0) 1)) (= l level) (not invisible-ok) - (progn (backward-char 1) (org-invisible-p))) + (progn (backward-char 1) (outline-invisible-p))) (if (< l level) (setq arg 1))) (setq arg (1- arg))) (beginning-of-line 1))) @@ -19383,7 +20272,7 @@ Stop at the first and last subheadings of a superior heading." (setq l (- (match-end 0) (match-beginning 0) 1)) (= l level) (not invisible-ok) - (org-invisible-p)) + (outline-invisible-p)) (if (< l level) (setq arg 1))) (setq arg (1- arg))))) @@ -19407,7 +20296,7 @@ Show the heading too, if it is currently invisible." (max (point-min) (1- (point))) (save-excursion (if (re-search-forward - (concat "[\r\n]\\(" outline-regexp "\\)") nil t) + (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) (match-beginning 1) (point-max))) nil) @@ -19467,7 +20356,7 @@ Show the heading too, if it is currently invisible." (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) (setq org-imenu-markers nil) (let* ((n org-imenu-depth) - (re (concat "^" outline-regexp)) + (re (concat "^" (org-get-limited-outline-regexp))) (subs (make-vector (1+ n) nil)) (last-level 0) m level head) @@ -19494,7 +20383,7 @@ Show the heading too, if it is currently invisible." '(progn (add-hook 'imenu-after-jump-hook (lambda () - (if (eq major-mode 'org-mode) + (if (org-mode-p) (org-show-context 'org-goto)))))) (defun org-link-display-format (link) @@ -19567,9 +20456,15 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." ;; Make flyspell not check words in links, to not mess up our keymap (defun org-mode-flyspell-verify () - "Don't let flyspell put overlays at active buttons." - (and (not (get-text-property (max (1- (point)) (point-min)) 'keymap)) - (not (get-text-property (max (1- (point)) (point-min)) 'org-no-flyspell)))) + "Don't let flyspell put overlays at active buttons, or on + {todo,all-time,additional-option-like}-keywords." + (let ((pos (max (1- (point)) (point-min))) + (word (thing-at-point 'word))) + (and (not (get-text-property pos 'keymap)) + (not (get-text-property pos 'org-no-flyspell)) + (not (member word org-todo-keywords-1)) + (not (member word org-all-time-keywords)) + (not (member word org-additional-option-like-keywords))))) (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region." @@ -19598,15 +20493,15 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (eval-after-load "ecb" '(defadvice ecb-method-clicked (after esf/org-show-context activate) "Make hierarchy visible when jumping into location from ECB tree buffer." - (if (eq major-mode 'org-mode) + (if (org-mode-p) (org-show-context)))) (defun org-bookmark-jump-unhide () "Unhide the current position, to show the bookmark location." (and (org-mode-p) - (or (org-invisible-p) + (or (outline-invisible-p) (save-excursion (goto-char (max (point-min) (1- (point)))) - (org-invisible-p))) + (outline-invisible-p))) (org-show-context 'bookmark-jump))) ;; Make session.el ignore our circular variable @@ -19642,5 +20537,6 @@ Still experimental, may disappear in the future." (run-hooks 'org-load-hook) +;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here |