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