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