lisp/muse-wiki.el

   1 ;;; muse-wiki.el --- wiki features for Muse
   2
   3 ;; Copyright (C) 2005, 2006 Free Software Foundation, Inc.
   4
   5 ;; Author: Yann Hodique <Yann.Hodique@lifl.fr>
   6 ;; Keywords:
   7
   8 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
   9
  10 ;; Emacs Muse is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published
  12 ;; by the Free Software Foundation; either version 2, or (at your
  13 ;; option) any later version.
  14
  15 ;; Emacs Muse is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with Emacs Muse; 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   (when (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   (when (featurep 'muse-colors)
 110     (muse-configure-highlighting 'muse-colors-markup muse-colors-markup)))
 111
 112 (defcustom muse-wiki-interwiki-alist
 113   '(("EmacsWiki" . "http://www.emacswiki.org/cgi-bin/wiki/"))
 114   "A table of WikiNames that refer to external entities.
 115 The format of this table is an alist, or series of cons cells.
 116 Each cons cell must be of the form:
 117
 118   (WIKINAME . STRING-OR-FUNCTION)
 119
 120 The second part of the cons cell may either be a STRING, which in most
 121 cases should be a URL, or a FUNCTION.  If a function, it will be
 122 called with one argument: the tag applied to the Interwiki name, or
 123 nil if no tag was used.  If the cdr was a STRING and a tag is used,
 124 the tag is simply appended.
 125
 126 Here are some examples:
 127
 128   (\"JohnWiki\" . \"http://alice.dynodns.net/wiki?\")
 129
 130 Referring to [[JohnWiki::EmacsModules]] then really means:
 131
 132   http://alice.dynodns.net/wiki?EmacsModules
 133
 134 If a function is used for the replacement text, you can get creative
 135 depending on what the tag is.  Tags may contain any alphabetic
 136 character, any number, % or _.  If you need other special characters,
 137 use % to specify the hex code, as in %2E.  All browsers should support
 138 this."
 139   :type '(repeat (cons (string :tag "WikiName")
 140                        (choice (string :tag "URL") function)))
 141   :set (function
 142         (lambda (sym value)
 143           (muse-wiki-update-interwiki-regexp value)
 144           (set sym value)))
 145   :group 'muse-wiki)
 146
 147 (defun muse-wiki-resolve-project-page (&optional project page)
 148   "Return the published path from the current page to PAGE of PROJECT.
 149 If PAGE is not specified, use the value of :default in PROJECT.
 150 If PROJECT is not specified, default to first project of
 151 `muse-projects-alist'.
 152
 153 Note that PAGE can have several output directories.  If this is
 154 the case, we will use the first one that matches our current
 155 style and ignore the others."
 156   (setq project (or project (caar muse-project-alist))
 157         page (or page (muse-get-keyword :default
 158                                         (cadr (muse-project project)))))
 159   (let* ((page-path (muse-project-page-file page project))
 160          (remote-style (when page-path (car (muse-project-applicable-styles
 161                                              page-path project))))
 162          (local-style (car (muse-project-applicable-styles
 163                             (muse-current-file)
 164                             (cddr (muse-project-of-file))))))
 165     (cond ((and remote-style local-style muse-publishing-p)
 166            (let ((prefix (muse-style-element :base-url remote-style)))
 167              (muse-publish-link-file
 168               (if prefix
 169                   (concat prefix page)
 170                 (file-relative-name (expand-file-name
 171                                      page
 172                                      (muse-style-element :path remote-style))
 173                                     (expand-file-name
 174                                      (muse-style-element :path local-style))))
 175               nil remote-style)))
 176           ((not muse-publishing-p)
 177            (if page-path
 178                page-path
 179              (when muse-wiki-allow-nonexistent-wikiword
 180                ;; make a path to a nonexistent file in project
 181                (setq page-path (expand-file-name
 182                                 page (car (cadr (muse-project project)))))
 183                (if (and muse-file-extension
 184                         (not (string= muse-file-extension "")))
 185                    (concat page-path "." muse-file-extension)
 186                  page-path)))))))
 187
 188 (defun muse-wiki-handle-interwiki (&optional string)
 189   "If STRING or point has an interwiki link, resolve it and
 190 return the first match.
 191 Match 1 is set to the link.
 192 Match 2 is set to the description."
 193   (when (if string (string-match muse-wiki-interwiki-regexp string)
 194           (looking-at muse-wiki-interwiki-regexp))
 195     (let* ((project (match-string 1 string))
 196            (subst (cdr (assoc project muse-wiki-interwiki-alist)))
 197            (word (if string
 198                      (and (match-beginning 2)
 199                           (substring string (match-beginning 2)))
 200                    (match-string 2 string))))
 201       (if subst
 202           (if (functionp subst)
 203               (funcall subst word)
 204             (concat subst word))
 205         (and (assoc project muse-project-alist)
 206              (or word (not muse-wiki-ignore-bare-project-names))
 207              (muse-wiki-resolve-project-page project word))))))
 208
 209 (defun muse-wiki-handle-wikiword (&optional string)
 210   "If STRING or point has a WikiWord, return it.
 211 Match 1 is set to the WikiWord."
 212   (when (and muse-wiki-use-wikiword
 213              (if string
 214                  (string-match muse-wiki-wikiword-regexp string)
 215                (looking-at muse-wiki-wikiword-regexp))
 216              (or muse-wiki-allow-nonexistent-wikiword
 217                  (and (muse-project-of-file)
 218                       (muse-project-page-file
 219                        (match-string 1 string) muse-current-project t))
 220                  (file-exists-p (match-string 1 string))))
 221     (match-string 1 string)))
 222
 223 ;; Prettifications
 224
 225 (defcustom muse-wiki-publish-small-title-words
 226   '("the" "and" "at" "on" "of" "for" "in" "an" "a")
 227   "Strings that should be downcased in a page title.
 228 This is used by `muse-wiki-publish-pretty-title', which must be
 229 called manually."
 230   :type '(repeat string)
 231   :group 'muse-wiki)
 232
 233 (defun muse-wiki-publish-pretty-title (&optional title explicit)
 234   "Return a pretty version of the given TITLE.
 235 If EXPLICIT is non-nil, TITLE will be returned unmodified."
 236   (unless title (setq title (muse-publishing-directive "title")))
 237   (if (or explicit
 238           (save-match-data (string-match muse-url-regexp title)))
 239       title
 240     (save-match-data
 241       (let ((case-fold-search nil))
 242         (while (string-match (concat "\\([" muse-regexp-lower
 243                                      "]\\)\\([" muse-regexp-upper
 244                                      "0-9]\\)")
 245                              title)
 246           (setq title (replace-match "\\1 \\2" t nil title)))
 247         (let* ((words (split-string title))
 248                (w (cdr words)))
 249           (while w
 250             (if (member (downcase (car w))
 251                         muse-wiki-publish-small-title-words)
 252                 (setcar w (downcase (car w))))
 253             (setq w (cdr w)))
 254           (mapconcat 'identity words " "))))))
 255
 256 (defun muse-wiki-publish-pretty-interwiki (desc &optional explicit)
 257   "Replace instances of `muse-wiki-interwiki-delimiter' with
 258 `muse-wiki-interwiki-replacement'."
 259   (if (or explicit
 260           (save-match-data (string-match muse-url-regexp desc)))
 261       desc
 262     (muse-replace-regexp-in-string muse-wiki-interwiki-delimiter
 263                                    muse-wiki-interwiki-replacement
 264                                    desc)))
 265
 266 ;; Coloring setup
 267
 268 (eval-after-load "muse-colors"
 269   '(progn
 270      (defun muse-wiki-colors-nop-tag (beg end)
 271        (add-text-properties beg (+ beg 5)
 272                             '(invisible muse intangible t)))
 273      (defun muse-colors-wikiword-separate ()
 274        (add-text-properties (match-beginning 0) (match-end 0)
 275                             '(invisible muse intangible t)))
 276
 277      (add-to-list 'muse-colors-tags
 278                   '("nop" nil nil muse-wiki-colors-nop-tag)
 279                   t)
 280
 281      (add-to-list 'muse-colors-markup
 282                   '(muse-wiki-interwiki-regexp t muse-colors-implicit-link)
 283                   t)
 284      (add-to-list 'muse-colors-markup
 285                   '(muse-wiki-wikiword-regexp t muse-colors-implicit-link)
 286                   t)
 287      (add-to-list 'muse-colors-markup
 288                   '("''''" ?\' muse-colors-wikiword-separate)
 289                   nil)
 290
 291      (muse-configure-highlighting 'muse-colors-markup muse-colors-markup)))
 292
 293 ;; Publishing setup
 294
 295 (eval-after-load "muse-publish"
 296   '(progn
 297      (add-to-list 'muse-publish-markup-regexps
 298                   '(3100 muse-wiki-interwiki-regexp 0 link)
 299                   t)
 300      (add-to-list 'muse-publish-markup-regexps
 301                   '(3200 muse-wiki-wikiword-regexp 0 link)
 302                   t)
 303      (add-to-list 'muse-publish-markup-regexps
 304                   '(3300 "''''" 0 "")
 305                   t)
 306
 307      (custom-add-option 'muse-publish-desc-transforms
 308                         'muse-wiki-publish-pretty-interwiki)
 309      (custom-add-option 'muse-publish-desc-transforms
 310                         'muse-wiki-publish-pretty-title)))
 311
 312 ;; Insinuate link handling
 313
 314 (custom-add-option 'muse-implicit-link-functions
 315                    'muse-wiki-handle-interwiki)
 316 (custom-add-option 'muse-implicit-link-functions
 317                    'muse-wiki-handle-wikiword)
 318
 319 (custom-add-option 'muse-explicit-link-functions
 320                    'muse-wiki-handle-interwiki)
 321
 322 (add-to-list 'muse-implicit-link-functions
 323              'muse-wiki-handle-interwiki t)
 324 (add-to-list 'muse-implicit-link-functions
 325              'muse-wiki-handle-wikiword t)
 326
 327 (add-to-list 'muse-explicit-link-functions
 328              'muse-wiki-handle-interwiki t)
 329
 330 ;; Update several things when Muse mode is entered
 331 (defun muse-wiki-update-custom-values ()
 332   "Update some important muse-wiki values that may have been altered manually."
 333   (muse-wiki-update-interwiki-regexp muse-wiki-interwiki-alist))
 334
 335 (custom-add-option 'muse-mode-hook
 336                    'muse-wiki-update-custom-values)
 337
 338 (add-hook 'muse-mode-hook
 339           'muse-wiki-update-custom-values)
 340
 341 (provide 'muse-wiki)
 342 ;;; muse-wiki.el ends here