emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: James TD Smith <ahktenzero@mohorovi.cc>
To: emacs-orgmode@gnu.org
Subject: [PATCH 3/3] Some small fixes in org-registry.
Date: Tue, 20 Oct 2009 03:51:30 +0100	[thread overview]
Message-ID: <1256007090-32050-4-git-send-email-ahktenzero@mohorovi.cc> (raw)
In-Reply-To: <1256007090-32050-3-git-send-email-ahktenzero@mohorovi.cc>

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  <ahktenzero@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.dominik@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

  reply	other threads:[~2009-10-20  2:51 UTC|newest]

Thread overview: 9+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2009-10-20  2:51 A few small patches James TD Smith
2009-10-20  2:51 ` [PATCH 1/3] Add a missing entry, and fix some formatting in the changelog James TD Smith
2009-10-20  2:51   ` [PATCH 2/3] Add a way to display names for tag groups in fast tag selection James TD Smith
2009-10-20  2:51     ` James TD Smith [this message]
2009-10-21  8:43       ` [PATCH 3/3] Some small fixes in org-registry Carsten Dominik
2009-10-21 23:47         ` Andreas Burtzlaff
2009-10-22 13:24           ` Carsten Dominik
2009-10-21  8:43     ` [PATCH 2/3] Add a way to display names for tag groups in fast tag selection Carsten Dominik
2009-10-21  8:39   ` [PATCH 1/3] Add a missing entry, and fix some formatting in the changelog Carsten Dominik

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1256007090-32050-4-git-send-email-ahktenzero@mohorovi.cc \
    --to=ahktenzero@mohorovi.cc \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).