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-transform-interwiki (url explicit)
 113   "Return the destination of the given URL if it is an interwiki link.
 114 Otherwise return URL.  Read-only properties are added to the string."
 115   (let ((res (muse-wiki-handle-interwiki url)))
 116     (if (and res (not (string-match muse-image-regexp res)))
 117         (setq url (concat (file-name-directory res)
 118                           (muse-publish-output-name res)))))
 119   (muse-publish-read-only url))
 120
 121 (defun muse-wiki-transform-wikiword (url explicit)
 122   "If URL is a WikiWord but does not correspond with an existing
 123 file or interwiki name, return nil.  Otherwise, return URL.
 124 Read-only properties are added to the string."
 125   (when (and muse-wiki-use-wikiword
 126              (not explicit)
 127              (string-match (concat "^" muse-wiki-wikiword-regexp "$") url))
 128     (unless (or (and (muse-project-of-file)
 129                      (muse-project-page-file
 130                       url muse-current-project t))
 131                 (file-exists-p url)
 132                 ;; This is allowed to be the name of an interwiki or
 133                 ;; the name of a project.
 134                 (assoc url muse-project-alist)
 135                 (assoc url muse-wiki-interwiki-alist))
 136       (setq url nil)))
 137   (when url (muse-publish-read-only url)))
 138
 139 (defun muse-wiki-resolve-project-page (&optional project page)
 140   "Return the published path from the current page to PAGE of PROJECT.
 141 If PAGE is not specified, use the value of :default in PROJECT.
 142 If PROJECT is not specified, default to first project of
 143 `muse-projects-alist'.
 144
 145 Note that PAGE can have several output directories.  If this is
 146 the case, we will use the first one that matches our current
 147 style and ignore the others."
 148   (setq project (or project (caar muse-project-alist))
 149         page (or page (muse-get-keyword :default
 150                                         (cadr (muse-project project)))))
 151   (let ((remote-style (car (muse-project-applicable-styles
 152                             (muse-project-page-file page project)
 153                             project)))
 154         (local-style (car (muse-project-applicable-styles
 155                            (muse-project-page-file page
 156                                                    (muse-project-of-file))
 157                            (cddr (muse-project-of-file))))))
 158     (file-relative-name (expand-file-name
 159                          page (muse-style-element :path remote-style))
 160                         (expand-file-name
 161                          (muse-style-element :path local-style)))))
 162
 163 (defun muse-wiki-handle-interwiki (&optional string)
 164   "If STRING or point has an interwiki link, resolve it and
 165 return the first match.
 166 Match 1 is set to the link.
 167 Match 2 is set to the description."
 168   (when (if string (string-match muse-wiki-interwiki-regexp string)
 169           (looking-at muse-wiki-interwiki-regexp))
 170     (let* ((project (match-string 1 string))
 171            (subst (cdr (assoc project muse-wiki-interwiki-alist)))
 172            (word (match-string 2 string)))
 173       (if subst
 174           (if (functionp subst)
 175               (funcall subst word)
 176             (concat subst word))
 177         (and (assoc project muse-project-alist)
 178              (muse-wiki-resolve-project-page project word))))))
 179
 180 (defun muse-wiki-handle-wikiword (&optional string)
 181   "If STRING or point has a WikiWord, return it.
 182 Match 1 is set to the WikiWord."
 183   (when (and muse-wiki-use-wikiword
 184              (if string
 185                  (string-match muse-wiki-wikiword-regexp string)
 186                (looking-at muse-wiki-wikiword-regexp))
 187              (or (and (muse-project-of-file)
 188                       (muse-project-page-file
 189                        (match-string 1 string) muse-current-project t))
 190                  (file-exists-p (match-string 1 string))))
 191     (match-string 1 string)))
 192
 193 ;; Coloring setup
 194
 195 (eval-after-load "muse-colors"
 196   '(progn
 197      (defun muse-wiki-colors-wikiword ()
 198        "Color WikiWords."
 199        ;; remove flyspell overlays
 200        (when (fboundp 'flyspell-unhighlight-at)
 201          (let ((cur (match-beginning 0)))
 202            (while (> (match-end 0) cur)
 203              (flyspell-unhighlight-at cur)
 204              (setq cur (1+ cur)))))
 205        (let ((link (match-string-no-properties 1))
 206              (face (muse-link-face (match-string 1))))
 207          (when face
 208            (add-text-properties (match-beginning 1) (match-end 0)
 209                                 (muse-link-properties
 210                                  (match-string-no-properties 1) face)))))
 211
 212      (defun muse-wiki-colors-nop-tag (beg end)
 213        (when (and muse-wiki-hide-nop-tag
 214                   (<= (- end beg) 5))
 215          (add-text-properties beg end
 216                               '(invisible muse intangible t))))
 217
 218      (add-to-list 'muse-colors-tags
 219                   '("nop" nil nil muse-wiki-colors-nop-tag)
 220                   t)
 221
 222      (add-to-list 'muse-colors-markup
 223                   '(muse-wiki-interwiki-regexp t muse-wiki-colors-wikiword)
 224                   t)
 225      (add-to-list 'muse-colors-markup
 226                   '(muse-wiki-wikiword-regexp t muse-wiki-colors-wikiword)
 227                   t)
 228
 229      (muse-configure-highlighting 'muse-colors-markup muse-colors-markup)))
 230
 231 ;; Publishing setup
 232
 233 (eval-after-load "muse-publish"
 234   '(progn
 235      (add-to-list 'muse-publish-markup-regexps
 236                   '(3100 muse-wiki-interwiki-regexp 0 url)
 237                   t)
 238      (add-to-list 'muse-publish-markup-regexps
 239                   '(3200 muse-wiki-wikiword-regexp 0 url)
 240                   t)
 241      (add-to-list 'muse-publish-url-transforms
 242                   'muse-wiki-transform-interwiki)
 243      (add-to-list 'muse-publish-url-transforms
 244                   'muse-wiki-transform-wikiword)))
 245
 246 ;; Insinuate link handling
 247
 248 (add-to-list 'muse-implicit-link-functions
 249              'muse-wiki-handle-interwiki t)
 250 (add-to-list 'muse-implicit-link-functions
 251              'muse-wiki-handle-wikiword t)
 252
 253 (add-to-list 'muse-explicit-link-functions
 254              'muse-wiki-handle-interwiki)
 255
 256 ;; Update several things when Muse mode is entered
 257 (add-hook 'muse-mode-hook
 258           #'(lambda nil
 259               (muse-wiki-update-interwiki-regexp muse-wiki-interwiki-alist)))
 260
 261 (provide 'muse-wiki)
 262 ;;; muse-wiki.el ends here