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