planner-registry.el

   1 ;;; planner-registry.el --- registry for Planner
   2
   3 ;; Copyright (C) 2005, 2006 Free Software Foundation, Inc.
   4 ;; Time-stamp: <2006-01-23 18:21:18 guerry>
   5 ;;
   6 ;; Author: Bastien Guerry <bzg@altern.org>
   7 ;; Version: $Id: planner-registry.el,v 0.1 2006/01/23 17:21:21 guerry Exp $
   8 ;; Keywords: planner muse registry
   9
  10 ;; This file is part of Planner.  It is not part of GNU Emacs.
  11
  12 ;; Planner is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published
  14 ;; by the Free Software Foundation; either version 2, or (at your
  15 ;; option) any later version.
  16
  17 ;; Planner is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with Planner; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; This module provides a way to keep track of all the URLs in your
  30 ;; projects, and to list them depending on the current buffer.  The
  31 ;; URLs are defined in `muse-url-protocols' - it does NOT include
  32 ;; wikiwords (for now).
  33 ;;
  34 ;; If a URL has been created by `planner-create-task-from-buffer',
  35 ;; going to that buffer and calling `planner-registry-show' will show you
  36 ;; where planner put the URL.
  37 ;;
  38 ;; Say for example that you created a task from an e-mail.  Go to that
  39 ;; e-mail and call `planner-registry-show': it will open a new buffer
  40 ;; displaying the files (in a muse links format) where a link to this
  41 ;; e-mail has been added.
  42
  43 ;;; Getting Started:
  44
  45 ;; Put this in your init file:
  46 ;;
  47 ;; (require 'planner-registry)
  48 ;; (planner-registry-initialize)
  49 ;;
  50 ;; You MUST put it after the place where where Planner has been loaded
  51 ;; in your configuration file.
  52 ;;
  53 ;; If you want the registry to be updated each time you save a Planner
  54 ;; file, add this:
  55 ;;
  56 ;; (planner-registry-insinuate)
  57 ;;
  58 ;; If you don't want to update the registry each time a file is
  59 ;; written, you can do it manually with `planner-registry-update': it
  60 ;; will update the registry for saved muse/planner buffers only.
  61 ;;
  62 ;; There's no default `define-key' for `planner-registry-show' because
  63 ;; it's not bounded to one particular mode.  You can bound it to
  64 ;; whatever you want.
  65
  66 ;;; Todo:
  67
  68 ;; 1) Better windows manipulations
  69 ;; 2) Wiki links support
  70
  71 ;;; Problems:
  72
  73 ;; If you're using this with Planner, the default value of
  74 ;; `planner-bibtex-separator' must be changed from ":" to something
  75 ;; else.
  76 ;;
  77 ;; (setq planner-bibtex-separator "#")
  78 ;;
  79 ;; "#" as a separator enables you to perform fuzzy-matching on bibtex
  80 ;; URLs as well.
  81
  82 ;;; History:
  83
  84 ;; 2005.11.22 - new release.
  85 ;; 2005.11.18 - first release.
  86
  87 ;;; Contributors:
  88
  89 ;;; Code:
  90
  91 ;;;_* Prerequisites
  92
  93 (require 'planner)
  94
  95 ;;;_* Options
  96
  97 (defgroup planner-registry nil
  98   "A registry for Planner."
  99   :prefix "planner-registry-"
 100   :group 'muse)
 101
 102 ;; You can setq this var to what do you like.
 103 (defcustom planner-registry-file
 104   (concat (getenv "HOME") "/.planner-registry.el")
 105   "The registry file."
 106   :type 'string
 107   :group 'planner-registry)
 108
 109 (defcustom planner-registry-min-keyword-size 3
 110   "Minimum size for keywords."
 111   :type 'integer
 112   :group 'planner-registry)
 113
 114 (defcustom planner-registry-max-keyword-size 10
 115   "Maximum size for keywords."
 116   :type 'integer
 117   :group 'planner-registry)
 118
 119 (defcustom planner-registry-max-number-of-keywords 3
 120   "Maximum number of keywords."
 121   :type 'integer
 122   :group 'planner-registry)
 123
 124 (defcustom planner-registry-ignore-keywords
 125   '("E-Mail" "from" "www")
 126   "A list of ignored keywords."
 127   :type 'list
 128   :group 'planner-registry)
 129
 130 (defcustom planner-registry-show-level 0
 131   "Level for `planner-registry-show'.
 132 0 means that this function shows only exact matches.
 133 1 means that this function also shows descriptive matches.
 134 2 (or more) means that this function also shows fuzzy matches."
 135   :type 'boolean
 136   :group 'planner-registry)
 137
 138 ;;;_* Other variables and constants
 139
 140 (defvar planner-registry-alist nil
 141   "An alist containing the Planner registry.")
 142
 143 (defconst planner-registry-url-regexp
 144   (concat "\\(" (mapconcat 'car muse-url-protocols "\\|") "\\)"
 145           "[^][" muse-regexp-blank "\"'()^`{}\n]*[^][" muse-regexp-blank
 146           "\"'()^`{}.,;\n]+")
 147   "A regexp that matches Muse URL links.")
 148
 149 (defconst planner-registry-link-regexp
 150   (concat "\\[\\[\\(" planner-registry-url-regexp
 151           "\\)\\]\\[\\([^][\n]+\\)\\]\\]")
 152   "A regexp that matches Muse explicit links.")
 153
 154 (defconst planner-registry-url-or-link-regexp
 155   (concat "\\(" planner-registry-url-regexp "\\)\\|"
 156           planner-registry-link-regexp)
 157   "A regexp that matches both Muse URL and explicit links.
 158 The link is returned by `match-string' 3 or 1.
 159 The protocol is returned bu `match-string' 4 or 2.
 160 The description is returned by `match-string' 5")
 161
 162 ;;;_* Core code
 163
 164 ;;;###autoload
 165 (defun planner-registry-initialize (&optional from-scratch)
 166   "Set `planner-registry-alist' from `planner-registry-file'.
 167 If `planner-registry-file' doesn't exist, create it.
 168 If FROM-SCRATCH is non-nil, make the registry from scratch."
 169   (interactive "P")
 170   (if (or (not (file-exists-p planner-registry-file))
 171           from-scratch)
 172       (planner-registry-make-new-registry)
 173     (planner-registry-read-registry))
 174   (message "Planner registry initialized"))
 175
 176 (defun planner-registry-update nil
 177   "Update the registry from the current buffer."
 178   (interactive)
 179   (let* ((from-file (buffer-file-name))
 180          (new-entries
 181           (planner-registry-new-entries from-file)))
 182     (planner-registry-update-registry from-file new-entries))
 183   (with-temp-buffer
 184     (insert-file-contents planner-registry-file)
 185     (eval-buffer)))
 186
 187 (defun planner-registry-insinuate nil
 188   "Call `planner-registry-update' after saving in Planner mode.
 189 Use with caution.  This could slow down things a bit."
 190   (interactive)
 191   (add-hook 'planner-mode-hook
 192             (lambda nil
 193               (add-hook 'after-save-hook 'planner-registry-update t t))))
 194
 195 (defun planner-registry-show (&optional level)
 196   "Show entries at LEVEL.
 197 See `planner-registry-show-level' for details."
 198   (interactive "p")
 199   (let ((annot (run-hook-with-args-until-success
 200                 'planner-annotation-functions))
 201         (level (or level planner-registry-show-level)))
 202     (if (not annot)
 203         (message "Annotation is not supported for this buffer")
 204       (let ((entries (planner-registry-get-entries annot level)))
 205         (if (not entries)
 206             (message
 207              (format "No match (level %d) for \"%s\"" level
 208                      (progn (string-match
 209                              planner-registry-url-or-link-regexp annot)
 210                             (match-string 5 annot))))
 211           (delete-other-windows)
 212           (switch-to-buffer-other-window
 213            (set-buffer (get-buffer-create "*Planner registry*")))
 214           (erase-buffer)
 215           (dolist (elem entries)
 216             (dolist (entry elem)
 217               (insert entry))
 218             (when elem (insert "\n")))
 219           (muse-mode))))))
 220
 221 (defun planner-registry-create nil
 222   "Create `planner-registry-file'."
 223   (let ((items planner-registry-alist)
 224         item)
 225     (with-temp-buffer
 226       (find-file planner-registry-file)
 227       (erase-buffer)
 228       (insert
 229        (with-output-to-string
 230          (princ ";; -*- emacs-lisp -*-\n")
 231          (princ ";; Planner registry\n;; What are you doing here?\n\n")
 232          (princ "(setq planner-registry-alist\n'(\n")
 233          (while items
 234            (when (setq item (pop items))
 235              (prin1 item)
 236              (princ "\n")))
 237          (princ "))\n")))
 238       (save-buffer)
 239       (kill-buffer (current-buffer))))
 240   (message "Planner registry created"))
 241
 242 (defun planner-registry-entry-output (entry)
 243   "Make an output string for ENTRY."
 244   (concat " - [[pos://" (car entry)
 245           "#" (nth 1 entry) "]["
 246           (planner-registry-get-project-name (car entry))
 247           ": " (file-name-nondirectory (car entry))
 248           "]] - [[" (nth 2 entry) "][" (nth 3 entry) "]]\n"))
 249
 250 (defun planner-registry-get-project-name (file)
 251   "Get project name for FILE."
 252   (let ((file1 (directory-file-name
 253                 (file-name-directory file))))
 254     (planner-replace-regexp-in-string "/?[^/]+/" "" file1 t t)))
 255
 256 (defun planner-registry-read-registry nil
 257   "Set `planner-registry-alist' from `planner-registry-file'."
 258   (with-temp-buffer
 259     (find-file planner-registry-file)
 260     (eval-buffer)
 261     (kill-buffer (current-buffer))))
 262
 263 (defun planner-registry-update-registry (from-file new-entries)
 264   "Update the registry FROM-FILE with NEW-ENTRIES."
 265   (with-temp-buffer
 266     (find-file planner-registry-file)
 267     (goto-char (point-min))
 268     (while (re-search-forward
 269             (concat "^(\"" from-file) nil t)
 270       (delete-region (planner-line-beginning-position)
 271                      (planner-line-end-position)))
 272     (goto-char (point-min))
 273     (re-search-forward "^(\"" nil t)
 274     (goto-char (match-beginning 0))
 275     (dolist (elem new-entries)
 276       (insert (with-output-to-string (prin1 elem)) "\n"))
 277     (save-buffer)
 278     (kill-buffer (current-buffer)))
 279     (message (format "Planner registry updated for URLs in %s"
 280                      (file-name-nondirectory
 281                       (buffer-file-name)))))
 282
 283 (defun planner-registry-make-new-registry nil
 284   "Make a new `planner-registry-alist' from scratch."
 285   (setq planner-registry-alist nil)
 286   (let ((muse-directories (mapcar 'caadr muse-project-alist))
 287         muse-directory)
 288     (while muse-directories
 289       (when (setq muse-directory (pop muse-directories))
 290         (mapcar (lambda (file)
 291                   (unless (or (file-directory-p file)
 292                               (let ((case-fold-search nil))
 293                                 (string-match muse-project-ignore-regexp
 294                                               file)))
 295                     (dolist (elem (planner-registry-new-entries file))
 296                       (add-to-list 'planner-registry-alist elem))))
 297                 (directory-files muse-directory t)))))
 298   (planner-registry-create))
 299
 300 (defun planner-registry-new-entries (file)
 301   "List links in FILE that will be put in the registry."
 302   (let (result)
 303     (with-temp-buffer
 304       (insert-file-contents file)
 305       (goto-char (point-min))
 306       (while (re-search-forward planner-registry-url-or-link-regexp nil t)
 307         (let* ((point (number-to-string (match-beginning 0)))
 308                (link (or (match-string-no-properties 3)
 309                          (match-string-no-properties 1)))
 310                (desc (or (match-string-no-properties 5)
 311                          (progn (string-match
 312                                  planner-registry-url-regexp link)
 313                                 (substring
 314                                  link (length (match-string 1 link))))))
 315                (keywords (planner-registry-get-keywords desc))
 316                (ln-keyword (planner-registry-get-link-keywords link)))
 317           (add-to-list 'result
 318                        (list file point link desc keywords ln-keyword)))))
 319     result))
 320
 321 (defun planner-registry-get-entries (annot level)
 322   "Show the relevant entries in the registry.
 323 ANNOT is the annotation for the current buffer.
 324 LEVEL is set interactively or  set to `planner-registry-show-level'."
 325   (when (string-match planner-registry-url-or-link-regexp annot)
 326     (let* ((link (or (match-string 3 annot)
 327                      (match-string 1 annot)))
 328            (desc (or (match-string 5 annot) ""))
 329            exact-match descriptive fuzzy)
 330       (dolist (entry planner-registry-alist)
 331         (let* ((output (planner-registry-entry-output entry))
 332                (keyword (nth 4 entry))
 333                (ln-keyword (nth 5 entry)))
 334           ;; exact matching
 335           (when (equal (nth 2 entry) link)
 336             (add-to-list 'exact-match output))
 337           ;; descriptive matching
 338           (when (and (> level 0) (equal (nth 3 entry) desc))
 339             (unless (member output exact-match)
 340               (add-to-list 'descriptive output)))
 341           ;; fuzzy matching
 342           (when (and (> level 1)
 343                      (or (string-match ln-keyword link)
 344                          (string-match keyword desc)))
 345             ;; use (planner-registry-get-keywords)?
 346             (unless (or (member output exact-match)
 347                         (member output descriptive))
 348               (add-to-list 'fuzzy output)))))
 349       (when exact-match
 350         (add-to-list 'exact-match
 351                      (concat "* Exact match(es):\n\n")))
 352       (when descriptive
 353         (add-to-list 'descriptive
 354                      (concat "* Description match(es):\n\n")))
 355       (when fuzzy
 356         (add-to-list 'fuzzy
 357                      (concat "* Fuzzy match(es):\n\n")))
 358       (cond (fuzzy (list exact-match descriptive fuzzy))
 359             (descriptive (list exact-match descriptive))
 360             (exact-match (list exact-match))
 361             (t nil)))))
 362
 363 (defun planner-registry-get-link-keywords (link)
 364   "Make a list of keywords for LINK."
 365   (setq link (car (split-string link "#" t))))
 366
 367 (defun planner-registry-get-keywords (desc)
 368   "Make a list of keywords for DESC."
 369   (let ((kw (split-string desc "[ ./]+" t)))
 370     (mapcar (lambda (wd) (setq kw (delete wd kw)))
 371             planner-registry-ignore-keywords)
 372     (setq kw
 373           (mapcar (lambda (a)
 374                     (when (>= (length a) planner-registry-min-keyword-size)
 375                       (substring
 376                        a 0 (if (> (length a) planner-registry-max-keyword-size)
 377                                planner-registry-max-keyword-size (length a)))))
 378                   kw))
 379     (setq kw (delq nil kw))
 380     (setq kw (nthcdr (- (length kw)
 381                         planner-registry-max-number-of-keywords) kw))
 382     (mapconcat (lambda (e) e) kw ".*")))
 383
 384 (provide 'planner-registry)
 385
 386 ;;; planner-registry.el ends here
 387 ;;
 388 ;; Local Variables:
 389 ;; indent-tabs-mode: t
 390 ;; tab-width: 8
 391 ;; End: