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