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