1 ;;; muse-wiki.el --- wiki features for muse
3 ;; Copyright (C) 2005 Free Software Foundation, Inc.
5 ;; Author: Yann Hodique <Yann.Hodique@lifl.fr>
8 ;; This file is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; This file is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the
20 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 ;; Boston, MA 02110-1301, USA.
27 (require 'muse-regexps
)
31 (require 'muse-colors
))
33 (defgroup muse-wiki nil
34 "Options controlling the behavior of Emacs Muse Wiki features."
37 (defun muse-wiki-update-wikiword-regexp (sym val
)
38 "Update everything related to `muse-wiki-wikiword-regexp'"
40 (if (featurep 'muse-colors
)
41 (muse-configure-highlighting 'muse-colors-markup muse-colors-markup
)))
43 (defcustom muse-wiki-hide-nop-tag t
44 "If non-nil, hide <nop> tags when coloring a Muse buffer."
48 (defcustom muse-wiki-wikiword-regexp
49 (concat "\\<\\(\\(?:[" muse-regexp-upper
50 "][" muse-regexp-lower
"]+\\)\\(?:["
51 muse-regexp-upper
"][" muse-regexp-lower
"]+\\)+\\)\\>")
52 "Regexp used to match WikiWords"
55 :set
'muse-wiki-update-wikiword-regexp
)
57 (defcustom muse-wiki-use-wikiword t
58 "Wether to use WikiWord syntax or not"
62 (defvar muse-wiki-interwiki-regexp
""
63 "Regexp that matches all interwiki links.
64 This is automatically generated by setting `muse-wiki-interwiki-alist'.
65 It can also be set by calling `muse-wiki-update-interwiki-regexp'.")
67 (defun muse-wiki-update-interwiki-regexp (value)
68 "Update the value of `muse-wiki-interwiki-regexp'."
70 (setq muse-wiki-interwiki-regexp
71 (concat "\\<\\(" (mapconcat 'car muse-project-alist
"\\|")
72 "\\|" (mapconcat 'car value
"\\|")
73 "\\)\\(?:\\(?:#\\|::\\)\\(\\sw+\\)\\)?\\>"))
74 (setq muse-wiki-interwiki-regexp
""))
75 (muse-configure-highlighting 'muse-colors-markup muse-colors-markup
))
77 (defcustom muse-wiki-interwiki-alist
78 '(("EmacsWiki" .
"http://www.emacswiki.org/cgi-bin/wiki/"))
79 "A table of WikiNames that refer to external entities.
80 The format of this table is an alist, or series of cons cells.
81 Each cons cell must be of the form:
83 (WIKINAME . STRING-OR-FUNCTION)
85 The second part of the cons cell may either be a STRING, which in most
86 cases should be a URL, or a FUNCTION. If a function, it will be
87 called with one argument: the tag applied to the Interwiki name, or
88 nil if no tag was used. If the cdr was a STRING and a tag is used,
89 the tag is simply appended.
91 Here are some examples:
93 (\"JohnWiki\" . \"http://alice.dynodns.net/wiki?\")
95 Referring to [[JohnWiki::EmacsModules]] then really means:
97 http://alice.dynodns.net/wiki?EmacsModules
99 If a function is used for the replacement text, you can get creative
100 depending on what the tag is. Tags may contain any alphabetic
101 character, any number, % or _. If you need other special characters,
102 use % to specify the hex code, as in %2E. All browsers should support
104 :type
'(repeat (cons (string :tag
"WikiName")
105 (choice (string :tag
"URL") function
)))
108 (muse-wiki-update-interwiki-regexp value
)
112 (defun muse-wiki-output-name (name)
113 "Much like `muse-publish-output-name', but keep the directory part."
114 (concat (file-name-directory name
)
115 (muse-publish-output-name name
)))
117 (defun muse-wiki-transform-interwiki (url explicit
)
118 "Return the destination of the given URL if it is an interwiki link.
119 Otherwise return URL. Read-only properties are added to the string."
120 (let ((res (muse-wiki-handle-interwiki url
)))
121 (if (and res
(not (string-match muse-image-regexp res
)))
122 (setq url
(muse-wiki-output-name res
))))
125 (defun muse-wiki-transform-wikiword (url explicit
)
126 "If URL is a WikiWord but does not correspond with an existing
127 file or interwiki name, return nil. Otherwise, return URL.
128 Read-only properties are added to the string."
129 (when (and muse-wiki-use-wikiword
131 (string-match (concat "^" muse-wiki-wikiword-regexp
"$") url
))
132 (unless (or (and (muse-project-of-file)
133 (muse-project-page-file
134 url muse-current-project t
))
136 ;; This is allowed to be the name of an interwiki or
137 ;; the name of a project.
138 (assoc url muse-project-alist
)
139 (assoc url muse-wiki-interwiki-alist
))
143 (defun muse-wiki-resolve-project-page (&optional project page
)
144 "Return the published path from the current page to PAGE of PROJECT.
145 If PAGE is not specified, use the value of :default in PROJECT.
146 If PROJECT is not specified, default to first project of
147 `muse-projects-alist'.
149 Note that PAGE can have several output directories. If this is
150 the case, we will use the first one that matches our current
151 style and ignore the others."
152 (setq project
(or project
(caar muse-project-alist
))
153 page
(or page
(muse-get-keyword :default
154 (cadr (muse-project project
)))))
155 (let ((remote-style (car (muse-project-applicable-styles
156 (muse-project-page-file page project
)
158 (local-style (car (muse-project-applicable-styles
159 (or muse-publishing-current-file buffer-file-name
)
160 (cddr (muse-project-of-file))))))
161 (file-relative-name (expand-file-name
162 page
(muse-style-element :path remote-style
))
164 (muse-style-element :path local-style
)))))
166 (defun muse-wiki-handle-interwiki (&optional string
)
167 "If STRING or point has an interwiki link, resolve it and
168 return the first match.
169 Match 1 is set to the link.
170 Match 2 is set to the description."
171 (when (if string
(string-match muse-wiki-interwiki-regexp string
)
172 (looking-at muse-wiki-interwiki-regexp
))
173 (let* ((project (match-string 1 string
))
174 (subst (cdr (assoc project muse-wiki-interwiki-alist
)))
175 (word (match-string 2 string
)))
177 (if (functionp subst
)
180 (and (assoc project muse-project-alist
)
181 (muse-wiki-resolve-project-page project word
))))))
183 (defun muse-wiki-handle-wikiword (&optional string
)
184 "If STRING or point has a WikiWord, return it.
185 Match 1 is set to the WikiWord."
186 (when (and muse-wiki-use-wikiword
188 (string-match muse-wiki-wikiword-regexp string
)
189 (looking-at muse-wiki-wikiword-regexp
))
190 (or (and (muse-project-of-file)
191 (muse-project-page-file
192 (match-string 1 string
) muse-current-project t
))
193 (file-exists-p (match-string 1 string
))))
194 (match-string 1 string
)))
198 (defcustom muse-wiki-publish-small-title-words
199 '("the" "and" "at" "on" "of" "for" "in" "an" "a")
200 "Strings that should be downcased in a page title.
201 This is used by `muse-wiki-publish-pretty-title', which must be
203 :type
'(repeat string
)
206 (defun muse-wiki-publish-pretty-title (&optional title
)
207 "Return a pretty version of the given TITLE."
208 (unless title
(setq title
(muse-publishing-directive "title")))
210 (let ((case-fold-search nil
))
211 (while (string-match (concat "\\([" muse-regexp-upper
213 "]\\)\\([" muse-regexp-upper
216 (setq title
(replace-match "\\1 \\2" t nil title
)))
217 (let* ((words (split-string title
))
220 (if (member (downcase (car w
))
221 muse-wiki-publish-small-title-words
)
222 (setcar w
(downcase (car w
))))
224 (mapconcat 'identity words
" ")))))
228 (eval-after-load "muse-colors"
230 (defun muse-wiki-colors-wikiword ()
232 ;; remove flyspell overlays
233 (when (fboundp 'flyspell-unhighlight-at
)
234 (let ((cur (match-beginning 0)))
235 (while (> (match-end 0) cur
)
236 (flyspell-unhighlight-at cur
)
237 (setq cur
(1+ cur
)))))
238 (let ((link (muse-match-string-no-properties 1))
239 (face (muse-link-face (match-string 1))))
241 (add-text-properties (match-beginning 1) (match-end 0)
242 (muse-link-properties
243 (muse-match-string-no-properties 1) face
)))))
245 (defun muse-wiki-colors-nop-tag (beg end
)
246 (when (and muse-wiki-hide-nop-tag
248 (add-text-properties beg end
249 '(invisible muse intangible t
))))
251 (add-to-list 'muse-colors-tags
252 '("nop" nil nil muse-wiki-colors-nop-tag
)
255 (add-to-list 'muse-colors-markup
256 '(muse-wiki-interwiki-regexp t muse-wiki-colors-wikiword
)
258 (add-to-list 'muse-colors-markup
259 '(muse-wiki-wikiword-regexp t muse-wiki-colors-wikiword
)
262 (muse-configure-highlighting 'muse-colors-markup muse-colors-markup
)))
266 (eval-after-load "muse-publish"
268 (add-to-list 'muse-publish-markup-regexps
269 '(3100 muse-wiki-interwiki-regexp
0 url
)
271 (add-to-list 'muse-publish-markup-regexps
272 '(3200 muse-wiki-wikiword-regexp
0 url
)
274 (add-to-list 'muse-publish-url-transforms
275 'muse-wiki-transform-interwiki
)
276 (add-to-list 'muse-publish-url-transforms
277 'muse-wiki-transform-wikiword
)))
279 ;; Insinuate link handling
281 (add-to-list 'muse-implicit-link-functions
282 'muse-wiki-handle-interwiki t
)
283 (add-to-list 'muse-implicit-link-functions
284 'muse-wiki-handle-wikiword t
)
286 (add-to-list 'muse-explicit-link-functions
287 'muse-wiki-handle-interwiki
)
289 ;; Update several things when Muse mode is entered
290 (add-hook 'muse-mode-hook
292 (muse-wiki-update-interwiki-regexp muse-wiki-interwiki-alist
)))
295 ;;; muse-wiki.el ends here