lisp/muse-wiki.el

   1 ;;; muse-wiki.el --- wiki features for muse
   2
   3 ;; Copyright (C) 2005  Free Software Foundation, Inc.
   4
   5 ;; Author: Yann Hodique <Yann.Hodique@lifl.fr>
   6 ;; Keywords:
   7
   8 ;; This file is not part of GNU Emacs.
   9
  10 ;; This file is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This file is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Contributors:
  28
  29 ;;; Code:
  30
  31 (require 'muse-regexps)
  32 (require 'muse-mode)
  33
  34 (eval-when-compile
  35   (require 'muse-colors))
  36
  37 (defgroup muse-wiki nil
  38   "Options controlling the behavior of Emacs Muse Wiki features."
  39   :group 'muse-mode)
  40
  41 (defun muse-wiki-update-wikiword-regexp (sym val)
  42   "Update everything related to `muse-wiki-wikiword-regexp'"
  43   (set sym val)
  44   (if (featurep 'muse-colors)
  45       (muse-configure-highlighting 'muse-colors-markup muse-colors-markup)))
  46
  47 (defcustom muse-wiki-hide-nop-tag t
  48   "If non-nil, hide <nop> tags when coloring a Muse buffer."
  49   :type 'boolean
  50   :group 'muse-wiki)
  51
  52 (defcustom muse-wiki-wikiword-regexp
  53   (concat "\\<\\(\\(?:[" muse-regexp-upper
  54           "][" muse-regexp-lower "]+\\)\\(?:["
  55           muse-regexp-upper "][" muse-regexp-lower "]+\\)+\\)\\>")
  56   "Regexp used to match WikiWords"
  57   :type 'regexp
  58   :group 'muse-wiki
  59   :set 'muse-wiki-update-wikiword-regexp)
  60
  61 (defcustom muse-wiki-use-wikiword t
  62   "Wether to use WikiWord syntax or not"
  63   :type 'boolean
  64   :group 'muse-wiki)
  65
  66 (defvar muse-wiki-interwiki-regexp ""
  67   "Regexp that matches all interwiki links.
  68 This is automatically generated by setting `muse-wiki-interwiki-alist'.
  69 It can also be set by calling `muse-wiki-update-interwiki-regexp'.")
  70
  71 (defun muse-wiki-update-interwiki-regexp (value)
  72   "Update the value of `muse-wiki-interwiki-regexp' based on VALUE
  73 and `muse-project-alist'."
  74   (setq muse-wiki-interwiki-regexp
  75         (concat "\\<\\(" (mapconcat 'car muse-project-alist "\\|")
  76                 (when value (concat "\\|" (mapconcat 'car value "\\|")))
  77                 "\\)\\(?:\\(?:#\\|::\\)\\(\\sw+\\)\\)?\\>"))
  78   (muse-configure-highlighting 'muse-colors-markup muse-colors-markup))
  79
  80 (defcustom muse-wiki-interwiki-alist
  81   '(("EmacsWiki" . "http://www.emacswiki.org/cgi-bin/wiki/"))
  82   "A table of WikiNames that refer to external entities.
  83 The format of this table is an alist, or series of cons cells.
  84 Each cons cell must be of the form:
  85
  86   (WIKINAME . STRING-OR-FUNCTION)
  87
  88 The second part of the cons cell may either be a STRING, which in most
  89 cases should be a URL, or a FUNCTION.  If a function, it will be
  90 called with one argument: the tag applied to the Interwiki name, or
  91 nil if no tag was used.  If the cdr was a STRING and a tag is used,
  92 the tag is simply appended.
  93
  94 Here are some examples:
  95
  96   (\"JohnWiki\" . \"http://alice.dynodns.net/wiki?\")
  97
  98 Referring to [[JohnWiki::EmacsModules]] then really means:
  99
 100   http://alice.dynodns.net/wiki?EmacsModules
 101
 102 If a function is used for the replacement text, you can get creative
 103 depending on what the tag is.  Tags may contain any alphabetic
 104 character, any number, % or _.  If you need other special characters,
 105 use % to specify the hex code, as in %2E.  All browsers should support
 106 this."
 107   :type '(repeat (cons (string :tag "WikiName")
 108                        (choice (string :tag "URL") function)))
 109   :set (function
 110         (lambda (sym value)
 111           (muse-wiki-update-interwiki-regexp value)
 112           (set sym value)))
 113   :group 'muse-wiki)
 114
 115 (defun muse-wiki-resolve-project-page (&optional project page)
 116   "Return the published path from the current page to PAGE of PROJECT.
 117 If PAGE is not specified, use the value of :default in PROJECT.
 118 If PROJECT is not specified, default to first project of
 119 `muse-projects-alist'.
 120
 121 Note that PAGE can have several output directories.  If this is
 122 the case, we will use the first one that matches our current
 123 style and ignore the others."
 124   (setq project (or project (caar muse-project-alist))
 125         page (or page (muse-get-keyword :default
 126                                         (cadr (muse-project project)))))
 127   (let* ((page-path (muse-project-page-file page project))
 128          (remote-style (when page-path (car (muse-project-applicable-styles
 129                                              page-path project))))
 130          (local-style (car (muse-project-applicable-styles
 131                             (or muse-publishing-current-file buffer-file-name
 132                                 ;; astonishingly, sometimes even
 133                                 ;; buffer-file-name is not set!
 134                                 (concat default-directory (buffer-name)))
 135                             (cddr (muse-project-of-file))))))
 136     (if (and remote-style local-style muse-publishing-p)
 137         (muse-publish-output-file
 138          (file-relative-name (expand-file-name
 139                               page (muse-style-element :path remote-style))
 140                              (expand-file-name
 141                               (muse-style-element :path local-style))))
 142           page-path)))
 143
 144 (defun muse-wiki-handle-interwiki (&optional string)
 145   "If STRING or point has an interwiki link, resolve it and
 146 return the first match.
 147 Match 1 is set to the link.
 148 Match 2 is set to the description."
 149   (when (if string (string-match muse-wiki-interwiki-regexp string)
 150           (looking-at muse-wiki-interwiki-regexp))
 151     (let* ((project (match-string 1 string))
 152            (subst (cdr (assoc project muse-wiki-interwiki-alist)))
 153            (word (match-string 2 string)))
 154       (if subst
 155           (if (functionp subst)
 156               (funcall subst word)
 157             (concat subst word))
 158         (and (assoc project muse-project-alist)
 159              (muse-wiki-resolve-project-page project word))))))
 160
 161 (defun muse-wiki-handle-wikiword (&optional string)
 162   "If STRING or point has a WikiWord, return it.
 163 Match 1 is set to the WikiWord."
 164   (when (and muse-wiki-use-wikiword
 165              (if string
 166                  (string-match muse-wiki-wikiword-regexp string)
 167                (looking-at muse-wiki-wikiword-regexp))
 168              (or (and (muse-project-of-file)
 169                       (muse-project-page-file
 170                        (match-string 1 string) muse-current-project t))
 171                  (file-exists-p (match-string 1 string))))
 172     (match-string 1 string)))
 173
 174 ;; Pretty title
 175
 176 (defcustom muse-wiki-publish-small-title-words
 177   '("the" "and" "at" "on" "of" "for" "in" "an" "a")
 178   "Strings that should be downcased in a page title.
 179 This is used by `muse-wiki-publish-pretty-title', which must be
 180 called manually."
 181   :type '(repeat string)
 182   :group 'muse-wiki)
 183
 184 (defun muse-wiki-publish-pretty-title (&optional title)
 185   "Return a pretty version of the given TITLE."
 186   (unless title (setq title (muse-publishing-directive "title")))
 187   (save-match-data
 188     (let ((case-fold-search nil))
 189       (while (string-match (concat "\\([" muse-regexp-upper
 190                                    muse-regexp-lower
 191                                    "]\\)\\([" muse-regexp-upper
 192                                    "0-9]\\)")
 193                            title)
 194         (setq title (replace-match "\\1 \\2" t nil title)))
 195       (let* ((words (split-string title))
 196              (w (cdr words)))
 197         (while w
 198           (if (member (downcase (car w))
 199                       muse-wiki-publish-small-title-words)
 200               (setcar w (downcase (car w))))
 201           (setq w (cdr w)))
 202         (mapconcat 'identity words " ")))))
 203
 204 ;; Coloring setup
 205
 206 (eval-after-load "muse-colors"
 207   '(progn
 208      (defun muse-wiki-colors-nop-tag (beg end)
 209        (add-text-properties beg (+ beg 5)
 210                             '(invisible muse intangible t)))
 211
 212      (add-to-list 'muse-colors-tags
 213                   '("nop" nil nil muse-wiki-colors-nop-tag)
 214                   t)
 215
 216      (add-to-list 'muse-colors-markup
 217                   '(muse-wiki-interwiki-regexp t muse-colors-implicit-link)
 218                   t)
 219      (add-to-list 'muse-colors-markup
 220                   '(muse-wiki-wikiword-regexp t muse-colors-implicit-link)
 221                   t)
 222
 223      (muse-configure-highlighting 'muse-colors-markup muse-colors-markup)))
 224
 225 ;; Publishing setup
 226
 227 (eval-after-load "muse-publish"
 228   '(progn
 229      (add-to-list 'muse-publish-markup-regexps
 230                   '(3100 muse-wiki-interwiki-regexp 0 link)
 231                   t)
 232      (add-to-list 'muse-publish-markup-regexps
 233                   '(3200 muse-wiki-wikiword-regexp 0 link)
 234                   t)))
 235
 236 ;; Insinuate link handling
 237
 238 (custom-add-option 'muse-implicit-link-functions
 239                    'muse-wiki-handle-interwiki)
 240 (custom-add-option 'muse-implicit-link-functions
 241                    'muse-wiki-handle-wikiword)
 242
 243 (custom-add-option 'muse-explicit-link-functions
 244                    'muse-wiki-handle-interwiki)
 245
 246 (add-to-list 'muse-implicit-link-functions
 247              'muse-wiki-handle-interwiki t)
 248 (add-to-list 'muse-implicit-link-functions
 249              'muse-wiki-handle-wikiword t)
 250
 251 (add-to-list 'muse-explicit-link-functions
 252              'muse-wiki-handle-interwiki t)
 253
 254 ;; Update several things when Muse mode is entered
 255 (defun muse-wiki-update-custom-values ()
 256   "Update some important muse-wiki values that may have been altered manually."
 257   (muse-wiki-update-interwiki-regexp muse-wiki-interwiki-alist))
 258
 259 (custom-add-option 'muse-mode-hook
 260                    'muse-wiki-update-custom-values)
 261
 262 (add-hook 'muse-mode-hook
 263           'muse-wiki-update-custom-values)
 264
 265 (provide 'muse-wiki)
 266 ;;; muse-wiki.el ends here