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