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