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   "Whether to use color and publish bare WikiNames."
  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 (defcustom muse-wiki-interwiki-delimiter "#\\|::"
  72   "Delimiter regexp used for InterWiki links.
  73 If you use groups, use only shy groups."
  74   :type 'regexp
  75   :group 'muse-wiki)
  76
  77 (defcustom muse-wiki-interwiki-replacement ": "
  78   "Regexp used for replacing `muse-wiki-interwiki-delimiter' in
  79 InterWiki link descriptions.
  80
  81 If you want this replacement to happen, you must add
  82 `muse-wiki-publish-pretty-interwiki' to
  83 `muse-publish-desc-transforms'."
  84   :type 'regexp
  85   :group 'muse-wiki)
  86
  87 (defun muse-wiki-update-interwiki-regexp (value)
  88   "Update the value of `muse-wiki-interwiki-regexp' based on VALUE
  89 and `muse-project-alist'."
  90   (setq muse-wiki-interwiki-regexp
  91         (concat "\\<\\(" (mapconcat 'car muse-project-alist "\\|")
  92                 (when value (concat "\\|" (mapconcat 'car value "\\|")))
  93                 "\\)\\(?:\\(?:" muse-wiki-interwiki-delimiter
  94                 "\\)\\(\\sw+\\)\\)?\\>"))
  95   (muse-configure-highlighting 'muse-colors-markup muse-colors-markup))
  96
  97 (defcustom muse-wiki-interwiki-alist
  98   '(("EmacsWiki" . "http://www.emacswiki.org/cgi-bin/wiki/"))
  99   "A table of WikiNames that refer to external entities.
 100 The format of this table is an alist, or series of cons cells.
 101 Each cons cell must be of the form:
 102
 103   (WIKINAME . STRING-OR-FUNCTION)
 104
 105 The second part of the cons cell may either be a STRING, which in most
 106 cases should be a URL, or a FUNCTION.  If a function, it will be
 107 called with one argument: the tag applied to the Interwiki name, or
 108 nil if no tag was used.  If the cdr was a STRING and a tag is used,
 109 the tag is simply appended.
 110
 111 Here are some examples:
 112
 113   (\"JohnWiki\" . \"http://alice.dynodns.net/wiki?\")
 114
 115 Referring to [[JohnWiki::EmacsModules]] then really means:
 116
 117   http://alice.dynodns.net/wiki?EmacsModules
 118
 119 If a function is used for the replacement text, you can get creative
 120 depending on what the tag is.  Tags may contain any alphabetic
 121 character, any number, % or _.  If you need other special characters,
 122 use % to specify the hex code, as in %2E.  All browsers should support
 123 this."
 124   :type '(repeat (cons (string :tag "WikiName")
 125                        (choice (string :tag "URL") function)))
 126   :set (function
 127         (lambda (sym value)
 128           (muse-wiki-update-interwiki-regexp value)
 129           (set sym value)))
 130   :group 'muse-wiki)
 131
 132 (defun muse-wiki-resolve-project-page (&optional project page)
 133   "Return the published path from the current page to PAGE of PROJECT.
 134 If PAGE is not specified, use the value of :default in PROJECT.
 135 If PROJECT is not specified, default to first project of
 136 `muse-projects-alist'.
 137
 138 Note that PAGE can have several output directories.  If this is
 139 the case, we will use the first one that matches our current
 140 style and ignore the others."
 141   (setq project (or project (caar muse-project-alist))
 142         page (or page (muse-get-keyword :default
 143                                         (cadr (muse-project project)))))
 144   (let* ((page-path (muse-project-page-file page project))
 145          (remote-style (when page-path (car (muse-project-applicable-styles
 146                                              page-path project))))
 147          (local-style (car (muse-project-applicable-styles
 148                             (muse-current-file)
 149                             (cddr (muse-project-of-file))))))
 150     (if (and remote-style local-style muse-publishing-p)
 151         (muse-publish-link-file
 152          (file-relative-name (expand-file-name
 153                               page (muse-style-element :path remote-style))
 154                              (expand-file-name
 155                               (muse-style-element :path local-style)))
 156          nil remote-style)
 157       (unless muse-publishing-p page-path))))
 158
 159 (defun muse-wiki-handle-interwiki (&optional string)
 160   "If STRING or point has an interwiki link, resolve it and
 161 return the first match.
 162 Match 1 is set to the link.
 163 Match 2 is set to the description."
 164   (when (if string (string-match muse-wiki-interwiki-regexp string)
 165           (looking-at muse-wiki-interwiki-regexp))
 166     (let* ((project (match-string 1 string))
 167            (subst (cdr (assoc project muse-wiki-interwiki-alist)))
 168            (word (match-string 2 string)))
 169       (if subst
 170           (if (functionp subst)
 171               (funcall subst word)
 172             (concat subst word))
 173         (and (assoc project muse-project-alist)
 174              (muse-wiki-resolve-project-page project word))))))
 175
 176 (defun muse-wiki-handle-wikiword (&optional string)
 177   "If STRING or point has a WikiWord, return it.
 178 Match 1 is set to the WikiWord."
 179   (when (and muse-wiki-use-wikiword
 180              (if string
 181                  (string-match muse-wiki-wikiword-regexp string)
 182                (looking-at muse-wiki-wikiword-regexp))
 183              (or (and (muse-project-of-file)
 184                       (muse-project-page-file
 185                        (match-string 1 string) muse-current-project t))
 186                  (file-exists-p (match-string 1 string))))
 187     (match-string 1 string)))
 188
 189 ;; Prettifications
 190
 191 (defcustom muse-wiki-publish-small-title-words
 192   '("the" "and" "at" "on" "of" "for" "in" "an" "a")
 193   "Strings that should be downcased in a page title.
 194 This is used by `muse-wiki-publish-pretty-title', which must be
 195 called manually."
 196   :type '(repeat string)
 197   :group 'muse-wiki)
 198
 199 (defun muse-wiki-publish-pretty-title (&optional title explicit)
 200   "Return a pretty version of the given TITLE.
 201 If EXPLICIT is non-nil, TITLE will be returned unmodified."
 202   (unless title (setq title (muse-publishing-directive "title")))
 203   (if (or explicit
 204           (save-match-data (string-match muse-url-regexp title)))
 205       title
 206     (save-match-data
 207       (let ((case-fold-search nil))
 208         (while (string-match (concat "\\([" muse-regexp-lower
 209                                      "]\\)\\([" muse-regexp-upper
 210                                      "0-9]\\)")
 211                              title)
 212           (setq title (replace-match "\\1 \\2" t nil title)))
 213         (let* ((words (split-string title))
 214                (w (cdr words)))
 215           (while w
 216             (if (member (downcase (car w))
 217                         muse-wiki-publish-small-title-words)
 218                 (setcar w (downcase (car w))))
 219             (setq w (cdr w)))
 220           (mapconcat 'identity words " "))))))
 221
 222 (defun muse-wiki-publish-pretty-interwiki (desc &optional explicit)
 223   "Replace instances of `muse-wiki-interwiki-delimiter' with
 224 `muse-wiki-interwiki-replacement'."
 225   (if (or explicit
 226           (save-match-data (string-match muse-url-regexp desc)))
 227       desc
 228     (muse-replace-regexp-in-string muse-wiki-interwiki-delimiter
 229                                    muse-wiki-interwiki-replacement
 230                                    desc)))
 231
 232 ;; Coloring setup
 233
 234 (eval-after-load "muse-colors"
 235   '(progn
 236      (defun muse-wiki-colors-nop-tag (beg end)
 237        (add-text-properties beg (+ beg 5)
 238                             '(invisible muse intangible t)))
 239
 240      (add-to-list 'muse-colors-tags
 241                   '("nop" nil nil muse-wiki-colors-nop-tag)
 242                   t)
 243
 244      (add-to-list 'muse-colors-markup
 245                   '(muse-wiki-interwiki-regexp t muse-colors-implicit-link)
 246                   t)
 247      (add-to-list 'muse-colors-markup
 248                   '(muse-wiki-wikiword-regexp t muse-colors-implicit-link)
 249                   t)
 250
 251      (muse-configure-highlighting 'muse-colors-markup muse-colors-markup)))
 252
 253 ;; Publishing setup
 254
 255 (eval-after-load "muse-publish"
 256   '(progn
 257      (add-to-list 'muse-publish-markup-regexps
 258                   '(3100 muse-wiki-interwiki-regexp 0 link)
 259                   t)
 260      (add-to-list 'muse-publish-markup-regexps
 261                   '(3200 muse-wiki-wikiword-regexp 0 link)
 262                   t)
 263
 264      (custom-add-option 'muse-publish-desc-transforms
 265                         'muse-wiki-publish-pretty-interwiki)
 266      (custom-add-option 'muse-publish-desc-transforms
 267                         'muse-wiki-publish-pretty-title)))
 268
 269 ;; Insinuate link handling
 270
 271 (custom-add-option 'muse-implicit-link-functions
 272                    'muse-wiki-handle-interwiki)
 273 (custom-add-option 'muse-implicit-link-functions
 274                    'muse-wiki-handle-wikiword)
 275
 276 (custom-add-option 'muse-explicit-link-functions
 277                    'muse-wiki-handle-interwiki)
 278
 279 (add-to-list 'muse-implicit-link-functions
 280              'muse-wiki-handle-interwiki t)
 281 (add-to-list 'muse-implicit-link-functions
 282              'muse-wiki-handle-wikiword t)
 283
 284 (add-to-list 'muse-explicit-link-functions
 285              'muse-wiki-handle-interwiki t)
 286
 287 ;; Update several things when Muse mode is entered
 288 (defun muse-wiki-update-custom-values ()
 289   "Update some important muse-wiki values that may have been altered manually."
 290   (muse-wiki-update-interwiki-regexp muse-wiki-interwiki-alist))
 291
 292 (custom-add-option 'muse-mode-hook
 293                    'muse-wiki-update-custom-values)
 294
 295 (add-hook 'muse-mode-hook
 296           'muse-wiki-update-custom-values)
 297
 298 (provide 'muse-wiki)
 299 ;;; muse-wiki.el ends here