--- /dev/null
+;;; muse-wiki.el --- wiki features for Muse
+
+;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
+
+;; Author: Yann Hodique <Yann.Hodique@lifl.fr>
+;; Keywords:
+
+;; This file is part of Emacs Muse. It is not part of GNU Emacs.
+
+;; Emacs Muse is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 3, or (at your
+;; option) any later version.
+
+;; Emacs Muse is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with Emacs Muse; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;;; Contributors:
+
+;; Per B. Sederberg (per AT med DOT upenn DOT edu) made it so that all
+;; files in a Muse project can become implicit links.
+
+;;; Code:
+
+(require 'muse-regexps)
+(require 'muse-mode)
+
+(eval-when-compile
+ (require 'muse-colors))
+
+(defgroup muse-wiki nil
+ "Options controlling the behavior of Emacs Muse Wiki features."
+ :group 'muse-mode)
+
+(defcustom muse-wiki-use-wikiword t
+ "Whether to use color and publish bare WikiNames."
+ :type 'boolean
+ :group 'muse-wiki)
+
+(defcustom muse-wiki-allow-nonexistent-wikiword nil
+ "Whether to color bare WikiNames that don't have an existing file."
+ :type 'boolean
+ :group 'muse-wiki)
+
+(defcustom muse-wiki-match-all-project-files nil
+ "If non-nil, Muse will color and publish implicit links to any
+file in your project, regardless of whether its name is a WikiWord."
+ :type 'boolean
+ :group 'muse-wiki)
+
+(defcustom muse-wiki-ignore-implicit-links-to-current-page nil
+ "If non-nil, Muse will not recognize implicit links to the current
+page, both when formatting and publishing."
+ :type 'boolean
+ :group 'muse-wiki)
+
+(defvar muse-wiki-project-file-regexp nil
+ "Regexp used to match the files in the current project.
+
+This is set by `muse-wiki-update-project-file-regexp' automatically
+when `muse-wiki-match-all-project-files' is non-nil.")
+(make-variable-buffer-local 'muse-wiki-project-file-regexp)
+
+(defun muse-wiki-update-project-file-regexp ()
+ "Update a local copy of `muse-wiki-project-file-regexp' to include
+all the files in the project."
+ ;; see if the user wants to match project files
+ (when muse-wiki-match-all-project-files
+ (let ((files (mapcar #'car (muse-project-file-alist (muse-project)))))
+ (setq muse-wiki-project-file-regexp
+ (when files
+ (concat "\\("
+ ;; include all files from the project
+ (regexp-opt files 'words)
+ "\\)"))))
+ ;; update coloring setup
+ (when (featurep 'muse-colors)
+ (muse-colors-define-highlighting 'muse-mode muse-colors-markup))))
+
+(add-hook 'muse-update-values-hook
+ 'muse-wiki-update-project-file-regexp)
+(add-hook 'muse-project-file-alist-hook
+ 'muse-wiki-update-project-file-regexp)
+
+(defcustom muse-wiki-wikiword-regexp
+ (concat "\\<\\(\\(?:[" muse-regexp-upper
+ "]+[" muse-regexp-lower "]+\\)\\(?:["
+ muse-regexp-upper "]+[" muse-regexp-lower "]+\\)+\\)")
+ "Regexp used to match WikiWords."
+ :set (function
+ (lambda (sym value)
+ (set sym value)
+ (when (featurep 'muse-colors)
+ (muse-colors-define-highlighting 'muse-mode muse-colors-markup))))
+ :type 'regexp
+ :group 'muse-wiki)
+
+(defcustom muse-wiki-ignore-bare-project-names nil
+ "Determine whether project names without a page specifer are links.
+
+If non-nil, project names without a page specifier will not be
+considered links.
+
+When nil, project names without a specifier are highlighted and
+they link to the default page of the project that they name."
+ :type 'boolean
+ :group 'muse-wiki)
+
+(defvar muse-wiki-interwiki-regexp nil
+ "Regexp that matches all interwiki links.
+
+This is automatically generated by setting `muse-wiki-interwiki-alist'.
+It can also be set by calling `muse-wiki-update-interwiki-regexp'.")
+
+(defcustom muse-wiki-interwiki-delimiter "#\\|::"
+ "Delimiter regexp used for InterWiki links.
+
+If you use groups, use only shy groups."
+ :type 'regexp
+ :group 'muse-wiki)
+
+(defcustom muse-wiki-interwiki-replacement ": "
+ "Regexp used for replacing `muse-wiki-interwiki-delimiter' in
+InterWiki link descriptions.
+
+If you want this replacement to happen, you must add
+`muse-wiki-publish-pretty-interwiki' to
+`muse-publish-desc-transforms'."
+ :type 'regexp
+ :group 'muse-wiki)
+
+(eval-when-compile
+ (defvar muse-wiki-interwiki-alist))
+
+(defun muse-wiki-project-files-with-spaces (&optional project)
+ "Return a list of files in PROJECT that have spaces."
+ (setq project (muse-project project))
+ (let ((flist nil))
+ (save-match-data
+ (dolist (entry (muse-project-file-alist project))
+ (when (string-match " " (car entry))
+ (setq flist (cons (car entry) flist)))))
+ flist))
+
+(defun muse-wiki-update-interwiki-regexp ()
+ "Update the value of `muse-wiki-interwiki-regexp' based on
+`muse-wiki-interwiki-alist' and `muse-project-alist'."
+ (if (null muse-project-alist)
+ (setq muse-wiki-interwiki-regexp nil)
+ (let ((old-value muse-wiki-interwiki-regexp))
+ (setq muse-wiki-interwiki-regexp
+ (concat "\\<\\(" (regexp-opt (mapcar #'car muse-project-alist))
+ (when muse-wiki-interwiki-alist
+ (let ((interwiki-rules
+ (mapcar #'car muse-wiki-interwiki-alist)))
+ (when interwiki-rules
+ (concat "\\|" (regexp-opt interwiki-rules)))))
+ "\\)\\(?:\\(" muse-wiki-interwiki-delimiter
+ "\\)\\("
+ (when muse-wiki-match-all-project-files
+ ;; append the files from the project
+ (let ((files nil))
+ (dolist (proj muse-project-alist)
+ (setq files
+ (nconc (muse-wiki-project-files-with-spaces
+ (car proj))
+ files)))
+ (when files
+ (concat (regexp-opt files) "\\|"))))
+ "\\sw+\\)\\(#\\S-+\\)?\\)?\\>"))
+ (when (and (featurep 'muse-colors)
+ (not (string= old-value muse-wiki-interwiki-regexp)))
+ (muse-colors-define-highlighting 'muse-mode muse-colors-markup)))))
+
+(defcustom muse-wiki-interwiki-alist
+ '(("EmacsWiki" . "http://www.emacswiki.org/cgi-bin/wiki/"))
+ "A table of WikiNames that refer to external entities.
+
+The format of this table is an alist, or series of cons cells.
+Each cons cell must be of the form:
+
+ (WIKINAME . STRING-OR-FUNCTION)
+
+The second part of the cons cell may either be a STRING, which in most
+cases should be a URL, or a FUNCTION. If a function, it will be
+called with one argument: the tag applied to the Interwiki name, or
+nil if no tag was used. If the cdr was a STRING and a tag is used,
+the tag is simply appended.
+
+Here are some examples:
+
+ (\"JohnWiki\" . \"http://alice.dynodns.net/wiki?\")
+
+Referring to [[JohnWiki::EmacsModules]] then really means:
+
+ http://alice.dynodns.net/wiki?EmacsModules
+
+If a function is used for the replacement text, you can get creative
+depending on what the tag is. Tags may contain any alphabetic
+character, any number, % or _. If you need other special characters,
+use % to specify the hex code, as in %2E. All browsers should support
+this."
+ :type '(repeat (cons (string :tag "WikiName")
+ (choice (string :tag "URL") function)))
+ :set (function
+ (lambda (sym value)
+ (set sym value)
+ (muse-wiki-update-interwiki-regexp)))
+ :group 'muse-wiki)
+
+(add-hook 'muse-update-values-hook
+ 'muse-wiki-update-interwiki-regexp)
+
+(defun muse-wiki-resolve-project-page (&optional project page)
+ "Return the published path from the current page to PAGE of PROJECT.
+
+If PAGE is not specified, use the value of :default in PROJECT.
+
+If PROJECT is not specified, default to the current project. If
+no project is current, use the first project of
+`muse-projects-alist'.
+
+Note that PAGE can have several output directories. If this is
+the case, we will use the first one that matches our current
+style and has the same link suffix, ignoring the others. If no
+style has the same link suffix as the current publishing style,
+use the first style we find."
+ (setq project (or (and project
+ (muse-project project))
+ (muse-project)
+ (car muse-project-alist))
+ page (or page (muse-get-keyword :default (cadr project))))
+ (let* ((page-path (and muse-project-alist
+ (muse-project-page-file page project)))
+ (remote-styles (and page-path (muse-project-applicable-styles
+ page-path (cddr project))))
+ (local-style (muse-project-current-output-style)))
+ (cond ((and remote-styles local-style muse-publishing-p)
+ (muse-project-resolve-link page local-style remote-styles))
+ ((not muse-publishing-p)
+ (if page-path
+ page-path
+ (when muse-wiki-allow-nonexistent-wikiword
+ ;; make a path to a nonexistent file in project
+ (setq page-path (expand-file-name
+ page (car (cadr project))))
+ (if (and muse-file-extension
+ (not (string= muse-file-extension "")))
+ (concat page-path "." muse-file-extension)
+ page-path)))))))
+
+(defun muse-wiki-handle-implicit-interwiki (&optional string)
+ "If STRING or point has an interwiki link, resolve it to a filename.
+
+Match string 0 is set to the link."
+ (when (and muse-wiki-interwiki-regexp
+ (if string (string-match muse-wiki-interwiki-regexp string)
+ (looking-at muse-wiki-interwiki-regexp)))
+ (let* ((project (match-string 1 string))
+ (subst (cdr (assoc project muse-wiki-interwiki-alist)))
+ (word (match-string 3 string))
+ (anchor (if (match-beginning 4)
+ (match-string 4 string)
+ "")))
+ (if subst
+ (if (functionp subst)
+ (and (setq word (funcall subst word))
+ (concat word anchor))
+ (concat subst word anchor))
+ (and (assoc project muse-project-alist)
+ (or word (not muse-wiki-ignore-bare-project-names))
+ (setq word (muse-wiki-resolve-project-page project word))
+ (concat word anchor))))))
+
+(defun muse-wiki-handle-explicit-interwiki (&optional string)
+ "If STRING or point has an interwiki link, resolve it to a filename."
+ (let ((right-pos (if string (length string) (match-end 1))))
+ (when (and muse-wiki-interwiki-regexp
+ (if string (string-match muse-wiki-interwiki-regexp string)
+ (save-restriction
+ (narrow-to-region (point) right-pos)
+ (looking-at muse-wiki-interwiki-regexp))))
+ (let* ((project (match-string 1 string))
+ (subst (cdr (assoc project muse-wiki-interwiki-alist)))
+ (anchor (and (match-beginning 4)
+ (match-string 4 string)))
+ (word (when (match-end 2)
+ (cond (anchor (match-string 3 string))
+ (string (substring string (match-end 2)))
+ (right-pos (buffer-substring (match-end 2)
+ right-pos))
+ (t nil)))))
+ (if (and (null word)
+ right-pos
+ (not (= right-pos (match-end 1))))
+ ;; if only a project name was found, it must take up the
+ ;; entire string or link
+ nil
+ (unless anchor
+ (if (or (null word)
+ (not (string-match "#[^#]+\\'" word)))
+ (setq anchor "")
+ (setq anchor (match-string 0 word))
+ (setq word (substring word 0 (match-beginning 0)))))
+ (if subst
+ (if (functionp subst)
+ (and (setq word (funcall subst word))
+ (concat word anchor))
+ (concat subst word anchor))
+ (and (assoc project muse-project-alist)
+ (or word (not muse-wiki-ignore-bare-project-names))
+ (setq word (muse-wiki-resolve-project-page project word))
+ (concat word anchor))))))))
+
+(defun muse-wiki-handle-wikiword (&optional string)
+ "If STRING or point has a WikiWord, return it.
+
+Match 1 is set to the WikiWord."
+ (when (and (or (and muse-wiki-match-all-project-files
+ muse-wiki-project-file-regexp
+ (if string
+ (string-match muse-wiki-project-file-regexp string)
+ (looking-at muse-wiki-project-file-regexp)))
+ (and muse-wiki-use-wikiword
+ (if string
+ (string-match muse-wiki-wikiword-regexp string)
+ (looking-at muse-wiki-wikiword-regexp))))
+ (cond
+ (muse-wiki-allow-nonexistent-wikiword
+ t)
+ ((and muse-wiki-ignore-implicit-links-to-current-page
+ (string= (match-string 1 string) (muse-page-name)))
+ nil)
+ ((and (muse-project-of-file)
+ (muse-project-page-file
+ (match-string 1 string) muse-current-project t))
+ t)
+ ((file-exists-p (match-string 1 string))
+ t)
+ (t nil)))
+ (match-string 1 string)))
+
+;;; Prettifications
+
+(defcustom muse-wiki-publish-small-title-words
+ '("the" "and" "at" "on" "of" "for" "in" "an" "a")
+ "Strings that should be downcased in a page title.
+
+This is used by `muse-wiki-publish-pretty-title', which must be
+called manually."
+ :type '(repeat string)
+ :group 'muse-wiki)
+
+(defcustom muse-wiki-hide-nop-tag t
+ "If non-nil, hide <nop> tags when coloring a Muse buffer."
+ :type 'boolean
+ :group 'muse-wiki)
+
+(defun muse-wiki-publish-pretty-title (&optional title explicit)
+ "Return a pretty version of the given TITLE.
+
+If EXPLICIT is non-nil, TITLE will be returned unmodified."
+ (unless title (setq title (or (muse-publishing-directive "title") "")))
+ (if (or explicit
+ (save-match-data (string-match muse-url-regexp title)))
+ title
+ (save-match-data
+ (let ((case-fold-search nil))
+ (while (string-match (concat "\\([" muse-regexp-lower
+ "]\\)\\([" muse-regexp-upper
+ "0-9]\\)")
+ title)
+ (setq title (replace-match "\\1 \\2" t nil title)))
+ (let* ((words (split-string title))
+ (w (cdr words)))
+ (while w
+ (if (member (downcase (car w))
+ muse-wiki-publish-small-title-words)
+ (setcar w (downcase (car w))))
+ (setq w (cdr w)))
+ (mapconcat 'identity words " "))))))
+
+(defun muse-wiki-publish-pretty-interwiki (desc &optional explicit)
+ "Replace instances of `muse-wiki-interwiki-delimiter' with
+`muse-wiki-interwiki-replacement'."
+ (if (or explicit
+ (save-match-data (string-match muse-url-regexp desc)))
+ desc
+ (muse-replace-regexp-in-string muse-wiki-interwiki-delimiter
+ muse-wiki-interwiki-replacement
+ desc)))
+
+;;; Coloring setup
+
+(defun muse-wiki-colors-nop-tag (beg end)
+ "Inhibit the colorization of inhibit links just after the tag.
+
+Example: <nop>WikiWord"
+ (when muse-wiki-hide-nop-tag
+ (add-text-properties beg (+ beg 5)
+ '(invisible muse intangible t)))
+ (unless (> (+ beg 6) (point-max))
+ (add-text-properties (+ beg 5) (+ beg 6)
+ '(muse-no-implicit-link t))))
+
+(defun muse-colors-wikiword-separate ()
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(invisible muse intangible t)))
+
+(defun muse-wiki-insinuate-colors ()
+ (add-to-list 'muse-colors-tags
+ '("nop" nil nil nil muse-wiki-colors-nop-tag)
+ t)
+ (add-to-list 'muse-colors-markup
+ '(muse-wiki-interwiki-regexp t muse-colors-implicit-link)
+ t)
+ (add-to-list 'muse-colors-markup
+ '(muse-wiki-wikiword-regexp t muse-colors-implicit-link)
+ t)
+ (add-to-list 'muse-colors-markup
+ '(muse-wiki-project-file-regexp t muse-colors-implicit-link)
+ t)
+ (add-to-list 'muse-colors-markup
+ '("''''" ?\' muse-colors-wikiword-separate)
+ nil)
+ (muse-colors-define-highlighting 'muse-mode muse-colors-markup))
+
+(eval-after-load "muse-colors" '(muse-wiki-insinuate-colors))
+
+;;; Publishing setup
+
+(defun muse-wiki-publish-nop-tag (beg end)
+ "Inhibit the colorization of inhibit links just after the tag.
+
+Example: <nop>WikiWord"
+ (unless (= (point) (point-max))
+ (muse-publish-mark-read-only (point) (+ (point) 1))))
+
+(defun muse-wiki-insinuate-publish ()
+ (add-to-list 'muse-publish-markup-tags
+ '("nop" nil nil nil muse-wiki-publish-nop-tag)
+ t)
+ (add-to-list 'muse-publish-markup-regexps
+ '(3100 muse-wiki-interwiki-regexp 0 link)
+ t)
+ (add-to-list 'muse-publish-markup-regexps
+ '(3200 muse-wiki-wikiword-regexp 0 link)
+ t)
+ (add-to-list 'muse-publish-markup-regexps
+ '(3250 muse-wiki-project-file-regexp 0 link)
+ t)
+ (add-to-list 'muse-publish-markup-regexps
+ '(3300 "''''" 0 "")
+ t)
+ (custom-add-option 'muse-publish-desc-transforms
+ 'muse-wiki-publish-pretty-interwiki)
+ (custom-add-option 'muse-publish-desc-transforms
+ 'muse-wiki-publish-pretty-title))
+
+(eval-after-load "muse-publish" '(muse-wiki-insinuate-publish))
+
+;;; Insinuate link handling
+
+(custom-add-option 'muse-implicit-link-functions
+ 'muse-wiki-handle-implicit-interwiki)
+(custom-add-option 'muse-implicit-link-functions
+ 'muse-wiki-handle-wikiword)
+
+(custom-add-option 'muse-explicit-link-functions
+ 'muse-wiki-handle-explicit-interwiki)
+
+(add-to-list 'muse-implicit-link-functions
+ 'muse-wiki-handle-implicit-interwiki t)
+(add-to-list 'muse-implicit-link-functions
+ 'muse-wiki-handle-wikiword t)
+
+(add-to-list 'muse-explicit-link-functions
+ 'muse-wiki-handle-explicit-interwiki t)
+
+;;; Obsolete functions
+
+(defun muse-wiki-update-custom-values ()
+ (muse-display-warning
+ (concat "Please remove `muse-wiki-update-custom-values' from"
+ " `muse-mode-hook'. Its use is now deprecated.")))
+
+(provide 'muse-wiki)
+;;; muse-wiki.el ends here