Mercurial > emacs
changeset 100448:cea079b68b76
2008-12-16 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-refile): Avoid refiling to within the region to be
refiled.
* org-export-latex.el (org-export-latex-special-chars): Replace
special characters also in tables.
* org-agenda.el (org-agenda-change-all-lines): New argument
FORCE-TAGS.
(org-agenda-set-tags): Cet the new tags and pas them to
`org-format-agenda-item'.
2008-12-16 Carsten Dominik <carsten.dominik@gmail.com>
* org-export-latex.el (org-export-latex-classes): Add longable as
a default package to all classes.
(org-export-latex-tables): Handle the longtable attribute and the
align attribute.
* org-table.el (orgtbl-to-generic): Handle tables that start with
a hline.
* org-export-latex.el (org-export-latex-emphasis-alist): Switch to
\verb for colde-like snippets.
(org-export-as-latex): Fix issues with region export.
* org.el (org-up-heading-safe): Speed up function by using a
direct regexp search.
(org-olpa): New variable.
(org-get-outline-path): Speed-up path constructions in cases where
this is possible because the entire hierarchy is scanned anyway.
(org-refile-get-location): Don't compare the truenames of files,
this is too slow.
(org-goto-max-level): New option.
(org-goto): Use `org-goto-max-level'.
2008-12-16 Tassilo Horn <tassilo@member.fsf.org>
* org-gnus.el (org-gnus-article-link, org-gnus-article-link):
Strip angle brackets from message-ids in the former and don't do
it in the latter.
(org-gnus-follow-link): Open summary reliable, even if the last
messages were deleted, and handle empty groups, too.
2008-12-16 Carsten Dominik <carsten.dominik@gmail.com>
* org-export-latex.el (org-export-latex-emphasis-alist): Use \verb
instead of \texttt for the =...= and ~===~ emphasis environments.
(org-export-as-latex): Remove any old :org-license-to-kill text
properties.
(org-export-as-latex): Pass RBEG to `org-export-latex-first-lines'.
(org-export-latex-make-header): Add some hard space after the
table of contents.
(org-export-latex-first-lines): Accept RBEG argument. Mark
exported text so that it will be excuded in further steps.
* org-table.el (org-table-get-specials): Make @0 reference the
last line in a table.
(org-table-recalculate): Improve docstring.
2008-12-16 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-log-done): Fix docstring.
2008-12-16 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-html-format-image): Fix bugs.
* org-export-latex.el (org-export-latex-tables)
(org-export-latex-links): Implement attribute, label, and caption
handling.
* org-exp.el (org-export-html-style-default): Add style
definitions for the figure div.
(org-export-preprocess-string, org-export-as-html): Implement
attribute, label, and caption handling.
(org-export-attach-captions-and-attributes): New function.
(org-export-html-format-image): New function.
(org-format-org-table-html): Implement attribute, label, and
caption handling.
* org.el (org-find-text-property-in-string): New function.
(org-extract-attributes): Use the property org-attr instead of
org-attrobutes, because this property is now set with the #+ATTR
lines.
2008-12-16 Carsten Dominik <carsten.dominik@gmail.com>
* org-compat.el (org-substring-no-properties): Fix for XEmacs, for
the case that FROM is nil.
* org.el (org-before-first-heading-p): New function.
2008-12-16 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-as-html): Do not add a space before
enforces line breaks.
(org-export-as-html): Close paragraph before blockquote and verse
tags.
2008-12-16 Carsten Dominik <carsten.dominik@gmail.com>
* org-id.el (org-id-locations-file): Wrap file name with
`convert-standard-filename'.
(org-id-files): New variable.
(org-id-use-hash): New option.
(org-id-update-id-locations): Also search in all files current
listed in `org-id-files'. Convert the resulting alist to a hash
if the user customation says so.
(org-id-locations-save): Handle he case if `org-id-locations' is a
hash.
(org-id-locations-load): Convert the alist to a hash.
(org-id-add-location): Handle the hast case.
(kill-emacs-hook): Make sure id locations are saved when Emacs is
exited.
(org-id-hash-to-alist, org-id-alist-to-hash)
(org-id-paste-tracker): New functions.
| author | Carsten Dominik <dominik@science.uva.nl> |
|---|---|
| date | Tue, 16 Dec 2008 13:28:37 +0000 |
| parents | f84c0729a0e9 |
| children | 7a96b720c8c6 |
| files | lisp/org/org-agenda.el lisp/org/org-archive.el lisp/org/org-attach.el lisp/org/org-bbdb.el lisp/org/org-bibtex.el lisp/org/org-clock.el lisp/org/org-colview.el lisp/org/org-compat.el lisp/org/org-exp.el lisp/org/org-export-latex.el lisp/org/org-faces.el lisp/org/org-gnus.el lisp/org/org-id.el lisp/org/org-info.el lisp/org/org-irc.el lisp/org/org-jsinfo.el lisp/org/org-list.el lisp/org/org-mac-message.el lisp/org/org-macs.el lisp/org/org-mew.el lisp/org/org-mhe.el lisp/org/org-mouse.el lisp/org/org-plot.el lisp/org/org-publish.el lisp/org/org-remember.el lisp/org/org-rmail.el lisp/org/org-table.el lisp/org/org-timer.el lisp/org/org-vm.el lisp/org/org-w3m.el lisp/org/org-wl.el lisp/org/org.el |
| diffstat | 32 files changed, 705 insertions(+), 280 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/org/org-agenda.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-agenda.el Tue Dec 16 13:28:37 2008 +0000 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;; @@ -5067,13 +5067,17 @@ (org-flag-heading nil))) ; show the next heading (org-add-note)))) -(defun org-agenda-change-all-lines (newhead hdmarker &optional fixface just-this) +(defun org-agenda-change-all-lines (newhead hdmarker + &optional fixface just-this + force-tags) "Change all lines in the agenda buffer which match HDMARKER. The new content of the line will be NEWHEAD (as modified by `org-format-agenda-item'). HDMARKER is checked with `equal' against all `org-hd-marker' text properties in the file. If FIXFACE is non-nil, the face of each item is modified acording to -the new TODO state." +the new TODO state. +If JUST-THIS is non-nil, change just the current line, not all. +If FORCE-TAGS is non nil, the car of it ar the new tags." (let* ((inhibit-read-only t) (line (org-current-line)) props m pl undone-face done-face finish new dotime cat tags) @@ -5088,7 +5092,9 @@ (setq props (text-properties-at (point)) dotime (get-text-property (point) 'dotime) cat (get-text-property (point) 'org-category) - tags (get-text-property (point) 'tags) + tags (if force-tags + (car force-tags) + (get-text-property (point) 'tags)) new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix) pl (get-text-property (point) 'prefix-length) undone-face (get-text-property (point) 'undone-face) @@ -5191,7 +5197,7 @@ (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) (inhibit-read-only t) - newhead) + newhead tags) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -5203,9 +5209,10 @@ (org-flag-heading nil))) ; show the next heading (goto-char pos) (call-interactively 'org-set-tags) + (setq tags (org-get-tags-at)) (end-of-line 1) (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker) + (org-agenda-change-all-lines newhead hdmarker nil nil (list tags)) (beginning-of-line 1))))) (defun org-agenda-toggle-archive-tag () @@ -5627,6 +5634,7 @@ (time-to-days (current-time)))) (files (org-agenda-files 'unrestricted)) entries file) ;; Get all entries which may contain an appt + (org-prepare-agenda-buffers files) (while (setq file (pop files)) (setq entries (append entries
--- a/lisp/org/org-archive.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-archive.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-attach.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-attach.el Tue Dec 16 13:28:37 2008 +0000 @@ -4,7 +4,7 @@ ;; Author: John Wiegley <johnw@newartisans.com> ;; Keywords: org data task -;; Version: 6.14 +;; Version: 6.15a ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-bbdb.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-bbdb.el Tue Dec 16 13:28:37 2008 +0000 @@ -6,7 +6,7 @@ ;; Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-bibtex.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-bibtex.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Bastien Guerry <bzg at altern dot org> ;; Carsten Dominik <carsten dot dominik at gmail dot com> ;; Keywords: org, wp, remember -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-clock.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-clock.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;; @@ -118,7 +118,8 @@ (const :tag "Clock and history" t) (const :tag "No persistence" nil))) -(defcustom org-clock-persist-file "~/.emacs.d/org-clock-save.el" +(defcustom org-clock-persist-file (convert-standard-filename + "~/.emacs.d/org-clock-save.el") "File to save clock data to" :group 'org-clock :type 'string)
--- a/lisp/org/org-colview.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-colview.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-compat.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-compat.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;; @@ -284,7 +284,7 @@ (defun org-substring-no-properties (string &optional from to) (if (featurep 'xemacs) - (org-no-properties (substring string from to)) + (org-no-properties (substring string (or from 0) to)) (substring-no-properties string from to))) (provide 'org-compat)
--- a/lisp/org/org-exp.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-exp.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;; @@ -545,7 +545,8 @@ table { border-collapse: collapse; } td, th { vertical-align: top; } dt { font-weight: bold; } - + div.figure { padding: 0.5em; } + div.figure p { text-align: center; } .org-info-js_info-navigation { border-style:none; } #org-info-js_console-label { font-size:10px; font-weight:bold; white-space:nowrap; } @@ -1432,6 +1433,8 @@ (let* ((htmlp (plist-get parameters :for-html)) (asciip (plist-get parameters :for-ascii)) (latexp (plist-get parameters :for-LaTeX)) + (backend (cond (htmlp 'html) (latexp 'latex) (asciip 'ascii))) + (archived-trees (plist-get parameters :archived-trees)) (inhibit-read-only t) (drawers org-drawers) @@ -1465,6 +1468,9 @@ ;; Handle source code snippets (org-export-replace-src-segments) + + ;; Find all headings and compute the targets for them + (setq target-alist (org-export-define-heading-targets target-alist)) ;; Get rid of drawers (org-export-remove-or-extract-drawers drawers @@ -1487,9 +1493,6 @@ ;; Remove todo-keywords before exporting, if the user has requested so (org-export-remove-headline-metadata parameters) - ;; Find all headings and compute the targets for them - (setq target-alist (org-export-define-heading-targets target-alist)) - ;; Find targets in comments and move them out of comments, ;; but mark them as targets that should be invisible (setq target-alist (org-export-handle-invisible-targets target-alist)) @@ -1498,8 +1501,7 @@ (org-export-protect-examples (if asciip 'indent nil)) ;; Protect backend specific stuff, throw away the others. - (org-export-select-backend-specific-text - (cond (htmlp 'html) (latexp 'latex) (asciip 'ascii))) + (org-export-select-backend-specific-text backend) ;; Protect quoted subtrees (org-export-protect-quoted-subtrees) @@ -1510,10 +1512,13 @@ ;; Blockquotes and verse (org-export-mark-blockquote-and-verse) + ;; Attach captions to the correct opject + (setq target-alist (org-export-attach-captions-and-attributes + backend target-alist)) + ;; Remove comment environment and comment subtrees (org-export-remove-comment-blocks-and-subtrees) - ;; Find matches for radio targets and turn them into internal links (org-export-mark-radio-links) @@ -1571,18 +1576,22 @@ The new targets are added to TARGET-ALIST, which is also returned." (goto-char (point-min)) (org-init-section-numbers) - (let ((re (concat "^" org-outline-regexp)) + (let ((re (concat "^" org-outline-regexp + "\\| [ \t]*:ID:[ \t]*\\([^ \t\r\n]+\\)")) level target) (while (re-search-forward re nil t) - (setq level (org-reduced-level - (save-excursion (goto-char (point-at-bol)) - (org-outline-level)))) - (setq target (org-solidify-link-text - (format "sec-%s" (org-section-number level)))) - (push (cons target target) target-alist) - (add-text-properties - (point-at-bol) (point-at-eol) - (list 'target target)))) + (if (match-end 1) + (push (cons (org-match-string-no-properties 1) + target) target-alist) + (setq level (org-reduced-level + (save-excursion (goto-char (point-at-bol)) + (org-outline-level)))) + (setq target (org-solidify-link-text + (format "sec-%s" (org-section-number level)))) + (push (cons target target) target-alist) + (add-text-properties + (point-at-bol) (point-at-eol) + (list 'target target))))) target-alist) (defun org-export-handle-invisible-targets (target-alist) @@ -1611,9 +1620,11 @@ target-alist) (defun org-export-target-internal-links (target-alist) - "Find all internal links and assign target to them. + "Find all internal links and assign targets to them. If a link has a fuzzy match (i.e. not a *dedicated* target match), -let the link point to the corresponding section." +let the link point to the corresponding section. +This function also handles the id links, if they have a match in +the current file." (goto-char (point-min)) (while (re-search-forward org-bracket-link-regexp nil t) (org-if-unprotected @@ -1625,6 +1636,8 @@ (target (cond ((cdr (assoc slink target-alist))) + ((and (string-match "^id:" link) + (cdr (assoc (substring link 3) target-alist)))) ((string-match org-link-types-re link) nil) ((or (file-name-absolute-p link) (string-match "^\\." link)) @@ -1748,17 +1761,15 @@ (todo (plist-get opts :todo-keywords)) (tags (plist-get opts :tags)) (pri (plist-get opts :priority)) - rpl) + (elts '(1 2 3 4 5)) + rpl props) + (setq elts (delq nil (list 1 (if todo 2) (if pri 3) 4 (if tags 5)))) (when (or (not todo) (not tags) (not pri)) - ;; OK, something needs to be removed - (setq rpl (concat "\\1" - (if todo " \\2" "") - (if pri " \\3" "") - " \\4" - (if tags " \\5" ""))) (goto-char (point-min)) (while (re-search-forward re nil t) - (replace-match rpl t nil))))) + (setq rpl (mapconcat (lambda (i) (if (match-end i) (match-string i) "")) + elts " ")) + (replace-match rpl t t))))) (defun org-export-protect-quoted-subtrees () "Mark quoted subtrees with the protection property." @@ -1838,6 +1849,41 @@ "ORG-VERSE-END" "ORG-VERSE-START") t t))) +(defun org-export-attach-captions-and-attributes (backend target-alist) + "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. +If the next thing following is a table, add the text properties to the first +table line. If it is a link, add it to the line containing the link." + (goto-char (point-min)) + (remove-text-properties (point-min) (point-max) + '(org-caption nil org-attributes nil)) + (let ((case-fold-search t) + (re (concat "^#\\+caption:[ \t]+\\(.*\\)" + "\\|" + "^#\\+attr_" (symbol-name backend) ":[ \t]+\\(.*\\)" + "\\|" + "^#\\+label:[ \t]+\\(.*\\)" + "\\|" + "^[ \t]*|[^-]" + "\\|" + "^[ \t]*\\[\\[.*\\]\\][ \t]*$")) + cap attr label) + (while (re-search-forward re nil t) + (cond + ((match-end 1) + (setq cap (concat cap (if cap " " "") (org-trim (match-string 1))))) + ((match-end 2) + (setq attr (concat attr (if attr " " "") (org-trim (match-string 2))))) + ((match-end 3) + (setq label (org-trim (match-string 3)))) + (t + (add-text-properties (point-at-bol) (point-at-eol) + (list 'org-caption cap + 'org-attributes attr + 'org-label label)) + (if label (push (cons label label) target-alist)) + (setq cap nil attr nil label nil))))) + target-alist) + (defun org-export-remove-comment-blocks-and-subtrees () "Remove the comment environment, and also commented subtrees." (let ((re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>")) @@ -3206,12 +3252,14 @@ ;; Blockquotes and verse (when (equal "ORG-BLOCKQUOTE-START" line) + (org-close-par-maybe) (insert "<blockquote>\n<p>\n") (throw 'nextline nil)) (when (equal "ORG-BLOCKQUOTE-END" line) (insert "</p>\n</blockquote>\n") (throw 'nextline nil)) (when (equal "ORG-VERSE-START" line) + (org-close-par-maybe) (insert "\n<p class=\"verse\">\n") (setq inverse t) (throw 'nextline nil)) @@ -3225,7 +3273,7 @@ (setq line (concat (mapconcat 'identity (make-list (* 2 i) "\\nbsp") "") " " (org-trim line)))) - (setq line (concat line " \\\\")))) + (setq line (concat line "\\\\")))) ;; make targets to anchors (while (string-match "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line) @@ -3271,9 +3319,8 @@ (string-match "^\\.\\.?/" path))) "file") (t "internal"))) - (setq path (org-extract-attributes path)) - (setq attr (org-attributes-to-string - (get-text-property 0 'org-attributes path))) + (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))) @@ -3302,10 +3349,8 @@ (if (and (or (eq t org-export-html-inline-images) (and org-export-html-inline-images (not descp))) (org-file-image-p path)) - (setq rpl (concat "<img src=\"" type ":" path "\"" - (if (string-match "\\<alt=" attr) - attr (concat attr " alt=\"" path "\"")) - "/>")) + (setq rpl (org-export-html-format-image + (concat type ":" path))) (setq link (concat type ":" path)) (setq rpl (concat "<a href=\"" (org-export-html-format-href link) @@ -3363,11 +3408,7 @@ (or (eq t org-export-html-inline-images) (and org-export-html-inline-images (not descp)))) - (concat "<img src=\"" thefile "\"" - (if (string-match "alt=" attr) - attr - (concat attr " alt=\"" - thefile "\"")) "/>") + (org-export-html-format-image thefile) (concat "<a href=\"" thefile "\"" attr ">" (org-export-html-format-desc desc) "</a>"))) @@ -3668,6 +3709,22 @@ (org-html-do-expand s)) s)) +(defun org-export-html-format-image (src) + "Create image tag with source and attributes." + (save-match-data + (let* ((caption (org-find-text-property-in-string 'org-caption src)) + (attr (org-find-text-property-in-string 'org-attributes src)) + (label (org-find-text-property-in-string 'org-label src))) + (format "<div %sclass=\"figure\"> +<p><img src=\"%s\"%s></p>%s +</div>" + (if label (format "id=\"%s\" " label) "") + src + (if (string-match "\\<alt=" (or attr "")) + (concat " " attr ) + (concat " " attr " alt=\"" src "\"")) + (if caption (concat "\n<p>" caption "</p>") ""))))) + (defvar org-table-colgroup-info nil) (defun org-format-table-ascii (lines) "Format a table for ascii export." @@ -3754,10 +3811,16 @@ ;; column and the special lines (setq lines (org-table-clean-before-export lines))) - (let ((head (and org-export-highlight-first-table-line + (let ((caption (or (get-text-property 0 'org-caption (car lines)) + (get-text-property (or (next-single-property-change + 0 'org-caption (car lines)) + 0) + 'org-caption (car lines)))) + (head (and org-export-highlight-first-table-line (delq nil (mapcar (lambda (x) (string-match "^[ \t]*|-" x)) (cdr lines))))) + (nlines 0) fnum i tbopen line fields html gr colgropen) (if splice (setq head nil)) @@ -3814,6 +3877,7 @@ fnum "") html) (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) + (if caption (push (format "<caption>%s</caption>" caption) html)) (push html-table-tag html)) (concat (mapconcat 'identity html "\n") "\n")))
--- a/lisp/org/org-export-latex.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-export-latex.el Tue Dec 16 13:28:37 2008 +0000 @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-export-latex.el -;; Version: 6.14 +;; Version: 6.15a ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Maintainer: Bastien Guerry <bzg AT altern DOT org> ;; Keywords: org, wp, tex @@ -91,6 +91,7 @@ \\usepackage[utf8]{inputenc} \\usepackage[T1]{fontenc} \\usepackage{graphicx} +\\usepackage{longtable} \\usepackage{hyperref}" ("\\section{%s}" . "\\section*{%s}") ("\\subsection{%s}" . "\\subsection*{%s}") @@ -102,6 +103,7 @@ \\usepackage[utf8]{inputenc} \\usepackage[T1]{fontenc} \\usepackage{graphicx} +\\usepackage{longtable} \\usepackage{hyperref}" ("\\part{%s}" . "\\part*{%s}") ("\\chapter{%s}" . "\\chapter*{%s}") @@ -113,6 +115,7 @@ \\usepackage[utf8]{inputenc} \\usepackage[T1]{fontenc} \\usepackage{graphicx} +\\usepackage{longtable} \\usepackage{hyperref}" ("\\part{%s}" . "\\part*{%s}") ("\\chapter{%s}" . "\\chapter*{%s}") @@ -163,8 +166,8 @@ ("/" "\\emph{%s}" nil) ("_" "\\underline{%s}" nil) ("+" "\\texttt{%s}" nil) - ("=" "\\texttt{%s}" nil) - ("~" "\\texttt{%s}" t)) + ("=" "\\verb|%s|" nil) + ("~" "\\verb|%s|" 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. @@ -357,6 +360,8 @@ (error "Need a file name to be able to export"))) (message "Exporting to LaTeX...") + (remove-text-properties (point-min) (point-max) + '(:org-license-to-kill nil)) (org-update-radio-target-regexp) (org-export-latex-set-initial-vars ext-plist arg) (let* ((wcf (current-window-configuration)) @@ -404,11 +409,10 @@ (odd org-odd-levels-only) (header (org-export-latex-make-header title opt-plist)) (skip (cond (subtree-p nil) - (region-p t) - ;; never skip first lines when exporting a subtree + (region-p nil) (t (plist-get opt-plist :skip-before-1st-heading)))) (text (plist-get opt-plist :text)) - (first-lines (if skip "" (org-export-latex-first-lines))) + (first-lines (if skip "" (org-export-latex-first-lines rbeg))) (coding-system (and (boundp 'buffer-file-coding-system) buffer-file-coding-system)) (coding-system-for-write (or org-export-latex-coding-system @@ -420,17 +424,18 @@ (if region-p (region-end) (point-max)))) (string-for-export (org-export-preprocess-string - region :emph-multiline t - :for-LaTeX t - :comments nil - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :todo-keywords (plist-get opt-plist :todo-keywords) - :add-text (if (eq to-buffer 'string) nil text) - :skip-before-1st-heading skip - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :LaTeX-fragments nil))) + region + :emph-multiline t + :for-LaTeX t + :comments nil + :tags (plist-get opt-plist :tags) + :priority (plist-get opt-plist :priority) + :todo-keywords (plist-get opt-plist :todo-keywords) + :add-text (if (eq to-buffer 'string) nil text) + :skip-before-1st-heading skip + :select-tags (plist-get opt-plist :select-tags) + :exclude-tags (plist-get opt-plist :exclude-tags) + :LaTeX-fragments nil))) (set-buffer buffer) (erase-buffer) @@ -452,12 +457,6 @@ (unless (or skip (eq to-buffer 'string)) (insert first-lines)) - ;; handle the case where the region does not begin with a section - (when region-p - (insert (with-temp-buffer - (insert string-for-export) - (org-export-latex-first-lines)))) - ;; export the content of headlines (org-export-latex-global (with-temp-buffer @@ -733,32 +732,33 @@ (when (and org-export-with-toc (plist-get opt-plist :section-numbers)) (cond ((numberp toc) - (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\n" + (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n" (min toc (plist-get opt-plist :headline-levels)))) - (toc (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\n" + (toc (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n" (plist-get opt-plist :headline-levels)))))))) -(defun org-export-latex-first-lines (&optional comments) +(defun org-export-latex-first-lines (&optional beg) "Export the first lines before first headline. -COMMENTS is either nil to replace them with the empty string or a -formatting string like %%%%s if we want to comment them out." +If BEG is non-nil, the is the beginning of he region." (save-excursion - (goto-char (point-min)) + (goto-char (or beg (point-min))) (if (org-at-heading-p) (beginning-of-line 2)) (let* ((pt (point)) - (end (if (and (re-search-forward "^\\* " nil t) - (not (eq pt (match-beginning 0)))) + (end (if (re-search-forward "^\\*+ " nil t) (goto-char (match-beginning 0)) (goto-char (point-max))))) - (org-export-latex-content - (org-export-preprocess-string - (buffer-substring (point-min) end) - :for-LaTeX t - :emph-multiline t - :add-text nil - :comments nil - :skip-before-1st-heading nil - :LaTeX-fragments nil))))) + (prog1 + (org-export-latex-content + (org-export-preprocess-string + (buffer-substring pt end) + :for-LaTeX t + :emph-multiline t + :add-text nil + :comments nil + :skip-before-1st-heading nil + :LaTeX-fragments nil)) + (add-text-properties pt (max pt (1- end)) + '(:org-license-to-kill t)))))) (defun org-export-latex-content (content &optional exclude-list) "Convert CONTENT string to LaTeX. @@ -855,8 +855,8 @@ "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-\\)\"" "``") ("\\(\\S-\\)\"" "''") @@ -877,8 +877,9 @@ (goto-char (point-min)) (while (re-search-forward c nil t) ;; Put the point where to check for org-protected - (unless (or (get-text-property (match-beginning 2) 'org-protected) - (org-at-table-p)) +; (unless (or (get-text-property (match-beginning 2) 'org-protected); +; (org-at-table-p)) + (unless (get-text-property (match-beginning 2) 'org-protected) (cond ((member (match-string 2) '("\\$" "$")) (if (equal (match-string 2) "\\$") (replace-match (concat (match-string 1) "$" @@ -1035,14 +1036,27 @@ (save-excursion (org-table-align)) (let* ((beg (org-table-begin)) (end (org-table-end)) - (raw-table (buffer-substring-no-properties beg end)) - fnum fields line lines olines gr colgropen line-fmt align) + (raw-table (buffer-substring beg end)) + fnum fields line lines olines gr colgropen line-fmt align + caption label attr floatp longtblp) (if org-export-latex-tables-verbatim (let* ((tbl (concat "\\begin{verbatim}\n" raw-table "\\end{verbatim}\n"))) (apply 'delete-region (list beg end)) (insert (org-export-latex-protect-string tbl))) (progn + (setq caption (org-find-text-property-in-string + 'org-caption raw-table) + attr (org-find-text-property-in-string + 'org-attributes raw-table) + label (org-find-text-property-in-string + 'org-label raw-table) + longtblp (and attr (stringp attr) + (string-match "\\<longtable\\>" attr)) + align (and attr (stringp attr) + (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr) + (match-string 1 attr)) + floatp (or caption label)) (setq lines (split-string raw-table "\n" t)) (apply 'delete-region (list beg end)) (when org-export-table-remove-special-lines @@ -1076,10 +1090,11 @@ (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt)) (setq line-fmt (match-string 2 line-fmt))) ;; format alignment - (setq align (apply 'format - (cons line-fmt - (mapcar (lambda (x) (if x "r" "l")) - org-table-last-alignment)))) + (unless align + (setq align (apply 'format + (cons line-fmt + (mapcar (lambda (x) (if x "r" "l")) + org-table-last-alignment))))) ;; prepare the table to send to orgtbl-to-latex (setq lines (mapcar @@ -1089,8 +1104,34 @@ lines)) (when insert (insert (org-export-latex-protect-string - (orgtbl-to-latex - lines `(:tstart ,(concat "\\begin{tabular}{" align "}")))) + (concat + (if longtblp + (concat "\\begin{longtable}{" align "}\n") + (if floatp "\\begin{table}[htb]\n")) + (if (or floatp longtblp) + (format + "\\caption{%s%s}" + (if label (concat "\\\label{" label "}") "") + (or caption ""))) + (if longtblp "\\\\\n" "\n") + (if (not longtblp) "\\begin{center}\n") + (if (not longtblp) (concat "\\begin{tabular}{" align "}\n")) + (orgtbl-to-latex + lines + `(:tstart nil :tend nil + :hlend ,(if longtblp + (format "\\\\ +\\hline +\\endhead +\\hline\\multicolumn{%d}{r}{Continued on next page}\\ +\\endfoot +\\endlastfoot" (length org-table-last-alignment)) + nil))) + (if (not longtblp) (concat "\n\\end{tabular}")) + (if longtblp "\n" "\n\\end{center}\n") + (if longtblp + "\\end{longtable}" + (if floatp "\\end{table}")))) "\n\n"))))))) (defun org-export-latex-fontify () @@ -1122,10 +1163,17 @@ (goto-char (match-beginning 0)) (let* ((re-radio org-export-latex-all-targets-re) (remove (list (match-beginning 0) (match-end 0))) - (type (match-string 2)) (raw-path (org-extract-attributes (match-string 3))) (full-raw-path (concat (match-string 1) raw-path)) (desc (match-string 5)) + (type (or (match-string 2) + (if (or (file-name-absolute-p raw-path) + (string-match "^\\.\\.?/" raw-path)) + "file"))) + (caption (org-find-text-property-in-string 'org-caption raw-path)) + (attr (org-find-text-property-in-string 'org-attributes raw-path)) + (label (org-find-text-property-in-string 'org-label raw-path)) + (floatp (or label caption)) imgp radiop ;; define the path of the link (path (cond @@ -1137,7 +1185,8 @@ (concat type ":" raw-path)) ((equal type "file") (if (and (or (org-file-image-p (expand-file-name raw-path)) - (string-match "\\.eps$" raw-path)) + (string-match "\\.\\(pdf\\|jpg\\|ps\\|eps\\)$" + raw-path)) (equal desc full-raw-path)) (setq imgp t) (progn (when (string-match "\\(.+\\)::.+" raw-path) @@ -1150,10 +1199,17 @@ ;; process with link inserting (apply 'delete-region remove) (cond ((and imgp (plist-get org-export-latex-options-plist :inline-images)) - (insert (format "\\includegraphics[%s]{%s}" - ;; image option should be set be a comment line - org-export-latex-image-default-option - (expand-file-name raw-path)))) + (insert + (concat + (if floatp "\\begin{figure}[htb]\n") + (format "\\centerline{\\includegraphics[%s]{%s}}\n" + (or attr org-export-latex-image-default-option) + (expand-file-name raw-path)) + (if floatp + (format "\\caption{%s%s}\n" + (if label (concat "\\label{" label "}")) + (or caption ""))) + (if floatp "\\end{figure}\n")))) (radiop (insert (format "\\hyperref[%s]{%s}" (org-solidify-link-text raw-path) desc))) ((not type) @@ -1167,7 +1223,6 @@ (defun org-export-latex-preprocess () "Clean stuff in the LaTeX export." - ;; Preserve line breaks (goto-char (point-min)) (while (re-search-forward "\\\\\\\\" nil t)
--- a/lisp/org/org-faces.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-faces.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-gnus.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-gnus.el Tue Dec 16 13:28:37 2008 +0000 @@ -6,7 +6,7 @@ ;; Tassilo Horn <tassilo at member dot fsf dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;; @@ -74,11 +74,11 @@ (if (and (string-match "^nntp" group) ;; Only for nntp groups (org-xor current-prefix-arg org-gnus-prefer-web-links)) - (concat (if (string-match "gmane" unprefixed-group) - "http://news.gmane.org/" - "http://groups.google.com/group/") - unprefixed-group) - (concat "gnus:" group)))) + (org-make-link (if (string-match "gmane" unprefixed-group) + "http://news.gmane.org/" + "http://groups.google.com/group/") + unprefixed-group) + (org-make-link "gnus:" group)))) (defun org-gnus-article-link (group newsgroups message-id x-no-archive) "Create a link to a Gnus article. @@ -98,8 +98,7 @@ (format (if (string-match "gmane\\." newsgroups) "http://mid.gmane.org/%s" "http://groups.google.com/groups/search?as_umsgid=%s") - (org-fixup-message-id-for-http - (replace-regexp-in-string "[<>]" "" message-id))) + (org-fixup-message-id-for-http message-id)) (org-make-link "gnus:" group "#" message-id))) (defun org-gnus-store-link () @@ -115,7 +114,7 @@ (unless group (error "Not on a group")) (org-store-link-props :type "gnus" :group group) (setq desc (org-gnus-group-link group) - link (org-make-link desc)) + link desc) (org-add-link-props :link link :description desc) link)) @@ -127,7 +126,8 @@ (goto-char (point-min)) (mail-header-extract-no-properties))) (from (mail-header 'from header)) - (message-id (mail-header 'message-id header)) + (message-id (org-remove-angle-brackets + (mail-header 'message-id header))) (date (mail-header 'date header)) (to (mail-header 'to header)) (newsgroups (mail-header 'newsgroups header)) @@ -149,6 +149,10 @@ (error "Error in Gnus link")) (setq group (match-string 1 path) article (match-string 3 path)) + (when group + (setq group (org-substring-no-properties group))) + (when article + (setq article (org-substring-no-properties article))) (org-gnus-follow-link group article))) (defun org-gnus-follow-link (&optional group article) @@ -156,13 +160,28 @@ (require 'gnus) (funcall (cdr (assq 'gnus org-link-frame-setup))) (if gnus-other-frame-object (select-frame gnus-other-frame-object)) + (when group + (setq group (org-substring-no-properties group))) + (when article + (setq article (org-substring-no-properties article))) (cond ((and group article) - (gnus-group-read-group 1 nil group) - (gnus-summary-goto-article - (if (string-match "[^0-9]" article) - article - (string-to-number article)) - nil t)) + (gnus-activate-group group t) + (condition-case nil + (let ((articles 1) + group-opened) + (while (and (not group-opened) + ;; stop on integer overflows + (> articles 0)) + (setq group-opened (gnus-group-read-group articles nil group) + articles (if (< articles 16) + (1+ articles) + (* articles 2)))) + (if group-opened + (gnus-summary-goto-article article nil t) + (message "Couldn't follow gnus link. %s" + "The summary couldn't be opened."))) + (quit (message "Couldn't follow gnus link. %s" + "The linked group is empty.")))) (group (gnus-group-jump-to-group group)))) (defun org-gnus-no-new-news ()
--- a/lisp/org/org-id.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-id.el Tue Dec 16 13:28:37 2008 +0000 @@ -1,10 +1,10 @@ -;;; org-id.el --- Global identifier for Org-mode entries +;;; org-id.el --- Global identifiers for Org-mode entries ;; Copyright (C) 2008 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;; @@ -35,7 +35,7 @@ ;; Org has a builtin method that uses a compact encoding of the creation ;; time of the ID, with microsecond accuracy. This virtually ;; guarantees globally unique identifiers, even if several people are -;; creating ID's at the same time in files that will eventually be used +;; creating IDs at the same time in files that will eventually be used ;; together. As an exernal method `uuidgen' is supported, if installed ;; on the system. ;; @@ -78,17 +78,26 @@ :tag "Org ID" :group 'org) -(defcustom org-id-method 'org - "The method that should be used to create new ID's. -An ID will consist of the prefix specified in `org-id-prefix', and a unique -part created by the method this variable specifies. +(defcustom org-id-method + (condition-case nil + (if (string-match "\\`[-0-9a-fA-F]\\{36\\}\\'" + (org-trim (shell-command-to-string "uuidgen"))) + 'uuidgen + 'org) + (error 'org)) + "The method that should be used to create new IDs. + +If `uuidgen' is available on the system, it will be used as the default method. +if not. the methd `org' is used. +An ID will consist of the optional prefix specified in `org-id-prefix', +and a unique part created by the method this variable specifies. Allowed values are: -org Org's own internal method, using an encoding of the current time, - and the current domain of the computer. This method will - honor the variable `org-id-include-domain'. +org Org's own internal method, using an encoding of the current time to + microsecond accuracy, and optionally the current domain of the + computer. See the variable `org-id-include-domain'. uuidgen Call the external command uuidgen." :group 'org-id @@ -107,26 +116,54 @@ (const :tag "No prefix") (string :tag "Prefix"))) -(defcustom org-id-include-domain t +(defcustom org-id-include-domain nil "Non-nil means, add the domain name to new IDs. -This ensures global uniqueness of ID's, and is also suggested by +This ensures global uniqueness of IDs, and is also suggested by RFC 2445 in combination with RFC 822. This is only relevant if `org-id-method' is `org'. When uuidgen is used, the domain will never -be added." +be added. +The default is to not use this because we have no really good way to get +the true domain, and Org entries will normally not be shared with enough +people to make this necessary." + :group 'org-id + :type 'boolean) + +(defcustom org-id-track-globally t + "Non-nil means, track IDs trhough files, so that links work globally. +This work by maintaining a hash table for IDs and writing this table +to disk when exiting Emacs. Because of this, it works best if you use +a single Emacs process, not many. + +When nil, IDs are not tracked. Links to IDs will still work within +a buffer, but not if the entry is located in another file. +IDs can still be used if the entry with the id is in the same file as +the link." :group 'org-id :type 'boolean) (defcustom org-id-locations-file (convert-standard-filename - "~/.org-id-locations") - "The file for remembering the last ID number generated." + "~/.emacs.d/.org-id-locations") + "The file for remembering in which file an ID was defined. +This variable is only relevant when `org-id-track-globally' is set." :group 'org-id :type 'file) (defvar org-id-locations nil - "List of files with ID's in those files.") + "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.") + +(defvar org-id-files nil + "List of files that contain IDs.") (defcustom org-id-extra-files 'org-agenda-text-search-extra-files - "Files to be searched for ID's, besides the agenda files." + "Files to be searched for IDs, besides the agenda files. +When Org reparses files to remake the list of files and IDs it is tracking, +it will normally scan the agenda files, the archives related to agenda files, +any files that are listed as ID containing in the current register, and +any Org-mode files currently visited by Emacs. +You can list additional files here. +This variable is only relevant when `org-id-track-globally' is set." :group 'org-id :type '(choice @@ -134,6 +171,14 @@ (repeat :tag "List of files" (file)))) +(defcustom org-id-search-archives t + "Non-nil means, search also the archive files of agenda files for entries. +This is a possibility to reduce overhead, but it measn that entries moved +to the archives can no longer be found by ID. +This variable is only relevant when `org-id-track-globally' is set." + :group 'org-id + :type 'boolean) + ;;; The API functions ;;;###autoload @@ -202,7 +247,7 @@ (defun org-id-goto (id) "Switch to the buffer containing the entry with id ID. Move the cursor to that entry in that buffer." - (interactive) + (interactive "sID: ") (let ((m (org-id-find id 'marker))) (unless m (error "Cannot find entry with ID \"%s\"" id)) @@ -326,77 +371,163 @@ ;; Storing ID locations (files) -(defun org-id-update-id-locations () - "Scan relevant files for ID's. -Store the relation between files and corresponding ID's." +(defun org-id-update-id-locations (&optional files) + "Scan relevant files for IDs. +Store the relation between files and corresponding IDs. +This will scan all agenda files, all associated archives, and all +files currently mentioned in `org-id-locations'. +When FILES is given, scan these files instead. +When CHECK is given, prepare detailed iinformation about duplicate IDs." (interactive) - (let ((files (append (org-agenda-files) - (if (symbolp org-id-extra-files) - (symbol-value org-id-extra-files) - org-id-extra-files))) - org-agenda-new-buffers - file ids reg found id) - (while (setq file (pop files)) - (setq ids nil) - (with-current-buffer (org-get-agenda-file-buffer file) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$" - nil t) - (setq id (org-match-string-no-properties 1)) - (if (member id found) - (error "Duplicate ID \"%s\"" id)) - (push id found) - (push id ids)) - (push (cons file ids) reg))))) - (org-release-buffers org-agenda-new-buffers) - (setq org-agenda-new-buffers nil) - (setq org-id-locations reg) - (org-id-locations-save))) + (if (not org-id-track-globally) + (error "Please turn on `org-id-track-globally' if you want to track IDs.") + (let ((files + (or files + (append + ;; Agenda files and all associated archives + (org-agenda-files t org-id-search-archives) + ;; Explicit extra files + (if (symbolp org-id-extra-files) + (symbol-value org-id-extra-files) + org-id-extra-files) + ;; Files associated with live org-mode buffers + (delq nil + (mapcar (lambda (b) + (with-current-buffer b + (and (org-mode-p) (buffer-file-name)))) + (buffer-list))) + ;; All files known to have IDs + org-id-files))) + org-agenda-new-buffers + file nfiles tfile ids reg found id seen (ndup 0)) + (setq nfiles (length files)) + (while (setq file (pop files)) + (message "Finding ID locations (%d/%d files): %s" + (- nfiles (length files)) nfiles file) + (setq tfile (file-truename file)) + (when (and (file-exists-p file) (not (member tfile seen))) + (push tfile seen) + (setq ids nil) + (with-current-buffer (org-get-agenda-file-buffer file) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$" + nil t) + (setq id (org-match-string-no-properties 1)) + (if (member id found) + (progn + (message "Duplicate ID \"%s\", also in file %s" + id (car (delq + nil + (mapcar + (lambda (x) + (if (member id (cdr x)) (car x))) + reg)))) + (when (= ndup 0) + (ding) + (sit-for 2)) + (setq ndup (1+ ndup))) + (push id found) + (push id ids))) + (push (cons (abbreviate-file-name file) ids) reg)))))) + (org-release-buffers org-agenda-new-buffers) + (setq org-agenda-new-buffers nil) + (setq org-id-locations reg) + (setq org-id-files (mapcar 'car org-id-locations)) + (org-id-locations-save) ;; this function can also handle the alist form + ;; now convert to a hash + (setq org-id-locations (org-id-alist-to-hash org-id-locations)) + (if (> ndup 0) + (message "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup) + (message "%d unique files scanned for IDs" (length org-id-files))) + org-id-locations))) (defun org-id-locations-save () "Save `org-id-locations' in `org-id-locations-file'." - (with-temp-file org-id-locations-file - (print org-id-locations (current-buffer)))) + (when org-id-track-globally + (let ((out (if (hash-table-p org-id-locations) + (org-id-hash-to-alist org-id-locations) + org-id-locations))) + (with-temp-file org-id-locations-file + (print out (current-buffer)))))) (defun org-id-locations-load () "Read the data from `org-id-locations-file'." (setq org-id-locations nil) - (with-temp-buffer - (condition-case nil - (progn - (insert-file-contents-literally org-id-locations-file) - (goto-char (point-min)) - (setq org-id-locations (read (current-buffer)))) - (error - (message "Could not read org-id-values from %s. Setting it to nil." - org-id-locations-file))))) + (when org-id-track-globally + (with-temp-buffer + (condition-case nil + (progn + (insert-file-contents-literally org-id-locations-file) + (goto-char (point-min)) + (setq org-id-locations (read (current-buffer)))) + (error + (message "Could not read org-id-values from %s. Setting it to nil." + org-id-locations-file)))) + (setq org-id-files (mapcar 'car org-id-locations)) + (setq org-id-locations (org-id-alist-to-hash org-id-locations)))) (defun org-id-add-location (id file) "Add the ID with location FILE to the database of ID loations." - (when (and id file) ; don't error when called from a buffer with no file + ;; Only if global tracking is on, and when the buffer has a file + (when (and org-id-track-globally id file) (unless org-id-locations (org-id-locations-load)) - (catch 'exit - (let ((locs org-id-locations) list) - (while (setq list (pop locs)) - (when (equal (file-truename file) (file-truename (car list))) - (setcdr list (cons id (cdr list))) - (throw 'exit t)))) - (push (list file id) org-id-locations)) - (org-id-locations-save))) + (puthash id (abbreviate-file-name file) org-id-locations) + (add-to-list 'org-id-files (abbreviate-file-name file)))) + +(add-hook 'kill-emacs-hook 'org-id-locations-save) + +(defun org-id-hash-to-alist (hash) + "Turn an org-id hash into an alist, so that it can be written to a file." + (let (res x) + (maphash + (lambda (k v) + (if (setq x (member v res)) + (setcdr x (cons k (cdr x))) + (push (list v k) res))) + hash) + res)) + +(defun org-id-alist-to-hash (list) + "Turn an org-id location list into a hash table." + (let ((res (make-hash-table + :test 'equal + :size (apply '+ (mapcar 'length list)))) + f i) + (mapc + (lambda (x) + (setq f (car x)) + (mapc (lambda (i) (puthash i f res)) (cdr x))) + list) + res)) + +(defun org-id-paste-tracker (txt &optional buffer-or-file) + "Update any IDs in TXT and assign BUFFER-OR-FILE to them." + (when org-id-track-globally + (save-match-data + (setq buffer-or-file (or buffer-or-file (current-buffer))) + (when (bufferp buffer-or-file) + (setq buffer-or-file (or (buffer-base-buffer buffer-or-file) + buffer-or-file)) + (setq buffer-or-file (buffer-file-name buffer-or-file))) + (when buffer-or-file + (let ((fname (abbreviate-file-name buffer-or-file)) + (s 0)) + (while (string-match "^[ \t]*:ID:[ \t]+\\([^ \t\n\r]+\\)" txt s) + (setq s (match-end 0)) + (org-id-add-location (match-string 1 txt) fname))))))) ;; Finding entries with specified id (defun org-id-find-id-file (id) "Query the id database for the file in which this ID is located." (unless org-id-locations (org-id-locations-load)) - (catch 'found - (mapc (lambda (x) (if (member id (cdr x)) - (throw 'found (car x)))) - org-id-locations) - nil)) + (or (gethash id org-id-locations) + ;; ball back on current buffer + (buffer-file-name (or (buffer-base-buffer (current-buffer)) + (current-buffer))))) (defun org-id-find-id-in-file (id file &optional markerp) "Return the position of the entry ID in FILE. @@ -415,8 +546,41 @@ (move-marker (make-marker) pos buf) (cons file pos)))))))) +;; id link type + +;; Calling the following function is hard-coded into `org-store-link', +;; so we do have to add it to `org-store-link-functions'. + +(defun org-id-store-link () + "Store a link to the current entry, using it's ID." + (interactive) + (let* ((link (org-make-link "id:" (org-id-get-create))) + (desc (save-excursion + (org-back-to-heading t) + (or (and (looking-at org-complex-heading-regexp) + (if (match-end 4) (match-string 4) (match-string 0))) + link)))) + (org-store-link-props :link link :description desc :type "id") + link)) + +(defun org-id-open (id) + "Go to the entry with id ID." + (org-mark-ring-push) + (let ((m (org-id-find id 'marker))) + (unless m + (error "Cannot find entry with ID \"%s\"" id)) + (if (not (equal (current-buffer) (marker-buffer m))) + (switch-to-buffer-other-window (marker-buffer m))) + (goto-char m) + (move-marker m nil) + (org-show-context))) + +(org-add-link-type "id" 'org-id-open) + (provide 'org-id) ;;; org-id.el ends here ;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712 + +
--- a/lisp/org/org-info.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-info.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-irc.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-irc.el Tue Dec 16 13:28:37 2008 +0000 @@ -4,7 +4,7 @@ ;; ;; Author: Philip Jackson <emacs@shellarchive.co.uk> ;; Keywords: erc, irc, link, org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-jsinfo.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-jsinfo.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-list.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-list.el Tue Dec 16 13:28:37 2008 +0000 @@ -6,7 +6,7 @@ ;; Bastien Guerry <bzg AT altern DOT org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-mac-message.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-mac-message.el Tue Dec 16 13:28:37 2008 +0000 @@ -3,7 +3,7 @@ ;; Copyright (C) 2008 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> -;; Version: 6.14 +;; Version: 6.15a ;; Keywords: outlines, hypermedia, calendar, wp ;; This file is part of GNU Emacs.
--- a/lisp/org/org-macs.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-macs.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-mew.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-mew.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; This file is part of GNU Emacs.
--- a/lisp/org/org-mhe.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-mhe.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-mouse.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-mouse.el Tue Dec 16 13:28:37 2008 +0000 @@ -4,7 +4,7 @@ ;; ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-plot.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-plot.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: tables, plotting ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-publish.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-publish.el Tue Dec 16 13:28:37 2008 +0000 @@ -4,7 +4,7 @@ ;; Author: David O'Toole <dto@gnu.org> ;; Maintainer: Bastien Guerry <bzg AT altern DOT org> ;; Keywords: hypermedia, outlines, wp -;; Version: 6.14 +;; Version: 6.15a ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-remember.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-remember.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-rmail.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-rmail.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-table.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-table.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;; @@ -1897,7 +1897,8 @@ (beginning-of-line 2) (setq l (1+ l))) (setq org-table-current-line-types (apply 'vector (nreverse types)) - org-table-dlines (apply 'vector (cons nil (nreverse dlines))) + org-table-dlines (apply 'vector (cons (car dlines) + (nreverse dlines))) org-table-hlines (apply 'vector (cons nil (nreverse hlines))))))) (defun org-table-maybe-eval-formula () @@ -2360,12 +2361,17 @@ (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. -With prefix arg ALL, do this for all lines in the table." +With prefix arg ALL, do this for all lines in the table. +With the prefix argument ALL is `(16)' (a double `C-c C-u' prefix), or if +it is the symbol `iterate', recompute the table until it no longer changes. +If NOALIGN is not nil, do not re-align the table after the computations +are done. This is typically used internally to save time, if it is +known that the table will be realigned a little later anyway." (interactive "P") (or (memq this-command org-recalc-commands) (setq org-recalc-commands (cons this-command org-recalc-commands))) (unless (org-at-table-p) (error "Not at a table")) - (if (equal all '(16)) + (if (or (eq all 'iterate) (equal all '(16))) (org-table-iterate) (org-table-get-specials) (let* ((eqlist (sort (org-table-get-stored-formulas) @@ -3865,9 +3871,15 @@ ;; Do we have a heading section? If so, format it and handle the ;; trailing hline. - (if (and (not splicep) (listp (car *orgtbl-table*)) - (memq 'hline *orgtbl-table*)) + (if (and (not splicep) + (or (consp (car *orgtbl-table*)) + (consp (nth 1 *orgtbl-table*))) + (memq 'hline (cdr *orgtbl-table*))) (progn + (when (eq 'hline (car *orgtbl-table*)) + ;; there is a hline before the first data line + (and hline (push hline *orgtbl-rtn*)) + (pop *orgtbl-table*)) (let* ((*orgtbl-lstart* (or (plist-get params :hlstart) *orgtbl-lstart*)) (*orgtbl-llstart* (or (plist-get params :hllstart)
--- a/lisp/org/org-timer.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-timer.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-vm.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-vm.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-w3m.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-w3m.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-wl.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org-wl.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org.el Tue Dec 16 13:23:17 2008 +0000 +++ b/lisp/org/org.el Tue Dec 16 13:28:37 2008 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.14 +;; Version: 6.15a ;; ;; This file is part of GNU Emacs. ;; @@ -92,7 +92,7 @@ ;;; Version -(defconst org-version "6.14" +(defconst org-version "6.15a" "The version number of the file org.el.") (defun org-version (&optional here) @@ -162,7 +162,7 @@ (const :tag " bbdb: Links to BBDB entries" org-bbdb) (const :tag " bibtex: Links to BibTeX entries" org-bibtex) (const :tag " gnus: Links to GNUS folders/messages" org-gnus) - (const :tag " id: Global id's for identifying entries" org-id) + (const :tag " id: Global IDs for identifying entries" org-id) (const :tag " info: Links to Info nodes" org-info) (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo) (const :tag " irc: Links to IRC/ERC chat sessions" org-irc) @@ -178,13 +178,13 @@ (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) (const :tag "C annotation-helper: Call Remeber directly from Browser" org-annotation-helper) (const :tag "C bookmark: Org links to bookmarks" org-bookmark) + (const :tag "C browser-url: Store link, directly from Browser" org-browser-url) (const :tag "C depend: TODO dependencies for Org-mode" org-depend) (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol) (const :tag "C eval: Include command output as text" org-eval) (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry) (const :tag "C exp-blocks: Pre-process blocks for export" org-exp-blocks) - (const :tag "C id: Global id's for identifying entries" org-id) (const :tag "C interactive-query: Interactive modification of tags query" org-interactive-query) (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix) (const :tag "C man: Support for links to manpages in Org-mode" org-man) @@ -956,6 +956,40 @@ :group 'org-link-store :type 'regexp) +(defcustom org-link-to-org-use-id 'create-if-interactive + "Non-nil means, storing a link to an Org file will use entry IDs. + +Note that before this variable is even considered, org-id must be loaded, +to please customize `org-modules' and turn it on. + +The variable can have the following values: + +t Create an ID if needed to make a link to the current entry. + +create-if-interactive + If `org-store-link' is called directly (interactively, as a user + command), do create an ID to support the link. But when doing the + job for remember, only use the ID if it already exists. The + purpose of this setting is to avoid proliferation of unwanted + IDs, just because you happen to be in an Org file when you + call `org-remember' that automatically and preemptively + creates a link. If you do want to get an ID link in a remember + template to an entry not having an ID, create it first by + explicitly creating a link to it, using `C-c C-l' first. + +use-existing + Use existing ID, do not create one. + +nil Never use an ID to make a link, instead link using a text search for + the headline text." + :group 'org-link-store + :type '(choice + (const :tag "Create ID to make link" t) + (const :tag "Create if string link interactively" + 'create-if-interactive) + (const :tag "Only use existing" 'use-existing) + (const :tag "Do not use ID to create link" nil))) + (defcustom org-context-in-file-links t "Non-nil means, file links from `org-store-link' contain context. A search string will be added to the file name with :: as separator and @@ -1283,6 +1317,11 @@ (const :tag "Outline" outline) (const :tag "Outline-path-completion" outline-path-completion))) +(defcustom org-goto-max-level 5 + "Maximum level to be considered when running org-goto with refile interface." + :group 'org-refile + :type 'number) + (defcustom org-reverse-note-order nil "Non-nil means, store new notes at the beginning of a file or entry. When nil, new notes will be filed to the end of a file or entry. @@ -1515,14 +1554,22 @@ (choice (const :tag "Add" t) (const :tag "Remove" nil))))))) (defcustom org-log-done nil - "Non-nil means, record a CLOSED timestamp when moving an entry to DONE. -When equal to the list (done), also prompt for a closing note. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - + "Information to record when a task moves to the DONE state. + +Possible values are: + +nil Don't add anything, just change the keyword +time Add a time stamp to the task +note Prompt a closing note and add it with template `org-log-note-headings' + +This option can also be set with on a per-file-basis with + + #+STARTUP: nologdone #+STARTUP: logdone #+STARTUP: lognotedone - #+STARTUP: nologdone" + +You can have local logging settings for a subtree by setting the LOGGING +property to one or more of these keywords." :group 'org-todo :group 'org-progress :type '(choice @@ -2806,11 +2853,12 @@ ;; Autoload ID code +(declare-function org-id-store-link "org-id") (org-autoload "org-id" '(org-id-get-create org-id-new org-id-copy org-id-get org-id-get-with-outline-path-completion org-id-get-with-outline-drilling - org-id-goto org-id-find)) + org-id-goto org-id-find org-id-store-link)) ;;; Variables for pre-computed regular expressions, all buffer local @@ -4504,7 +4552,7 @@ the location selected in the indirect buffer and expose the the headline hierarchy above." (interactive "P") - (let* ((org-refile-targets '((nil . (:maxlevel . 10)))) + (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) (org-refile-use-outline-path t) (interface (if (not alternative-interface) @@ -5268,6 +5316,7 @@ (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)) @@ -6141,7 +6190,6 @@ (setcdr (assoc type org-link-protocols) (list follow export)) (push (list type follow export) org-link-protocols))) - ;;;###autoload (defun org-store-link (arg) "\\<org-mode-map>Store an org-link to the current location. @@ -6202,14 +6250,34 @@ link (org-make-link cpltxt))) ((and buffer-file-name (org-mode-p)) - ;; Just link to current headline - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name))) - ;; Add a context search string - (when (org-xor org-context-in-file-links arg) - ;; Check if we are on a target - (if (org-in-regexp "<<\\(.*?\\)>>") - (setq cpltxt (concat cpltxt "::" (match-string 1))) + (cond + ((org-in-regexp "<<\\(.*?\\)>>") + (setq cpltxt + (concat "file:" + (abbreviate-file-name buffer-file-name) + "::" (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 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 + (org-id-store-link) + (error + ;; probably before first headling, link to file only + (concat "file:" + (abbreviate-file-name buffer-file-name)))))) + (t + ;; Just link to current headline + (setq cpltxt (concat "file:" + (abbreviate-file-name buffer-file-name))) + ;; 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) @@ -6221,10 +6289,10 @@ (condition-case nil (org-make-org-heading-search-string txt) (error ""))) - desc "NONE")))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link (org-make-link cpltxt))) + desc "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. @@ -6655,7 +6723,7 @@ (setq key (match-string 1 a) value (match-string 2 a) start (match-end 0) attr (plist-put attr (intern key) value)))) - (org-add-props s nil 'org-attributes attr)) + (org-add-props s nil 'org-attr attr)) s)) (defun org-attributes-to-string (plist) @@ -6663,7 +6731,8 @@ (let ((s "") key value) (while plist (setq key (pop plist) value (pop plist)) - (setq s (concat s " "(symbol-name key) "=\"" value "\""))) + (and value + (setq s (concat s " " (symbol-name key) "=\"" value "\"")))) s)) ;;; Opening/following a link @@ -7392,10 +7461,12 @@ (defun org-get-refile-targets (&optional default-buffer) "Produce a table with refile targets." (let ((entries (or org-refile-targets '((nil . (:level . 1))))) - targets txt re files f desc descre) + targets txt re files f desc descre fast-path-p level) + (message "Getting targets...") (with-current-buffer (or default-buffer (current-buffer)) (while (setq entry (pop entries)) (setq files (car entry) desc (cdr entry)) + (setq fast-path-p nil) (cond ((null files) (setq files (list (current-buffer)))) ((eq files 'org-agenda-files) @@ -7419,6 +7490,7 @@ (cdr desc))) "\\}[ \t]"))) ((eq (car desc) :maxlevel) + (setq fast-path-p t) (setq descre (concat "^\\*\\{1," (number-to-string (if org-odd-levels-only (1- (* 2 (cdr desc))) @@ -7436,7 +7508,8 @@ (while (re-search-forward descre nil t) (goto-char (point-at-bol)) (when (looking-at org-complex-heading-regexp) - (setq txt (org-link-display-format (match-string 4)) + (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) + txt (org-link-display-format (match-string 4)) re (concat "^" (regexp-quote (buffer-substring (match-beginning 1) (match-end 4))))) @@ -7452,26 +7525,37 @@ (buffer-file-name (buffer-base-buffer)))) (if (eq org-refile-use-outline-path 'full-file-path) (list (buffer-file-name (buffer-base-buffer))))) - (org-get-outline-path) + (org-get-outline-path fast-path-p level txt) (list txt)) "/"))) (push (list txt f re (point)) targets)) (goto-char (point-at-eol)))))))) - (nreverse targets)))) + (message "Getting targets...done") + (nreverse targets)))) (defun org-protect-slash (s) (while (string-match "/" s) (setq s (replace-match "\\" t t s))) s) -(defun org-get-outline-path () +(defvar org-olpa (make-vector 20 nil)) + +(defun org-get-outline-path (&optional fastp level heading) "Return the outline path to the current entry, as a list." - (let (rtn) - (save-excursion - (while (org-up-heading-safe) - (when (looking-at org-complex-heading-regexp) - (push (org-match-string-no-properties 4) rtn))) - rtn))) + (if (> level 19) (error "Outline path failure, more than 19 levels.")) + (if fastp + (progn + (loop for i from level upto 19 do + (aset org-olpa i nil)) + (prog1 + (delq nil (append org-olpa nil)) + (aset org-olpa level heading))) + (let (rtn) + (save-excursion + (while (org-up-heading-safe) + (when (looking-at org-complex-heading-regexp) + (push (org-match-string-no-properties 4) rtn))) + rtn)))) (defvar org-refile-history nil "History for refiling operations.") @@ -7514,6 +7598,15 @@ (setq file (nth 1 it) re (nth 2 it) pos (nth 3 it)) + (if (and (equal (buffer-file-name) file) + (if regionp + (and (>= pos region-start) + (<= pos region-end)) + (and (>= pos (point)) + (< pos (save-excursion + (org-end-of-subtree t t)))))) + (error "Cannot refile to position inside the tree or region")) + (setq nbuf (or (find-buffer-visiting file) (find-file-noselect file))) (if goto @@ -7571,10 +7664,9 @@ 'org-ido-completing-read)) (extra (if org-refile-use-outline-path "/" "")) (filename (buffer-file-name (buffer-base-buffer cbuf))) - (fname (and filename (file-truename filename))) (tbl (mapcar (lambda (x) - (if (not (equal fname (file-truename (nth 1 x)))) + (if (not (equal filename (nth 1 x))) (cons (concat (car x) extra " (" (file-name-nondirectory (nth 1 x)) ")") (cdr x)) @@ -7740,7 +7832,8 @@ "BEGIN_EXAMPLE" "END_EXAMPLE" "BEGIN_QUOTE" "END_QUOTE" "BEGIN_VERSE" "END_VERSE" - "BEGIN_SRC" "END_SRC")) + "BEGIN_SRC" "END_SRC" + "CAPTION" "LABEL" "ATTR_HTML" "ATTR_LaTeX")) (defcustom org-structure-template-alist '( @@ -9437,10 +9530,9 @@ (defun org-toggle-tag (tag &optional onoff) "Toggle the tag TAG for the current line. If ONOFF is `on' or `off', don't toggle but set to this state." - (unless (org-on-heading-p t) (error "Not on headling")) (let (res current) (save-excursion - (beginning-of-line) + (org-back-to-heading t) (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") (point-at-eol) t) (progn @@ -10559,6 +10651,7 @@ IDENT can be a string, a symbol or a number, this function will search for the string representation of it. Return the position where this entry starts, or nil if there is no such entry." + (interactive "sID: ") (let ((id (cond ((stringp ident) ident) ((symbol-name ident) (symbol-name ident)) @@ -13412,6 +13505,12 @@ ;;; Generally useful functions +(defun org-find-text-property-in-string (prop s) + "Return the first non-nil value of property PROP in string S." + (or (get-text-property 0 prop s) + (get-text-property (or (next-single-property-change 0 prop s) 0) + prop s))) + (defun org-display-warning (message) ;; Copied from Emacs-Muse "Display the given MESSAGE as a warning." (if (fboundp 'display-warning) @@ -14308,6 +14407,11 @@ (error (error "Before first headline at position %d in buffer %s" (point) (current-buffer))))) +(defun org-before-first-heading-p () + "Before first heading?" + (save-excursion + (null (re-search-backward "^\\*+ " nil t)))) + (defalias 'org-on-heading-p 'outline-on-heading-p) (defalias 'org-at-heading-p 'outline-on-heading-p) (defun org-at-heading-or-item-p () @@ -14329,16 +14433,14 @@ "Move to the heading line of which the present line is a subheading. This version will not throw an error. It will return the level of the headline found, or nil if no higher level is found." - (let ((pos (point)) start-level level - (re (concat "^" outline-regexp))) - (catch 'exit - (org-back-to-heading t) - (setq start-level (funcall outline-level)) - (if (equal start-level 1) (throw 'exit nil)) - (while (re-search-backward re nil t) - (setq level (funcall outline-level)) - (if (< level start-level) (throw 'exit level))) - nil))) + (let (start-level re) + (org-back-to-heading t) + (setq start-level (funcall outline-level)) + (if (equal start-level 1) + nil + (setq re (concat "^\\*\\{1," (number-to-string (1- start-level)) "\\} ")) + (if (re-search-backward re nil t) + (funcall outline-level))))) (defun org-first-sibling-p () "Is this heading the first child of its parents?"