mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2025-01-06 11:55:57 +00:00
Added org-expiry.el org-registry.el org-iswitchb.el org2rem.el to ./CONTRIB/lisp/
This commit is contained in:
Bastien Guerry
parent
1fe4b6b73c
commit
2ef581cfce
346
CONTRIB/lisp/org-expiry.el
Normal file
346
CONTRIB/lisp/org-expiry.el
Normal file
@ -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
|
||||
90
CONTRIB/lisp/org-iswitchb.el
Normal file
90
CONTRIB/lisp/org-iswitchb.el
Normal file
@ -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
|
||||
272
CONTRIB/lisp/org-registry.el
Normal file
272
CONTRIB/lisp/org-registry.el
Normal file
@ -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
|
||||
105
CONTRIB/lisp/org2rem.el
Normal file
105
CONTRIB/lisp/org2rem.el
Normal file
@ -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
|
||||
Loading…
Reference in New Issue
Block a user