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