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 ;; Per B. Sederberg (per AT med DOT upenn DOT edu) made it so that all
  30 ;; files in a Muse project can become implicit links.
  31
  32 ;;; Code:
  33
  34 (require 'muse-regexps)
  35 (require 'muse-mode)
  36
  37 (eval-when-compile
  38   (require 'muse-colors))
  39
  40 (defgroup muse-wiki nil
  41   "Options controlling the behavior of Emacs Muse Wiki features."
  42   :group 'muse-mode)
  43
  44 (defcustom muse-wiki-use-wikiword t
  45   "Whether to use color and publish bare WikiNames."
  46   :type 'boolean
  47   :group 'muse-wiki)
  48
  49 (defcustom muse-wiki-allow-nonexistent-wikiword nil
  50   "Whether to color bare WikiNames that don't have an existing file."
  51   :type 'boolean
  52   :group 'muse-wiki)
  53
  54 (defcustom muse-wiki-match-all-project-files nil
  55   "Whether to extend WikiName functionality to also match
  56 existing filenames, regardless of whether they are named in
  57 WikiWord format.
  58
  59 If non-nil, Muse will color and publish implicit links to any
  60 file in your project."
  61   :type 'boolean
  62   :group 'muse-wiki)
  63
  64 (defvar muse-wiki-updating-wikiword-p nil
  65   "Prevent recursive calls to `muse-wiki-update-local-wikiword-regexp'.")
  66
  67 (eval-when-compile
  68   (defvar muse-wiki-wikiword-regexp))
  69
  70 (defun muse-wiki-update-local-wikiword-regexp ()
  71   "Update a local copy of `muse-wiki-wikiword-regexp' to include
  72 all the files in the project."
  73   ;; see if the user wants to append project files
  74   (when (and muse-wiki-use-wikiword
  75              muse-wiki-match-all-project-files
  76              (not muse-wiki-updating-wikiword-p))
  77     (let ((muse-wiki-updating-wikiword-p t))
  78       ;; make the regexp local
  79       (set (make-local-variable 'muse-wiki-wikiword-regexp)
  80            (concat "\\(\\<\\(?:"
  81                    ;; append the files from the project
  82                    (mapconcat 'car
  83                               (muse-project-file-alist (muse-project))
  84                               "\\|")
  85                    "\\)\\>\\|\\(?:"
  86                    (default-value 'muse-wiki-wikiword-regexp)
  87                    "\\)\\)"))
  88       ;; update coloring setup
  89       (when (featurep 'muse-colors)
  90         (muse-configure-highlighting
  91          'muse-colors-markup muse-colors-markup)))))
  92
  93 (add-hook 'muse-update-values-hook
  94           'muse-wiki-update-local-wikiword-regexp)
  95 (add-hook 'muse-project-file-alist-hook
  96           'muse-wiki-update-local-wikiword-regexp)
  97
  98 (defun muse-wiki-update-wikiword-regexp (sym val)
  99   "Update everything related to `muse-wiki-wikiword-regexp'."
 100   (set sym val)
 101   (muse-wiki-update-local-wikiword-regexp)
 102   (when (featurep 'muse-colors)
 103     (muse-configure-highlighting 'muse-colors-markup muse-colors-markup)))
 104
 105 (defcustom muse-wiki-wikiword-regexp
 106   (concat "\\<\\(\\(?:[" muse-regexp-upper
 107           "]+[" muse-regexp-lower "]+\\)\\(?:["
 108           muse-regexp-upper "]+[" muse-regexp-lower "]+\\)+\\)")
 109   "Regexp used to match WikiWords."
 110   :type 'regexp
 111   :group 'muse-wiki
 112   :set 'muse-wiki-update-wikiword-regexp)
 113
 114 (defcustom muse-wiki-ignore-bare-project-names nil
 115   "Determine whether project names without a page specifer are links.
 116 If non-nil, project names without a page specifier will not be
 117 considered links.
 118 When nil, project names without a specifier are highlighted and
 119 they link to the default page of the project that they name."
 120   :type 'boolean
 121   :group 'muse-wiki)
 122
 123 (defvar muse-wiki-interwiki-regexp ""
 124   "Regexp that matches all interwiki links.
 125 This is automatically generated by setting `muse-wiki-interwiki-alist'.
 126 It can also be set by calling `muse-wiki-update-interwiki-regexp'.")
 127
 128 (defcustom muse-wiki-interwiki-delimiter "#\\|::"
 129   "Delimiter regexp used for InterWiki links.
 130 If you use groups, use only shy groups."
 131   :type 'regexp
 132   :group 'muse-wiki)
 133
 134 (defcustom muse-wiki-interwiki-replacement ": "
 135   "Regexp used for replacing `muse-wiki-interwiki-delimiter' in
 136 InterWiki link descriptions.
 137
 138 If you want this replacement to happen, you must add
 139 `muse-wiki-publish-pretty-interwiki' to
 140 `muse-publish-desc-transforms'."
 141   :type 'regexp
 142   :group 'muse-wiki)
 143
 144 (eval-when-compile
 145   (defvar muse-wiki-interwiki-alist))
 146
 147 (defun muse-wiki-update-interwiki-regexp ()
 148   "Update the value of `muse-wiki-interwiki-regexp' based on
 149 `muse-wiki-interwiki-alist' and `muse-project-alist'."
 150   (when muse-wiki-match-all-project-files
 151     (make-local-variable 'muse-wiki-interwiki-regexp))
 152   (setq muse-wiki-interwiki-regexp
 153         (concat "\\<\\(" (mapconcat 'car muse-project-alist "\\|")
 154                 (when muse-wiki-interwiki-alist
 155                   (concat "\\|" (mapconcat 'car muse-wiki-interwiki-alist
 156                                            "\\|")))
 157                 "\\)\\(?:\\(?:" muse-wiki-interwiki-delimiter
 158                 "\\)\\("
 159                 (when muse-wiki-match-all-project-files
 160                   ;; append the files from the project
 161                   (concat
 162                    (mapconcat 'car
 163                               (muse-project-file-alist (muse-project))
 164                               "\\|")
 165                    "\\|"))
 166                 "\\sw+\\)\\)?\\>"))
 167   (when (featurep 'muse-colors)
 168     (muse-configure-highlighting 'muse-colors-markup muse-colors-markup)))
 169
 170 (defcustom muse-wiki-interwiki-alist
 171   '(("EmacsWiki" . "http://www.emacswiki.org/cgi-bin/wiki/"))
 172   "A table of WikiNames that refer to external entities.
 173 The format of this table is an alist, or series of cons cells.
 174 Each cons cell must be of the form:
 175
 176   (WIKINAME . STRING-OR-FUNCTION)
 177
 178 The second part of the cons cell may either be a STRING, which in most
 179 cases should be a URL, or a FUNCTION.  If a function, it will be
 180 called with one argument: the tag applied to the Interwiki name, or
 181 nil if no tag was used.  If the cdr was a STRING and a tag is used,
 182 the tag is simply appended.
 183
 184 Here are some examples:
 185
 186   (\"JohnWiki\" . \"http://alice.dynodns.net/wiki?\")
 187
 188 Referring to [[JohnWiki::EmacsModules]] then really means:
 189
 190   http://alice.dynodns.net/wiki?EmacsModules
 191
 192 If a function is used for the replacement text, you can get creative
 193 depending on what the tag is.  Tags may contain any alphabetic
 194 character, any number, % or _.  If you need other special characters,
 195 use % to specify the hex code, as in %2E.  All browsers should support
 196 this."
 197   :type '(repeat (cons (string :tag "WikiName")
 198                        (choice (string :tag "URL") function)))
 199   :set (function
 200         (lambda (sym value)
 201           (set sym value)
 202           (muse-wiki-update-interwiki-regexp)))
 203   :group 'muse-wiki)
 204
 205 (add-hook 'muse-update-values-hook
 206           'muse-wiki-update-interwiki-regexp)
 207
 208 (defun muse-wiki-resolve-project-page (&optional project page)
 209   "Return the published path from the current page to PAGE of PROJECT.
 210 If PAGE is not specified, use the value of :default in PROJECT.
 211 If PROJECT is not specified, default to first project of
 212 `muse-projects-alist'.
 213
 214 Note that PAGE can have several output directories.  If this is
 215 the case, we will use the first one that matches our current
 216 style and ignore the others."
 217   (setq project (or (and project
 218                          (muse-project project))
 219                     (car muse-project-alist))
 220         page (or page (muse-get-keyword :default
 221                                         (cadr project))))
 222   (let* ((page-path (muse-project-page-file page project))
 223          (remote-style (when page-path (car (muse-project-applicable-styles
 224                                              page-path (cddr project)))))
 225          (local-style (car (muse-project-applicable-styles
 226                             (muse-current-file)
 227                             (cddr (muse-project-of-file))))))
 228     (cond ((and remote-style local-style muse-publishing-p)
 229            (let ((prefix (muse-style-element :base-url remote-style)))
 230              (muse-publish-link-file
 231               (if prefix
 232                   (concat prefix page)
 233                 (file-relative-name (expand-file-name
 234                                      page
 235                                      (muse-style-element :path remote-style))
 236                                     (expand-file-name
 237                                      (muse-style-element :path local-style))))
 238               nil remote-style)))
 239           ((not muse-publishing-p)
 240            (if page-path
 241                page-path
 242              (when muse-wiki-allow-nonexistent-wikiword
 243                ;; make a path to a nonexistent file in project
 244                (setq page-path (expand-file-name
 245                                 page (car (cadr project))))
 246                (if (and muse-file-extension
 247                         (not (string= muse-file-extension "")))
 248                    (concat page-path "." muse-file-extension)
 249                  page-path)))))))
 250
 251 (defun muse-wiki-handle-interwiki (&optional string)
 252   "If STRING or point has an interwiki link, resolve it and
 253 return the first match.
 254 Match 1 is set to the link.
 255 Match 2 is set to the description."
 256   (when (if string (string-match muse-wiki-interwiki-regexp string)
 257           (looking-at muse-wiki-interwiki-regexp))
 258     (let* ((project (match-string 1 string))
 259            (subst (cdr (assoc project muse-wiki-interwiki-alist)))
 260            (word (if string
 261                      (and (match-beginning 2)
 262                           (substring string (match-beginning 2)))
 263                    (match-string 2 string))))
 264       (if subst
 265           (if (functionp subst)
 266               (funcall subst word)
 267             (concat subst word))
 268         (and (assoc project muse-project-alist)
 269              (or word (not muse-wiki-ignore-bare-project-names))
 270              (muse-wiki-resolve-project-page project word))))))
 271
 272 (defun muse-wiki-handle-wikiword (&optional string)
 273   "If STRING or point has a WikiWord, return it.
 274 Match 1 is set to the WikiWord."
 275   (when (and muse-wiki-use-wikiword
 276              (if string
 277                  (string-match muse-wiki-wikiword-regexp string)
 278                (looking-at muse-wiki-wikiword-regexp))
 279              (or muse-wiki-allow-nonexistent-wikiword
 280                  (and (muse-project-of-file)
 281                       (muse-project-page-file
 282                        (match-string 1 string) muse-current-project t))
 283                  (file-exists-p (match-string 1 string))))
 284     (match-string 1 string)))
 285
 286 ;; Prettifications
 287
 288 (defcustom muse-wiki-publish-small-title-words
 289   '("the" "and" "at" "on" "of" "for" "in" "an" "a")
 290   "Strings that should be downcased in a page title.
 291 This is used by `muse-wiki-publish-pretty-title', which must be
 292 called manually."
 293   :type '(repeat string)
 294   :group 'muse-wiki)
 295
 296 (defcustom muse-wiki-hide-nop-tag t
 297   "If non-nil, hide <nop> tags when coloring a Muse buffer."
 298   :type 'boolean
 299   :group 'muse-wiki)
 300
 301 (defun muse-wiki-publish-pretty-title (&optional title explicit)
 302   "Return a pretty version of the given TITLE.
 303 If EXPLICIT is non-nil, TITLE will be returned unmodified."
 304   (unless title (setq title (or (muse-publishing-directive "title") "")))
 305   (if (or explicit
 306           (save-match-data (string-match muse-url-regexp title)))
 307       title
 308     (save-match-data
 309       (let ((case-fold-search nil))
 310         (while (string-match (concat "\\([" muse-regexp-lower
 311                                      "]\\)\\([" muse-regexp-upper
 312                                      "0-9]\\)")
 313                              title)
 314           (setq title (replace-match "\\1 \\2" t nil title)))
 315         (let* ((words (split-string title))
 316                (w (cdr words)))
 317           (while w
 318             (if (member (downcase (car w))
 319                         muse-wiki-publish-small-title-words)
 320                 (setcar w (downcase (car w))))
 321             (setq w (cdr w)))
 322           (mapconcat 'identity words " "))))))
 323
 324 (defun muse-wiki-publish-pretty-interwiki (desc &optional explicit)
 325   "Replace instances of `muse-wiki-interwiki-delimiter' with
 326 `muse-wiki-interwiki-replacement'."
 327   (if (or explicit
 328           (save-match-data (string-match muse-url-regexp desc)))
 329       desc
 330     (muse-replace-regexp-in-string muse-wiki-interwiki-delimiter
 331                                    muse-wiki-interwiki-replacement
 332                                    desc)))
 333
 334 ;; Coloring setup
 335
 336 (eval-after-load "muse-colors"
 337   '(progn
 338      (defun muse-wiki-colors-nop-tag (beg end)
 339        (when muse-wiki-hide-nop-tag
 340          (add-text-properties beg (+ beg 5)
 341                               '(invisible muse intangible t))))
 342      (defun muse-colors-wikiword-separate ()
 343        (add-text-properties (match-beginning 0) (match-end 0)
 344                             '(invisible muse intangible t)))
 345
 346      (add-to-list 'muse-colors-tags
 347                   '("nop" nil nil muse-wiki-colors-nop-tag)
 348                   t)
 349
 350      (add-to-list 'muse-colors-markup
 351                   '(muse-wiki-interwiki-regexp t muse-colors-implicit-link)
 352                   t)
 353      (add-to-list 'muse-colors-markup
 354                   '(muse-wiki-wikiword-regexp t muse-colors-implicit-link)
 355                   t)
 356      (add-to-list 'muse-colors-markup
 357                   '("''''" ?\' muse-colors-wikiword-separate)
 358                   nil)
 359
 360      (muse-configure-highlighting 'muse-colors-markup muse-colors-markup)))
 361
 362 ;; Publishing setup
 363
 364 (eval-after-load "muse-publish"
 365   '(progn
 366      (add-to-list 'muse-publish-markup-regexps
 367                   '(3100 muse-wiki-interwiki-regexp 0 link)
 368                   t)
 369      (add-to-list 'muse-publish-markup-regexps
 370                   '(3200 muse-wiki-wikiword-regexp 0 link)
 371                   t)
 372      (add-to-list 'muse-publish-markup-regexps
 373                   '(3300 "''''" 0 "")
 374                   t)
 375
 376      (custom-add-option 'muse-publish-desc-transforms
 377                         'muse-wiki-publish-pretty-interwiki)
 378      (custom-add-option 'muse-publish-desc-transforms
 379                         'muse-wiki-publish-pretty-title)))
 380
 381 ;; Insinuate link handling
 382
 383 (custom-add-option 'muse-implicit-link-functions
 384                    'muse-wiki-handle-interwiki)
 385 (custom-add-option 'muse-implicit-link-functions
 386                    'muse-wiki-handle-wikiword)
 387
 388 (custom-add-option 'muse-explicit-link-functions
 389                    'muse-wiki-handle-interwiki)
 390
 391 (add-to-list 'muse-implicit-link-functions
 392              'muse-wiki-handle-interwiki t)
 393 (add-to-list 'muse-implicit-link-functions
 394              'muse-wiki-handle-wikiword t)
 395
 396 (add-to-list 'muse-explicit-link-functions
 397              'muse-wiki-handle-interwiki t)
 398
 399 ;; Obsolete functions
 400
 401 (defun muse-wiki-update-custom-values ()
 402   (muse-display-warning
 403    (concat "Please remove `muse-wiki-update-custom-values' from"
 404            " `muse-mode-hook'.  Its use is now deprecated.")))
 405
 406 (provide 'muse-wiki)
 407 ;;; muse-wiki.el ends here