Added org-expiry.el org-registry.el org-iswitchb.el org2rem.el to ./CONTRIB/lisp/

CONTRIB/lisp/org-expiry.el

@@ -0,0 +1,346 @@
+;;; org-expiry.el --- expiry mechanism for Org entries
+;;
+;; Copyright 2007 2008 Bastien Guerry
+;;
+;; Author: bzg AT altern DOT org
+;; Version: 0.2
+;; Keywords: org expiry
+;; URL: http://www.cognition.ens.fr/~guerry/u/org-expiry.el
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;;; Commentary:
+;;
+;; This gives you a chance to get rid of old entries in your Org files
+;; by expiring them.  
+;;
+;; By default, entries that have no EXPIRY property are considered to be
+;; new (i.e. 0 day old) and only entries older than one year go to the
+;; expiry process, which consist in adding the ARCHIVE tag.  None of
+;; your tasks will be deleted with the default settings.
+;;
+;; When does an entry expires?
+;; 
+;; Consider this entry:
+;;
+;; * Stop watching TV
+;;   :PROPERTIES:
+;;   :CREATED:  <2008-01-07 lun 08:01>
+;;   :EXPIRY:   <2008-01-09 08:01>
+;;   :END:
+;; 
+;; This entry will expire on the 9th, january 2008. 
+
+;; * Stop watching TV
+;;   :PROPERTIES:
+;;   :CREATED:  <2008-01-07 lun 08:01>
+;;   :EXPIRY:   +1w
+;;   :END:
+;;
+;; This entry will expire on the 14th, january 2008, one week after its
+;; creation date.
+;;
+;; What happen when an entry is expired?  Nothing until you explicitely
+;; M-x org-expiry-process-entries When doing this, org-expiry will check
+;; for expired entries and request permission to process them.
+;; 
+;; Processing an expired entries means calling the function associated
+;; with `org-expiry-handler-function'; the default is to add the tag
+;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive 
+;; the subtree.  
+;;
+;; Is this useful?  Well, when you're in a brainstorming session, it
+;; might be useful to know about the creation date of an entry, and be
+;; able to archive those entries that are more than xxx days/weeks old.
+;; 
+;; When you're in such a session, you can insinuate org-expiry like
+;; this: M-x org-expiry-insinuate 
+;; 
+;; Then, each time you're pressing M-RET to insert an item, the CREATION
+;; property will be automatically added.  Same when you're scheduling or
+;; deadlining items.  You can deinsinuate: M-x org-expiry-deinsinuate
+
+;;; Code:
+
+;;; User variables:
+
+(defgroup org-expiry nil
+  "Org expiry process."
+  :tag "Org Expiry"
+  :group 'org)
+
+(defcustom org-expiry-created-property-name "CREATED"
+  "The name of the property for setting the creation date."
+  :type 'string
+  :group 'org-expiry)
+
+(defcustom org-expiry-expiry-property-name "EXPIRY"
+  "The name of the property for setting the expiry date/delay."
+  :type 'string
+  :group 'org-expiry)
+
+(defcustom org-expiry-keyword "EXPIRED"
+  "The default keyword for `org-expiry-add-keyword'."
+  :type 'string
+  :group 'org-expiry)
+
+(defcustom org-expiry-wait "+1y"
+  "Time span between the creation date and the expiry.
+The default value for this variable (\"+1y\") means that entries
+will expire if there are at least one year old.
+
+If the expiry delay cannot be retrieved from the entry or the
+subtree above, the expiry process compares the expiry delay with
+`org-expiry-wait'.  This can be either an ISO date or a relative
+time specification.  See `org-read-date' for details."
+  :type 'string
+  :group 'org-expiry)
+
+(defcustom org-expiry-created-date "+0d"
+  "The default creation date.
+The default value of this variable (\"+0d\") means that entries
+without a creation date will be handled as if they were created
+today.
+
+If the creation date cannot be retrieved from the entry or the
+subtree above, the expiry process will compare the expiry delay
+with this date.  This can be either an ISO date or a relative
+time specification.  See `org-read-date' for details on relative
+time specifications."
+  :type 'string
+  :group 'org-expiry)
+
+(defcustom org-expiry-handler-function 'org-toggle-archive-tag
+  "Function to process expired entries.
+Possible candidates for this function are:
+
+`org-toggle-archive-tag'
+`org-expiry-add-keyword'
+`org-expiry-archive-subtree'"
+  :type 'function
+  :group 'org-expiry)
+
+(defcustom org-expiry-confirm-flag t
+  "Non-nil means confirm expiration process."
+  :type '(choice
+	  (const :tag "Always require confirmation" t)
+	  (const :tag "Do not require confirmation" nil)
+	  (const :tag "Require confirmation in interactive expiry process"
+		 interactive))
+  :group 'org-expiry)
+
+(defcustom org-expiry-advised-functions
+  '(org-scheduled org-deadline org-time-stamp)
+  "A list of advised functions.
+`org-expiry-insinuate' will activate the expiry advice for these
+functions.  `org-expiry-deinsinuate' will deactivate them."
+  :type 'boolean
+  :group 'list)
+
+;;; Advices and insinuation:
+
+(defadvice org-schedule (after org-schedule-update-created)
+  "Update the creation-date property when calling `org-schedule'."
+  (org-expiry-insert-created))
+
+(defadvice org-deadline (after org-deadline-update-created)
+  "Update the creation-date property when calling `org-deadline'."
+  (org-expiry-insert-created))
+
+(defadvice org-time-stamp (after org-time-stamp-update-created)
+  "Update the creation-date property when calling `org-time-stamp'."
+  (org-expiry-insert-created))
+
+(defun org-expiry-insinuate (&optional arg)
+  "Add hooks and activate advices for org-expiry.
+If ARG, also add a hook to `before-save-hook' in `org-mode' and
+restart `org-mode' if necessary."
+  (interactive "P")
+  (ad-activate 'org-schedule)
+  (ad-activate 'org-time-stamp)
+  (ad-activate 'org-deadline)
+  (add-hook 'org-insert-heading-hook 'org-expiry-insert-created)
+  (add-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
+  (add-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
+  (when arg
+    (add-hook 'org-mode-hook
+	      (lambda() (add-hook 'before-save-hook
+				  'org-expiry-process-entries t t)))
+    ;; need this to refresh org-mode hooks
+    (when (org-mode-p)
+      (org-mode)
+      (if (interactive-p)
+	  (message "Org-expiry insinuated, `org-mode' restarted.")))))
+
+(defun org-expiry-deinsinuate (&optional arg)
+  "Remove hooks and deactivate advices for org-expiry.
+If ARG, also remove org-expiry hook in Org's `before-save-hook'
+and restart `org-mode' if necessary."
+  (interactive "P")
+  (ad-deactivate 'org-schedule)
+  (ad-deactivate 'org-time-stamp)
+  (ad-deactivate 'org-deadline)
+  (remove-hook 'org-insert-heading-hook 'org-expiry-insert-created)
+  (remove-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
+  (remove-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
+  (remove-hook 'org-mode-hook
+	       (lambda() (add-hook 'before-save-hook
+				   'org-expiry-process-entries t t)))
+  (when arg
+    ;; need this to refresh org-mode hooks
+    (when (org-mode-p)
+      (org-mode)
+      (if (interactive-p)
+	  (message "Org-expiry de-insinuated, `org-mode' restarted.")))))
+
+;;; org-expiry-expired-p:
+
+(defun org-expiry-expired-p ()
+  "Check if the entry at point is expired.
+Return nil if the entry is not expired.  Otherwise return the
+amount of time between today and the expiry date.
+
+If there is no creation date, use `org-expiry-created-date'.  
+If there is no expiry date, use `org-expiry-expiry-date'."
+  (let* ((ex-prop org-expiry-expiry-property-name)
+	 (cr-prop org-expiry-created-property-name)
+	 (ct (current-time))
+	 (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t) "+0d")))
+	 (ex-field (or (org-entry-get (point) ex-prop t) org-expiry-wait))
+	 (ex (if (string-match "^[ \t]?[+-]" ex-field)
+		 (time-add cr (time-subtract (org-read-date nil t ex-field) ct))
+	       (org-read-date nil t ex-field))))
+    (if (time-less-p ex ct)
+	(time-subtract ct ex))))
+
+;;; Expire an entry or a region/buffer:
+
+(defun org-expiry-process-entry (&optional force)
+  "Call `org-expiry-handler-function' on entry.
+If FORCE is non-nil, don't require confirmation from the user.
+Otherwise rely on `org-expiry-confirm-flag' to decide."
+  (interactive "P")
+  (save-excursion
+    (when (interactive-p) (org-reveal))
+    (when (org-expiry-expired-p)
+      (org-back-to-heading)
+      (looking-at org-complex-heading-regexp)
+      (let* ((ov (org-make-overlay (point) (match-end 0)))
+	     (e (org-expiry-expired-p))
+	     (d (time-to-number-of-days e)))
+	(org-overlay-put ov 'face 'secondary-selection)
+	(if (or force
+		(null org-expiry-confirm-flag)
+		(and (eq org-expiry-confirm-flag 'interactive)
+		     (not (interactive)))
+		(and org-expiry-confirm-flag
+		     (y-or-n-p (format "Entry expired by %d days.  Process? " d))))
+	  (funcall 'org-expiry-handler-function))
+	(org-delete-overlay ov)))))
+
+(defun org-expiry-process-entries (beg end)
+  "Process all expired entries between BEG and END.
+The expiry process will run the function defined by
+`org-expiry-handler-functions'."
+  (interactive "r")
+  (save-excursion
+    (let ((beg (if (org-region-active-p)
+		   (region-beginning) (point-min)))
+	  (end (if (org-region-active-p)
+		   (region-end) (point-max))))
+      (goto-char beg)
+      (let ((expired 0) (processed 0))
+	(while (and (outline-next-heading) (< (point) end))
+	  (when (org-expiry-expired-p)
+	    (setq expired (1+ expired))
+	    (if (if (interactive-p)
+		    (call-interactively 'org-expiry-process-entry)
+		  (org-expiry-process-entry))
+		(setq processed (1+ processed)))))
+	(if (equal expired 0)
+	    (message "No expired entry")
+	  (message "Processed %d on %d expired entries"
+		   processed expired))))))
+
+;;; Insert created/expiry property:
+
+(defun org-expiry-insert-created (&optional arg)
+  "Insert or update a property with the creation date.
+If ARG, always update it.  With one `C-u' prefix, silently update
+to today's date.  With two `C-u' prefixes, prompt the user for to
+update the date."
+  (interactive "P")
+  (let* ((d (org-entry-get (point) org-expiry-created-property-name))
+	 d-time d-hour)
+    (when (or (null d) arg)
+      ;; update if no date or non-nil prefix argument
+      ;; FIXME Use `org-time-string-to-time' 
+      (setq d-time (if d (apply 'encode-time (org-parse-time-string d))
+		     (current-time)))
+      (setq d-hour (format-time-string "%H:%M" d-time))
+      (save-excursion
+	(org-entry-put
+	 (point) org-expiry-created-property-name
+	 ;; two C-u prefixes will call org-read-date
+	 (if (equal arg '(16))
+	     (concat "<" (org-read-date
+			  nil nil nil nil d-time d-hour) ">")
+	   (format-time-string (cdr org-time-stamp-formats))))))))
+
+(defun org-expiry-insert-expiry (&optional today)
+  "Insert a property with the expiry date.
+With one `C-u' prefix, don't prompt interactively for the date
+and insert today's date."
+  (interactive "P")
+  (let* ((d (org-entry-get (point) org-expiry-expiry-property-name))
+	 d-time d-hour)
+    (setq d-time (if d (apply 'encode-time (org-parse-time-string d))
+		   (current-time)))
+    (setq d-hour (format-time-string "%H:%M" d-time))
+    (save-excursion
+      (org-entry-put
+       (point) org-expiry-expiry-property-name
+       (if today (format-time-string (cdr org-time-stamp-formats))
+	 (concat "<" (org-read-date
+		      nil nil nil nil d-time d-hour) ">"))))))
+
+;;; Functions to process expired entries:
+
+(defun org-expiry-archive-subtree ()
+  "Archive the entry at point if it is expired."
+  (interactive)
+  (save-excursion
+    (if (org-expiry-expired-p)
+	(org-archive-subtree)
+      (if (interactive-p)
+	  (message "Entry at point is not expired.")))))
+
+(defun org-expiry-add-keyword (&optional keyword)
+  "Add KEYWORD to the entry at point if it is expired."
+  (interactive "sKeyword: ")
+  (if (or (member keyword org-todo-keywords-1)
+	  (setq keyword org-expiry-keyword))
+      (save-excursion
+	(if (org-expiry-expired-p)
+	    (org-todo keyword)
+	  (if (interactive-p)
+	      (message "Entry at point is not expired."))))
+    (error "\"%s\" is not a to-do keyword in this buffer" keyword)))
+
+;; FIXME what about using org-refile ?
+
+(provide 'org-expiry)
+
+;;; org-expiry.el ends here

CONTRIB/lisp/org-iswitchb.el

@@ -0,0 +1,90 @@
+;;; org-iswitchb.el --- use iswitchb to select Org buffer
+;;
+;; Copyright 2007 2008 Bastien Guerry
+;;
+;; Author: bzg AT altern DOT org
+;; Version: 0.1
+;; Keywords: Org buffer
+;; URL: http://www.cognition.ens.fr/~guerry/u/org-iswitchb.el
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;;; Commentary:
+;;
+;; Put this file into your load-path and the following into your ~/.emacs:
+;;   (require 'org-iswitchb)
+;;
+;;; Code:
+
+(defun org-iswitchb (&optional arg)
+  "Use `iswitchb-read-buffer' to prompt for an Org buffer to switch to.
+With a prefix argument, restrict available to files.
+With two prefix arguments, restrict available buffers to agenda files.
+
+Due to some yet unresolved reason, global function
+`iswitchb-mode' needs to be active for this function to work."
+  (interactive "P")
+  (eval-when-compile
+    (require 'iswitchb))
+  (let ((enabled iswitchb-mode) blist)
+    (or enabled (iswitchb-mode 1))
+    (setq blist (cond ((equal arg '(4)) (org-buffer-list 'files))
+		      ((equal arg '(16)) (org-buffer-list 'agenda))
+		      (t (org-buffer-list))))
+   (unwind-protect
+       (let ((iswitchb-make-buflist-hook
+	      (lambda ()
+		(setq iswitchb-temp-buflist
+		      (mapcar 'buffer-name blist)))))
+	 (switch-to-buffer
+	  (iswitchb-read-buffer
+	   "Switch-to: " nil t))
+	 (or enabled (iswitchb-mode -1))))))
+
+(defun org-buffer-list (&optional predicate tmp)
+  "Return a list of Org buffers.
+PREDICATE can be either 'export, 'files or 'agenda.
+
+'export restrict the list to Export buffers.
+'files  restrict the list to buffers visiting Org files.
+'agenda restrict the list to buffers visiting agenda files.
+
+If TMP is non-nil, don't include temporary buffers."
+  (let (filter blist)
+    (setq filter 
+	  (cond ((eq predicate 'files) "\.org$")
+		((eq predicate 'export) "\*Org .*Export")
+		(t "\*Org \\|\.org$")))
+    (setq blist
+	  (mapcar 
+	   (lambda(b)
+	     (let ((bname (buffer-name b))
+		   (bfile (buffer-file-name b)))
+	       (if (and (string-match filter bname)
+			(if (eq predicate 'agenda)
+			    (member bfile
+				    (mapcar (lambda(f) (file-truename f))
+					    org-agenda-files)) t)
+			(if tmp (not (string-match "tmp" bname)) t)) b)))
+	   (buffer-list)))
+    (delete nil blist)))
+
+(provide 'org-iswitchb)
+
+;;;  User Options, Variables
+
+;;; org-iswitchb.el ends here

CONTRIB/lisp/org-registry.el

@@ -0,0 +1,272 @@
+;;; org-registry.el --- a registry for Org links
+;;
+;; Copyright 2007 2008 Bastien Guerry
+;;
+;; Emacs Lisp Archive Entry
+;; Filename: org-registry.el
+;; Version: 0.1a
+;; Author: Bastien Guerry <bzg AT altern DOT org>
+;; Maintainer: Bastien Guerry <bzg AT altern DOT org>
+;; Keywords: org, wp, registry
+;; Description: Shows Org files where the current buffer is linked
+;; URL: http://www.cognition.ens.fr/~guerry/u/org-registry.el
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+;;
+;; This library add a registry to your Org setup.
+;;
+;; Org files are full of links inserted with `org-store-link'. This links
+;; point to e-mail, webpages, files, dirs, info pages, man pages, etc.
+;; Actually, they come from potentially *everywhere* since Org lets you
+;; define your own storing/following functions.
+;;
+;; So, what if you are on a e-mail, webpage or whatever and want to know if
+;; this buffer has already been linked to somewhere in your agenda files?
+;;
+;; This is were org-registry comes in handy.
+;;
+;;     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: 
+;;
+;;     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:
+
+(eval-when-compile
+  (require 'cl))
+
+(defgroup org-registry nil
+  "A registry for Org."
+  :group 'org)
+
+(defcustom org-registry-file
+  (concat (getenv "HOME") "/.org-registry.el")
+  "The Org registry file."
+  :group 'org-registry
+  :type 'file)
+
+(defcustom org-registry-find-file 'find-file-other-window
+  "How to find visit files."
+  :type 'function
+  :group 'org-registry)
+
+(defvar org-registry-alist nil
+  "An alist containing the Org registry.")
+
+;; FIXME name this org-before-first-heading-p?
+(defun org-registry-before-first-heading-p ()
+  "Before first heading?"
+  (save-excursion
+    (null (re-search-backward "^\\*+ " nil t))))
+
+;;;###autoload
+(defun org-registry-show (&optional visit)
+  "Show Org files where there are links pointing to the current
+buffer."
+  (interactive "P")
+  (org-registry-initialize)
+  (let* ((blink (or (org-remember-annotation) ""))
+	 (link (when (string-match org-bracket-link-regexp blink)
+		 (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)) 
+	 file point selection tmphist)
+    (cond ((and files visit)
+	   ;; result(s) to visit
+	   (cond ((< 1 (length files))
+		  ;; more than one result
+		  (setq tmphist (mapcar (lambda(entry)
+					  (format "%s (%d) [%s]"
+						  (nth 3 entry) ; file
+						  (nth 2 entry) ; point 
+						  (nth 1 entry))) files))
+		  (setq selection (completing-read "File: " tmphist
+						   nil t nil 'tmphist))
+		  (string-match "\\(.+\\) (\\([0-9]+\\))" selection)
+		  (setq file (match-string 1 selection))
+		  (setq point (string-to-number (match-string 2 selection))))
+		 ((eq 1 (length files))
+		  ;; just one result
+		  (setq file (nth 3 (car files)))
+		  (setq point (nth 2 (car files)))))
+	   ;; visit the (selected) file
+	   (funcall org-registry-find-file file)
+	   (goto-char point)
+	   (unless (org-registry-before-first-heading-p)
+	     (org-show-context)))
+	  ((and files (not visit))
+	   ;; result(s) to display
+	   (cond  ((eq 1 (length files))
+		   ;; show one file
+		   (message "Link in file %s (%d) [%s]" 
+			    (nth 3 (car files))
+			    (nth 2 (car files))
+			    (nth 1 (car files))))
+		  (t (org-registry-display-files files link))))
+	  (t (message "No link to this in org-agenda-files")))))
+
+(defun org-registry-display-files (files link)
+  "Display files in a separate 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) 
+		      (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)
+    (while (setq entry (assoc link 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
+this file."
+  (interactive)
+  (org-registry-show t))
+
+;;;###autoload
+(defun org-registry-initialize (&optional from-scratch)
+  "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
+`org-registry-alist'."
+  (interactive "P")
+  (if (or from-scratch (not (file-exists-p org-registry-file)))
+      ;; create a new registry
+      (let ((files org-agenda-files) file)
+	(while (setq file (pop files))
+	  (setq file (expand-file-name file))
+	  (mapc (lambda (entry)
+		  (add-to-list 'org-registry-alist entry))
+		(org-registry-get-entries file)))
+	(when from-scratch 
+	  (org-registry-create org-registry-alist)))
+    ;; eval the registry file
+    (with-temp-buffer
+      (insert-file-contents org-registry-file)
+      (eval-buffer))))
+
+;;;###autoload
+(defun org-registry-insinuate ()
+  "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 
+				'org-registry-update t t))))
+
+(defun org-registry-get-entries (file)
+  "List Org links in FILE that will be put in the registry."
+  (let (bufstr result)
+    (with-temp-buffer
+      (insert-file-contents file)
+      (goto-char (point-min))
+      (while (re-search-forward org-angle-link-re nil t)
+	(let* ((point (match-beginning 0))
+	       (link (match-string-no-properties 0))
+	       (desc (match-string-no-properties 0)))
+	    (add-to-list 'result (list link desc point file))))
+      (goto-char (point-min))
+      (while (re-search-forward org-bracket-link-regexp nil t)
+	(let* ((point (match-beginning 0))
+	       (link (match-string-no-properties 1))
+	       (desc (or (match-string-no-properties 3) "No description")))
+	    (add-to-list 'result (list link desc point file)))))
+    ;; return the list of new entries
+    result))
+
+;;;###autoload
+(defun org-registry-update ()
+  "Update the registry for the current Org file."
+  (interactive)
+  (unless (org-mode-p) (error "Not in org-mode"))
+  (let* ((from-file (expand-file-name (buffer-file-name)))
+	 (new-entries (org-registry-get-entries from-file)))
+    (with-temp-buffer
+      (unless (file-exists-p org-registry-file)
+	(org-registry-initialize t))
+      (find-file org-registry-file)
+      (goto-char (point-min))
+      (while (re-search-forward (concat from-file "\")$") nil t)
+	(let ((end (1+ (match-end 0)))
+	      (beg (progn (re-search-backward "^(\"" nil t)
+			  (match-beginning 0))))
+	(delete-region beg end)))
+      (goto-char (point-min))
+      (re-search-forward "^(\"" nil t)
+      (goto-char (match-beginning 0))
+      (mapc (lambda (elem)
+	      (insert (with-output-to-string (prin1 elem)) "\n")) 
+	    new-entries)
+      (save-buffer)
+      (kill-buffer (current-buffer)))
+    (message (format "Org registry updated for %s"
+		     (file-name-nondirectory from-file)))))
+
+(defun org-registry-create (entries)
+  "Create `org-registry-file' with ENTRIES."
+  (let (entry)
+    (with-temp-buffer
+      (find-file org-registry-file)
+      (erase-buffer)
+      (insert
+       (with-output-to-string
+	 (princ ";; -*- emacs-lisp -*-\n")
+	 (princ ";; Org registry\n")
+	 (princ ";; You shouldn't try to modify this buffer manually\n\n")
+	 (princ "(setq org-registry-alist\n'(\n")
+	 (while entries
+	   (when (setq entry (pop entries))
+	     (prin1 entry)
+	     (princ "\n")))
+	 (princ "))\n")))
+      (save-buffer)
+      (kill-buffer (current-buffer))))
+  (message "Org registry created"))
+
+(provide 'org-registry)
+
+;;;  User Options, Variables
+
+;;; org-registry.el ends here

CONTRIB/lisp/org2rem.el

@@ -0,0 +1,105 @@
+;;; org2rem.el --- Convert org appointments into reminders
+
+;; Copyright 2006 Bastien Guerry
+;;
+;; Author: bzg AT altern DOT fr
+;; Version: $Id: org2rem.el,v 0.1 2006/12/04 09:21:03 guerry Exp guerry $
+;; Keywords: org-mode remind reminder appointment diary calendar
+;; X-URL: http://www.cognition.ens.fr/~guerry/u/org2rem.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; Not so much to say here.  Just try org2rem in your org-mode buffer.
+
+;; Put this file into your load-path and the following into your ~/.emacs:
+;;   (require 'org2rem)
+
+;;; Code:
+
+(provide 'org2rem)
+(eval-when-compile
+  (require 'cl))
+
+(defvar org2rem-scheduled-reminders nil)
+(defvar org2rem-deadline-reminders nil)
+(defvar org2rem-scheduled-remind-file 
+  "~/.reminders.org.scheduled")
+(defvar org2rem-deadline-remind-file 
+  "~/.reminders.org.deadline")
+
+(defun org2rem-list-reminders (regexp)
+  "Make a list of appointments. 
+REGEXP is either SCHEDULED: or DEADLINE:."
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward 
+	    (concat "^[ \t]*" regexp
+		    "[ \t]*"  org-ts-regexp2) nil t)
+      (let* ((system-time-locale "C") ;; make sure we use english dates
+	     (year (string-to-number (match-string-no-properties 2)))
+	     (month (string-to-number (match-string-no-properties 3)))
+	     (day (string-to-number (match-string-no-properties 4)))
+	     (encoded-time (encode-time 0 0 0 day month year))
+	     (rem-time (format-time-string " %d %b %Y " encoded-time))
+	     task rem-task)
+	(save-excursion
+	  (re-search-backward org-todo-line-regexp nil t)
+	  (setq task
+		(replace-regexp-in-string 
+		 org-bracket-link-regexp 
+		 "\\3" (match-string-no-properties 3)))
+	  (setq rem-task (concat "REM" rem-time "MSG " task "%"))
+	  (if (equal regexp org-scheduled-string)
+	      (push rem-task org2rem-scheduled-reminders)
+	    (push rem-task org2rem-deadline-reminders)))))))
+
+(defun org2rem-write-file (file reminders)
+  "Write reminders list to files."
+  (with-temp-buffer
+    (find-file file)
+    (erase-buffer)
+    (dolist (rem reminders)
+      (insert rem "\n"))
+    (write-file file)
+    (kill-buffer (file-name-nondirectory file))))
+
+(defun org2rem ()
+  "Convert apptointment from local org-mode buffer to reminders.
+Store scheduled appointments in `org2rem-scheduled-remind-file'
+and `org2rem-deadline-remind-file'."
+  (interactive)
+  (setq org2rem-scheduled-reminders nil)
+  (setq org2rem-deadline-reminders nil)
+  (save-window-excursion
+    (org2rem-list-reminders org-scheduled-string)
+    (org2rem-list-reminders org-deadline-string)
+    (org2rem-write-file "~/.reminders.org.scheduled" 
+			org2rem-scheduled-reminders)
+    (org2rem-write-file "~/.reminders.org.deadline"
+			org2rem-deadline-reminders)))
+
+
+
+;;;;##########################################################################
+;;;;  User Options, Variables
+;;;;##########################################################################
+
+
+
+
+
+;;; org2rem.el ends here