Applied, thanks.
- Carsten
On Oct 20, 2009, at 4:51 AM, James TD Smith wrote:
org-registry-assoc-all removed matching links from the registry.
This meant
subsequent calls with the same parameters would return nothing.
Add another function for finding entries in the register, which used
find-if to
get entries satisfying a predicate.
---
contrib/ChangeLog | 9 +++++++--
contrib/lisp/org-registry.el | 40 +++++++++++++++++++++++
+----------------
2 files changed, 31 insertions(+), 18 deletions(-)
diff --git a/contrib/ChangeLog b/contrib/ChangeLog
index e30c28f..8524c9f 100644
--- a/contrib/ChangeLog
+++ b/contrib/ChangeLog
@@ -1,3 +1,10 @@
+2009-10-19 James TD Smith <ahktenz...@mohorovi.cc>
+
+ * lisp/org-registry.el (org-registry-assoc-all): Stop this from
+ deleting the links it finds from the registry.
+ (org-registry-find-all): Add a new function which returns all
+ registry entries which satisfy a test function.
+
2009-10-02 Carsten Dominik <carsten.domi...@gmail.com>
* lisp/org-special-blocks.el (org-special-blocks-ignore-regexp):
@@ -284,5 +291,3 @@
* lisp/org-irc.el: New file.
* ChangeLog: New file.
-
-
diff --git a/contrib/lisp/org-registry.el b/contrib/lisp/org-
registry.el
index f8d3d61..01b2fc8 100644
--- a/contrib/lisp/org-registry.el
+++ b/contrib/lisp/org-registry.el
@@ -39,25 +39,25 @@
;;
;; This is were org-registry comes in handy.
;;
-;; M-x org-registry-show will tell you the name of the file
+;; M-x org-registry-show will tell you the name of the file
;; C-u M-x org-registry-show will directly jump to the file
;;
-;; In case there are several files where the link lives in:
+;; In case there are several files where the link lives in:
;;
;; M-x org-registry-show will display them in a new window
;; C-u M-x org-registry-show will prompt for a file to visit
;;
;; Add this to your Org configuration:
-;;
+;;
;; (require 'org-registry)
;; (org-registry-initialize)
;;
;; If you want to update the registry with newly inserted links in the
;; current buffer: M-x org-registry-update
-;;
+;;
;; If you want this job to be done each time you save an Org buffer,
;; hook 'org-registry-update to the local 'after-save-hook in org-
mode:
-;;
+;;
;; (org-registry-insinuate)
;;; Code:
@@ -94,7 +94,7 @@ buffer."
(match-string-no-properties 1 blink)))
(desc (or (and (string-match org-bracket-link-regexp blink)
(match-string-no-properties 3 blink)) "No description"))
- (files (org-registry-assoc-all link))
+ (files (org-registry-assoc-all link))
file point selection tmphist)
(cond ((and files visit)
;; result(s) to visit
@@ -103,7 +103,7 @@ buffer."
(setq tmphist (mapcar (lambda(entry)
(format "%s (%d) [%s]"
(nth 3 entry) ; file
- (nth 2 entry) ; point
+ (nth 2 entry) ; point
(nth 1 entry))) files))
(setq selection (completing-read "File: " tmphist
nil t nil 'tmphist))
@@ -123,7 +123,7 @@ buffer."
;; result(s) to display
(cond ((eq 1 (length files))
;; show one file
- (message "Link in file %s (%d) [%s]"
+ (message "Link in file %s (%d) [%s]"
(nth 3 (car files))
(nth 2 (car files))
(nth 1 (car files))))
@@ -132,25 +132,33 @@ buffer."
(defun org-registry-display-files (files link)
"Display files in a separate window."
- (switch-to-buffer-other-window
+ (switch-to-buffer-other-window
(get-buffer-create " *Org registry info*"))
(erase-buffer)
(insert (format "Files pointing to %s:\n\n" link))
(let (file)
(while (setq file (pop files))
- (insert (format "%s (%d) [%s]\n" (nth 3 file)
+ (insert (format "%s (%d) [%s]\n" (nth 3 file)
(nth 2 file) (nth 1 file)))))
(shrink-window-if-larger-than-buffer)
(other-window 1))
(defun org-registry-assoc-all (link &optional registry)
"Return all associated entries of LINK in the registry."
- (let ((reg (or org-registry-alist registry)) entry output)
+ (let ((reg (copy-list (or org-registry-alist registry))) entry
output)
(while (setq entry (assoc link reg))
(add-to-list 'output entry)
(setq reg (delete entry reg)))
(nreverse output)))
+(defun org-registry-find-all (test &optional registry)
+ "Return all entries satisfying `test' in the registry."
+ (let ((reg (copy-list (or org-registry-alist registry))) entry
output)
+ (while (setq entry (find-if test reg))
+ (add-to-list 'output entry)
+ (setq reg (delete entry reg)))
+ (nreverse output)))
+
;;;###autoload
(defun org-registry-visit ()
"If an Org file contains a link to the current location, visit
@@ -160,7 +168,7 @@ this file."
;;;###autoload
(defun org-registry-initialize (&optional from-scratch)
- "Initialize `org-registry-alist'.
+ "Initialize `org-registry-alist'.
If FROM-SCRATCH is non-nil or the registry does not exist yet,
create a new registry from scratch and eval it. If the registry
exists, eval `org-registry-file' and make it the new value for
@@ -174,7 +182,7 @@ exists, eval `org-registry-file' and make it the
new value for
(mapc (lambda (entry)
(add-to-list 'org-registry-alist entry))
(org-registry-get-entries file)))
- (when from-scratch
+ (when from-scratch
(org-registry-create org-registry-alist)))
;; eval the registry file
(with-temp-buffer
@@ -186,8 +194,8 @@ exists, eval `org-registry-file' and make it the
new value for
"Call `org-registry-update' after saving in Org-mode.
Use with caution. This could slow down things a bit."
(interactive)
- (add-hook 'org-mode-hook
- (lambda() (add-hook 'after-save-hook
+ (add-hook 'org-mode-hook
+ (lambda() (add-hook 'after-save-hook
'org-registry-update t t))))
(defun org-registry-get-entries (file)
@@ -231,7 +239,7 @@ Use with caution. This could slow down things a
bit."
(re-search-forward "^(\"" nil t)
(goto-char (match-beginning 0))
(mapc (lambda (elem)
- (insert (with-output-to-string (prin1 elem)) "\n"))
+ (insert (with-output-to-string (prin1 elem)) "\n"))
new-entries)
(save-buffer)
(kill-buffer (current-buffer)))
--
1.6.3.3
_______________________________________________
Emacs-orgmode mailing list
Remember: use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
- Carsten
_______________________________________________
Emacs-orgmode mailing list
Remember: use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode