diff options
Diffstat (limited to 'emacs.d/elisp/muse/muse-wiki.el')
| -rw-r--r-- | emacs.d/elisp/muse/muse-wiki.el | 498 |
1 files changed, 0 insertions, 498 deletions
diff --git a/emacs.d/elisp/muse/muse-wiki.el b/emacs.d/elisp/muse/muse-wiki.el deleted file mode 100644 index e2cd3a2..0000000 --- a/emacs.d/elisp/muse/muse-wiki.el +++ /dev/null @@ -1,498 +0,0 @@ -;;; 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 |