lisp/muse-wiki.el

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