code.delx.au - gnu-emacs-elpa/blob - packages/muse/muse-wiki.el

   1 ;;; muse-wiki.el --- wiki features for Muse
   2
   3 ;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Yann Hodique <Yann.Hodique@lifl.fr>
   7 ;; Keywords:
   8
   9 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
  10
  11 ;; Emacs Muse is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published
  13 ;; by the Free Software Foundation; either version 3, or (at your
  14 ;; option) any later version.
  15
  16 ;; Emacs Muse is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with Emacs Muse; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Contributors:
  29
  30 ;; Per B. Sederberg (per AT med DOT upenn DOT edu) made it so that all
  31 ;; files in a Muse project can become implicit links.
  32
  33 ;;; Code:
  34
  35 (require 'muse-regexps)
  36 (require 'muse-mode)
  37
  38 (eval-when-compile
  39   (require 'muse-colors))
  40
  41 (defgroup muse-wiki nil
  42   "Options controlling the behavior of Emacs Muse Wiki features."
  43   :group 'muse-mode)
  44
  45 (defcustom muse-wiki-use-wikiword t
  46   "Whether to use color and publish bare WikiNames."
  47   :type 'boolean
  48   :group 'muse-wiki)
  49
  50 (defcustom muse-wiki-allow-nonexistent-wikiword nil
  51   "Whether to color bare WikiNames that don't have an existing file."
  52   :type 'boolean
  53   :group 'muse-wiki)
  54
  55 (defcustom muse-wiki-match-all-project-files nil
  56   "If non-nil, Muse will color and publish implicit links to any
  57 file in your project, regardless of whether its name is a WikiWord."
  58   :type 'boolean
  59   :group 'muse-wiki)
  60
  61 (defcustom muse-wiki-ignore-implicit-links-to-current-page nil
  62   "If non-nil, Muse will not recognize implicit links to the current
  63 page, both when formatting and publishing."
  64   :type 'boolean
  65   :group 'muse-wiki)
  66
  67 (defvar muse-wiki-project-file-regexp nil
  68   "Regexp used to match the files in the current project.
  69
  70 This is set by `muse-wiki-update-project-file-regexp' automatically
  71 when `muse-wiki-match-all-project-files' is non-nil.")
  72 (make-variable-buffer-local 'muse-wiki-project-file-regexp)
  73
  74 (defun muse-wiki-update-project-file-regexp ()
  75   "Update a local copy of `muse-wiki-project-file-regexp' to include
  76 all the files in the project."
  77   ;; see if the user wants to match project files
  78   (when muse-wiki-match-all-project-files
  79     (let ((files (mapcar #'car (muse-project-file-alist (muse-project)))))
  80       (setq muse-wiki-project-file-regexp
  81             (when files
  82               (concat "\\("
  83                       ;; include all files from the project
  84                       (regexp-opt files 'words)
  85                       "\\)"))))
  86     ;; update coloring setup
  87     (when (featurep 'muse-colors)
  88       (muse-colors-define-highlighting 'muse-mode 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-colors-define-highlighting 'muse-mode muse-colors-markup))))
 105   :type 'regexp
 106   :group 'muse-wiki)
 107
 108 (defcustom muse-wiki-ignore-bare-project-names nil
 109   "Determine whether project names without a page specifer are links.
 110
 111 If non-nil, project names without a page specifier will not be
 112 considered links.
 113
 114 When nil, project names without a specifier are highlighted and
 115 they link to the default page of the project that they name."
 116   :type 'boolean
 117   :group 'muse-wiki)
 118
 119 (defvar muse-wiki-interwiki-regexp nil
 120   "Regexp that matches all interwiki links.
 121
 122 This is automatically generated by setting `muse-wiki-interwiki-alist'.
 123 It can also be set by calling `muse-wiki-update-interwiki-regexp'.")
 124
 125 (defcustom muse-wiki-interwiki-delimiter "#\\|::"
 126   "Delimiter regexp used for InterWiki links.
 127
 128 If you use groups, use only shy groups."
 129   :type 'regexp
 130   :group 'muse-wiki)
 131
 132 (defcustom muse-wiki-interwiki-replacement ": "
 133   "Regexp used for replacing `muse-wiki-interwiki-delimiter' in
 134 InterWiki link descriptions.
 135
 136 If you want this replacement to happen, you must add
 137 `muse-wiki-publish-pretty-interwiki' to
 138 `muse-publish-desc-transforms'."
 139   :type 'regexp
 140   :group 'muse-wiki)
 141
 142 (eval-when-compile
 143   (defvar muse-wiki-interwiki-alist))
 144
 145 (defun muse-wiki-project-files-with-spaces (&optional project)
 146   "Return a list of files in PROJECT that have spaces."
 147   (setq project (muse-project project))
 148   (let ((flist nil))
 149     (save-match-data
 150       (dolist (entry (muse-project-file-alist project))
 151         (when (string-match " " (car entry))
 152           (setq flist (cons (car entry) flist)))))
 153     flist))
 154
 155 (defun muse-wiki-update-interwiki-regexp ()
 156   "Update the value of `muse-wiki-interwiki-regexp' based on
 157 `muse-wiki-interwiki-alist' and `muse-project-alist'."
 158   (if (null muse-project-alist)
 159       (setq muse-wiki-interwiki-regexp nil)
 160     (let ((old-value muse-wiki-interwiki-regexp))
 161       (setq muse-wiki-interwiki-regexp
 162             (concat "\\<\\(" (regexp-opt (mapcar #'car muse-project-alist))
 163                     (when muse-wiki-interwiki-alist
 164                       (let ((interwiki-rules
 165                              (mapcar #'car muse-wiki-interwiki-alist)))
 166                         (when interwiki-rules
 167                           (concat "\\|" (regexp-opt interwiki-rules)))))
 168                     "\\)\\(?:\\(" muse-wiki-interwiki-delimiter
 169                     "\\)\\("
 170                     (when muse-wiki-match-all-project-files
 171                       ;; append the files from the project
 172                       (let ((files nil))
 173                         (dolist (proj muse-project-alist)
 174                           (setq files
 175                                 (nconc (muse-wiki-project-files-with-spaces
 176                                         (car proj))
 177                                        files)))
 178                         (when files
 179                           (concat (regexp-opt files) "\\|"))))
 180                     "\\sw+\\)\\(#\\S-+\\)?\\)?\\>"))
 181       (when (and (featurep 'muse-colors)
 182                  (not (string= old-value muse-wiki-interwiki-regexp)))
 183         (muse-colors-define-highlighting 'muse-mode muse-colors-markup)))))
 184
 185 (defcustom muse-wiki-interwiki-alist
 186   '(("EmacsWiki" . "http://www.emacswiki.org/cgi-bin/wiki/"))
 187   "A table of WikiNames that refer to external entities.
 188
 189 The format of this table is an alist, or series of cons cells.
 190 Each cons cell must be of the form:
 191
 192   (WIKINAME . STRING-OR-FUNCTION)
 193
 194 The second part of the cons cell may either be a STRING, which in most
 195 cases should be a URL, or a FUNCTION.  If a function, it will be
 196 called with one argument: the tag applied to the Interwiki name, or
 197 nil if no tag was used.  If the cdr was a STRING and a tag is used,
 198 the tag is simply appended.
 199
 200 Here are some examples:
 201
 202   (\"JohnWiki\" . \"http://alice.dynodns.net/wiki?\")
 203
 204 Referring to [[JohnWiki::EmacsModules]] then really means:
 205
 206   http://alice.dynodns.net/wiki?EmacsModules
 207
 208 If a function is used for the replacement text, you can get creative
 209 depending on what the tag is.  Tags may contain any alphabetic
 210 character, any number, % or _.  If you need other special characters,
 211 use % to specify the hex code, as in %2E.  All browsers should support
 212 this."
 213   :type '(repeat (cons (string :tag "WikiName")
 214                        (choice (string :tag "URL") function)))
 215   :set (function
 216         (lambda (sym value)
 217           (set sym value)
 218           (muse-wiki-update-interwiki-regexp)))
 219   :group 'muse-wiki)
 220
 221 (add-hook 'muse-update-values-hook
 222           'muse-wiki-update-interwiki-regexp)
 223
 224 (defun muse-wiki-resolve-project-page (&optional project page)
 225   "Return the published path from the current page to PAGE of PROJECT.
 226
 227 If PAGE is not specified, use the value of :default in PROJECT.
 228
 229 If PROJECT is not specified, default to the current project.  If
 230 no project is current, use the first project of
 231 `muse-projects-alist'.
 232
 233 Note that PAGE can have several output directories.  If this is
 234 the case, we will use the first one that matches our current
 235 style and has the same link suffix, ignoring the others.  If no
 236 style has the same link suffix as the current publishing style,
 237 use the first style we find."
 238   (setq project (or (and project
 239                          (muse-project project))
 240                     (muse-project)
 241                     (car muse-project-alist))
 242         page (or page (muse-get-keyword :default (cadr project))))
 243   (let* ((page-path (and muse-project-alist
 244                          (muse-project-page-file page project)))
 245          (remote-styles (and page-path (muse-project-applicable-styles
 246                                         page-path (cddr project))))
 247          (local-style (muse-project-current-output-style)))
 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-implicit-interwiki (&optional string)
 263   "If STRING or point has an interwiki link, resolve it to a filename.
 264
 265 Match string 0 is set to the link."
 266   (when (and muse-wiki-interwiki-regexp
 267              (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 (match-string 3 string))
 272            (anchor (if (match-beginning 4)
 273                        (match-string 4 string)
 274                      "")))
 275       (if subst
 276           (if (functionp subst)
 277               (and (setq word (funcall subst word))
 278                    (concat word anchor))
 279             (concat subst word anchor))
 280         (and (assoc project muse-project-alist)
 281              (or word (not muse-wiki-ignore-bare-project-names))
 282              (setq word (muse-wiki-resolve-project-page project word))
 283              (concat word anchor))))))
 284
 285 (defun muse-wiki-handle-explicit-interwiki (&optional string)
 286   "If STRING or point has an interwiki link, resolve it to a filename."
 287   (let ((right-pos (if string (length string) (match-end 1))))
 288     (when (and muse-wiki-interwiki-regexp
 289                (if string (string-match muse-wiki-interwiki-regexp string)
 290                  (save-restriction
 291                    (narrow-to-region (point) right-pos)
 292                    (looking-at muse-wiki-interwiki-regexp))))
 293       (let* ((project (match-string 1 string))
 294              (subst (cdr (assoc project muse-wiki-interwiki-alist)))
 295              (anchor (and (match-beginning 4)
 296                           (match-string 4 string)))
 297              (word (when (match-end 2)
 298                      (cond (anchor (match-string 3 string))
 299                            (string (substring string (match-end 2)))
 300                            (right-pos (buffer-substring (match-end 2)
 301                                                         right-pos))
 302                            (t nil)))))
 303         (if (and (null word)
 304                  right-pos
 305                  (not (= right-pos (match-end 1))))
 306             ;; if only a project name was found, it must take up the
 307             ;; entire string or link
 308             nil
 309           (unless anchor
 310             (if (or (null word)
 311                     (not (string-match "#[^#]+\\'" word)))
 312                 (setq anchor "")
 313               (setq anchor (match-string 0 word))
 314               (setq word (substring word 0 (match-beginning 0)))))
 315           (if subst
 316               (if (functionp subst)
 317                   (and (setq word (funcall subst word))
 318                        (concat word anchor))
 319                 (concat subst word anchor))
 320             (and (assoc project muse-project-alist)
 321                  (or word (not muse-wiki-ignore-bare-project-names))
 322                  (setq word (muse-wiki-resolve-project-page project word))
 323                  (concat word anchor))))))))
 324
 325 (defun muse-wiki-handle-wikiword (&optional string)
 326   "If STRING or point has a WikiWord, return it.
 327
 328 Match 1 is set to the WikiWord."
 329   (when (and (or (and muse-wiki-match-all-project-files
 330                       muse-wiki-project-file-regexp
 331                       (if string
 332                           (string-match muse-wiki-project-file-regexp string)
 333                         (looking-at muse-wiki-project-file-regexp)))
 334                  (and muse-wiki-use-wikiword
 335                       (if string
 336                           (string-match muse-wiki-wikiword-regexp string)
 337                         (looking-at muse-wiki-wikiword-regexp))))
 338              (cond
 339               (muse-wiki-allow-nonexistent-wikiword
 340                t)
 341               ((and muse-wiki-ignore-implicit-links-to-current-page
 342                     (string= (match-string 1 string) (muse-page-name)))
 343                nil)
 344               ((and (muse-project-of-file)
 345                     (muse-project-page-file
 346                      (match-string 1 string) muse-current-project t))
 347                t)
 348               ((file-exists-p (match-string 1 string))
 349                t)
 350               (t nil)))
 351     (match-string 1 string)))
 352
 353 ;;; Prettifications
 354
 355 (defcustom muse-wiki-publish-small-title-words
 356   '("the" "and" "at" "on" "of" "for" "in" "an" "a")
 357   "Strings that should be downcased in a page title.
 358
 359 This is used by `muse-wiki-publish-pretty-title', which must be
 360 called manually."
 361   :type '(repeat string)
 362   :group 'muse-wiki)
 363
 364 (defcustom muse-wiki-hide-nop-tag t
 365   "If non-nil, hide <nop> tags when coloring a Muse buffer."
 366   :type 'boolean
 367   :group 'muse-wiki)
 368
 369 (defun muse-wiki-publish-pretty-title (&optional title explicit)
 370   "Return a pretty version of the given TITLE.
 371
 372 If EXPLICIT is non-nil, TITLE will be returned unmodified."
 373   (unless title (setq title (or (muse-publishing-directive "title") "")))
 374   (if (or explicit
 375           (save-match-data (string-match muse-url-regexp title)))
 376       title
 377     (save-match-data
 378       (let ((case-fold-search nil))
 379         (while (string-match (concat "\\([" muse-regexp-lower
 380                                      "]\\)\\([" muse-regexp-upper
 381                                      "0-9]\\)")
 382                              title)
 383           (setq title (replace-match "\\1 \\2" t nil title)))
 384         (let* ((words (split-string title))
 385                (w (cdr words)))
 386           (while w
 387             (if (member (downcase (car w))
 388                         muse-wiki-publish-small-title-words)
 389                 (setcar w (downcase (car w))))
 390             (setq w (cdr w)))
 391           (mapconcat 'identity words " "))))))
 392
 393 (defun muse-wiki-publish-pretty-interwiki (desc &optional explicit)
 394   "Replace instances of `muse-wiki-interwiki-delimiter' with
 395 `muse-wiki-interwiki-replacement'."
 396   (if (or explicit
 397           (save-match-data (string-match muse-url-regexp desc)))
 398       desc
 399     (muse-replace-regexp-in-string muse-wiki-interwiki-delimiter
 400                                    muse-wiki-interwiki-replacement
 401                                    desc)))
 402
 403 ;;; Coloring setup
 404
 405 (defun muse-wiki-colors-nop-tag (beg end)
 406   "Inhibit the colorization of inhibit links just after the tag.
 407
 408 Example: <nop>WikiWord"
 409   (when muse-wiki-hide-nop-tag
 410     (add-text-properties beg (+ beg 5)
 411                          '(invisible muse intangible t)))
 412   (unless (> (+ beg 6) (point-max))
 413     (add-text-properties (+ beg 5) (+ beg 6)
 414                          '(muse-no-implicit-link t))))
 415
 416 (defun muse-colors-wikiword-separate ()
 417   (add-text-properties (match-beginning 0) (match-end 0)
 418                        '(invisible muse intangible t)))
 419
 420 (defun muse-wiki-insinuate-colors ()
 421   (add-to-list 'muse-colors-tags
 422                '("nop" nil nil nil muse-wiki-colors-nop-tag)
 423                t)
 424   (add-to-list 'muse-colors-markup
 425                '(muse-wiki-interwiki-regexp t muse-colors-implicit-link)
 426                t)
 427   (add-to-list 'muse-colors-markup
 428                '(muse-wiki-wikiword-regexp t muse-colors-implicit-link)
 429                t)
 430   (add-to-list 'muse-colors-markup
 431                '(muse-wiki-project-file-regexp t muse-colors-implicit-link)
 432                t)
 433   (add-to-list 'muse-colors-markup
 434                '("''''" ?\' muse-colors-wikiword-separate)
 435                nil)
 436   (muse-colors-define-highlighting 'muse-mode muse-colors-markup))
 437
 438 (eval-after-load "muse-colors" '(muse-wiki-insinuate-colors))
 439
 440 ;;; Publishing setup
 441
 442 (defun muse-wiki-publish-nop-tag (beg end)
 443   "Inhibit the colorization of inhibit links just after the tag.
 444
 445 Example: <nop>WikiWord"
 446   (unless (= (point) (point-max))
 447     (muse-publish-mark-read-only (point) (+ (point) 1))))
 448
 449 (defun muse-wiki-insinuate-publish ()
 450   (add-to-list 'muse-publish-markup-tags
 451                '("nop" nil nil nil muse-wiki-publish-nop-tag)
 452                t)
 453   (add-to-list 'muse-publish-markup-regexps
 454                '(3100 muse-wiki-interwiki-regexp 0 link)
 455                t)
 456   (add-to-list 'muse-publish-markup-regexps
 457                '(3200 muse-wiki-wikiword-regexp 0 link)
 458                t)
 459   (add-to-list 'muse-publish-markup-regexps
 460                '(3250 muse-wiki-project-file-regexp 0 link)
 461                t)
 462   (add-to-list 'muse-publish-markup-regexps
 463                '(3300 "''''" 0 "")
 464                t)
 465   (custom-add-option 'muse-publish-desc-transforms
 466                      'muse-wiki-publish-pretty-interwiki)
 467   (custom-add-option 'muse-publish-desc-transforms
 468                      'muse-wiki-publish-pretty-title))
 469
 470 (eval-after-load "muse-publish" '(muse-wiki-insinuate-publish))
 471
 472 ;;; Insinuate link handling
 473
 474 (custom-add-option 'muse-implicit-link-functions
 475                    'muse-wiki-handle-implicit-interwiki)
 476 (custom-add-option 'muse-implicit-link-functions
 477                    'muse-wiki-handle-wikiword)
 478
 479 (custom-add-option 'muse-explicit-link-functions
 480                    'muse-wiki-handle-explicit-interwiki)
 481
 482 (add-to-list 'muse-implicit-link-functions
 483              'muse-wiki-handle-implicit-interwiki t)
 484 (add-to-list 'muse-implicit-link-functions
 485              'muse-wiki-handle-wikiword t)
 486
 487 (add-to-list 'muse-explicit-link-functions
 488              'muse-wiki-handle-explicit-interwiki t)
 489
 490 ;;; Obsolete functions
 491
 492 (defun muse-wiki-update-custom-values ()
 493   (muse-display-warning
 494    (concat "Please remove `muse-wiki-update-custom-values' from"
 495            " `muse-mode-hook'.  Its use is now deprecated.")))
 496
 497 (provide 'muse-wiki)
 498 ;;; muse-wiki.el ends here