diff options
| -rwxr-xr-x | lisp/ChangeLog | 16 | ||||
| -rw-r--r-- | lisp/org-exp.el | 39 | ||||
| -rw-r--r-- | lisp/org-id.el | 83 | ||||
| -rw-r--r-- | lisp/org.el | 93 |
4 files changed, 168 insertions, 63 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5db546a84..5b16d1638 100755 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -345,6 +345,10 @@ 2008-11-14 Carsten Dominik <carsten.dominik@gmail.com> + * org-exp.el (org-export-preprocess-string): Reorder so that we + can still see ID properties when we collect targets. + (org-export-target-internal-links): Also store targets for ID's. + * org.el (org-link-translation-function): New option. (org-open-at-point): Call `org-link-translation-function' if non-nil. @@ -361,12 +365,20 @@ 2008-11-13 Carsten Dominik <carsten.dominik@gmail.com> - * org-exp.el (org-icalendar-cleanup-string): Improve RFC2455 - compliance as far as quoting is concerned. + * org-id.el (org-id-search-archives): New option. + + * org.el (org-link-to-org-use-id): New option. + (org-store-link): Use `org-link-to-org-use-id'. + (org-id): Make org-id.el a standard component. + +2008-11-13 Carsten Dominik <carsten.dominik@gmail.com> * org.el (org-link-expand-abbrev): Implement %h as an escape for a hexified version of the tag. + * org-exp.el (org-icalendar-cleanup-string): Improve RFC2455 + compliance as far as quoting is concerned. + * org-vm.el (org-vm-follow-link): Require `vm-search'. * org.el (org-up-heading-safe, org-forward-same-level): Always diff --git a/lisp/org-exp.el b/lisp/org-exp.el index a24b43913..1ab6b4350 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1468,6 +1468,9 @@ on this string to produce the exported version." ;; 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 @@ -1490,9 +1493,6 @@ on this string to produce the exported version." ;; 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)) @@ -1519,7 +1519,6 @@ on this string to produce the exported version." ;; 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) @@ -1577,18 +1576,22 @@ on this string to produce the exported version." 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) @@ -1617,9 +1620,11 @@ Mark them as invisible targets." 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 @@ -1631,6 +1636,8 @@ let the link point to the corresponding section." (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)) diff --git a/lisp/org-id.el b/lisp/org-id.el index 07f78824f..04b9cb506 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -134,6 +134,14 @@ be added." (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. +It is possible that id searches might become too slow if a user has +used org-mode and ids for many years. This is why it is possibl to turn this +off." + :group 'org-id + :type 'boolean) + ;;; The API functions ;;;###autoload @@ -326,31 +334,43 @@ and time is the usual three-integer representation of time." ;; Storing ID locations (files) -(defun org-id-update-id-locations () +(defun org-id-update-id-locations (&optional files) "Scan relevant files for ID's. -Store the relation between files and corresponding ID's." +Store the relation between files and corresponding ID's. +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." (interactive) - (let ((files (append (org-agenda-files) - (if (symbolp org-id-extra-files) - (symbol-value org-id-extra-files) - org-id-extra-files))) + (let ((files + (or files + (append (org-agenda-files t org-id-search-archives) + (if (symbolp org-id-extra-files) + (symbol-value org-id-extra-files) + org-id-extra-files) + (mapcar 'car org-id-locations)))) org-agenda-new-buffers - file ids reg found id) + file nfiles tfile ids reg found id seen) + (setq nfiles (length files)) (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))))) + (message "Finding ID locations (%d/%d files)" + (- nfiles (length files)) nfiles) + (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) + (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) @@ -415,8 +435,29 @@ optional argument MARKERP, return the position as a new marker." (move-marker (make-marker) pos buf) (cons file pos)))))))) +(org-add-link-type "id" 'org-id-open) + +(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) + (switch-to-buffer-other-window (current-buffer)) + (org-id-goto id)) + (provide 'org-id) ;;; org-id.el ends here ;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712 + diff --git a/lisp/org.el b/lisp/org.el index 9406b2bb4..984864ce2 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -956,6 +956,36 @@ It should match if the message is from the user him/herself." :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 ID's. +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 + ID's, 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 @@ -2806,11 +2836,12 @@ collapsed state." ;; 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 @@ -6202,29 +6233,43 @@ For file links, arg negates `org-context-in-file-links'." 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))) - (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 "NONE")))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link (org-make-link cpltxt))) + (cond + ((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) + ;; Check if we are on a target + (if (org-in-regexp "<<\\(.*?\\)>>") + (setq cpltxt (concat cpltxt "::" (match-string 1))) + (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 "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. |