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