experimental/muse-protocol-iw.el

   1 ;;; muse-protocol-iw.el --- implement an interwiki protocol handler
   2
   3 ;; Copyright (C) 2006 Free Software Foundation, Inc.
   4
   5 ;; Author: Phillip Lord <phillip.lord@newcastle.ac.uk>
   6
   7 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
   8
   9 ;; Emacs Muse is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published
  11 ;; by the Free Software Foundation; either version 3, or (at your
  12 ;; option) any later version.
  13
  14 ;; Emacs Muse is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with Emacs Muse; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; This defines a new url type, which is like the interwiki support of
  27 ;; muse-wiki. You can also publish to a different directory structure
  28 ;; from the file space (which I do for historical reasons). So a link
  29 ;; like
  30
  31 ;; [[iw:home\emacs][hello]] will work from any of the individual muse
  32 ;; projects that I have.
  33
  34 (require 'muse-protocols)
  35
  36 (add-to-list 'muse-url-protocols
  37              '("iw:" muse-browse-url-iw muse-resolve-url-iw))
  38
  39 (defvar muse-interwiki-protocol-alist
  40       '(("home" "/" "~/src/ht/home_website")
  41         ("silly" "/silly/" "~/src/ht/home_website/silly")
  42         ("energy" "/energy/" "~/src/ht/home_website/energy")
  43         ("journal" "/journal/" "~/src/ht/home_website/journal")))
  44
  45 (defun muse-resolve-url-iw (url)
  46   (when (string-match "\\`iw:\\([a-zA-Z]*\\)\\\\\\(.+\\)" url)
  47     (let* ((wiki-resolve
  48             (assoc (match-string 1 url)
  49                    muse-interwiki-protocol-alist))
  50            (publish-resolve
  51             (nth 1 wiki-resolve)))
  52       (concat publish-resolve (match-string 2 url)))))
  53
  54 ;; this doesn't handle anchors properly yet.
  55 (defun muse-browse-url-iw (url)
  56   (when (string-match "\\`iw:\\([a-zA-Z]*\\)\\\\\\(.+\\)#?\\(.*\\)" url)
  57     (let* ((wiki-resolve
  58             (assoc (match-string 1 url)
  59                    muse-interwiki-protocol-alist))
  60            (browse-resolve
  61             (or (nth 2 wiki-resolve)
  62                 (nth 1 wiki-resolve))))
  63       (find-file
  64        (concat browse-resolve "/"
  65                (match-string 2 url)
  66                ".muse")))))
  67
  68
  69 (provide 'muse-protocol-iw)
  70 ;; muse-protocol-iw.el ends here