1 ;;; muse-wiki.el --- wiki features for Muse
3 ;; Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc.
5 ;; Author: Yann Hodique <Yann.Hodique@lifl.fr>
8 ;; This file is part of Emacs Muse. It is not part of GNU Emacs.
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 2, or (at your
13 ;; option) any later version.
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.
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.
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.
34 (require 'muse-regexps
)
38 (require 'muse-colors
))
40 (defgroup muse-wiki nil
41 "Options controlling the behavior of Emacs Muse Wiki features."
44 (defcustom muse-wiki-use-wikiword t
45 "Whether to use color and publish bare WikiNames."
49 (defcustom muse-wiki-allow-nonexistent-wikiword nil
50 "Whether to color bare WikiNames that don't have an existing file."
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."
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."
66 (defvar muse-wiki-project-file-regexp nil
67 "Regexp used to match the files in the current project.
69 This is set by `muse-wiki-update-project-file-regexp' automatically
70 when `muse-wiki-martch-all-project-files' is non-nil.")
71 (make-variable-buffer-local 'muse-wiki-project-file-regexp
)
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
82 ;; include all files from the project
83 (regexp-opt files
'words
)
85 ;; update coloring setup
86 (when (featurep 'muse-colors
)
87 (muse-configure-highlighting
88 'muse-colors-markup muse-colors-markup
))))
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
)
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."
103 (when (featurep 'muse-colors
)
104 (muse-configure-highlighting
105 'muse-colors-markup muse-colors-markup
))))
109 (defcustom muse-wiki-ignore-bare-project-names nil
110 "Determine whether project names without a page specifer are links.
112 If non-nil, project names without a page specifier will not be
115 When nil, project names without a specifier are highlighted and
116 they link to the default page of the project that they name."
120 (defvar muse-wiki-interwiki-regexp nil
121 "Regexp that matches all interwiki links.
123 This is automatically generated by setting `muse-wiki-interwiki-alist'.
124 It can also be set by calling `muse-wiki-update-interwiki-regexp'.")
126 (defcustom muse-wiki-interwiki-delimiter
"#\\|::"
127 "Delimiter regexp used for InterWiki links.
129 If you use groups, use only shy groups."
133 (defcustom muse-wiki-interwiki-replacement
": "
134 "Regexp used for replacing `muse-wiki-interwiki-delimiter' in
135 InterWiki link descriptions.
137 If you want this replacement to happen, you must add
138 `muse-wiki-publish-pretty-interwiki' to
139 `muse-publish-desc-transforms'."
144 (defvar muse-wiki-interwiki-alist
))
146 (defun muse-wiki-project-files-with-spaces (&optional project
)
147 "Return a list of files in PROJECT that have spaces."
148 (setq project
(muse-project project
))
151 (mapcar (function (lambda (file)
152 (when (string-match " " (car file
))
153 (setq flist
(cons (car file
) flist
)))))
154 (muse-project-file-alist project
)))
157 (defun muse-wiki-update-interwiki-regexp ()
158 "Update the value of `muse-wiki-interwiki-regexp' based on
159 `muse-wiki-interwiki-alist' and `muse-project-alist'."
160 (if (null muse-project-alist
)
161 (setq muse-wiki-interwiki-regexp nil
)
162 (setq muse-wiki-interwiki-regexp
163 (concat "\\<\\(" (regexp-opt (mapcar #'car muse-project-alist
))
164 (when muse-wiki-interwiki-alist
165 (let ((interwiki-rules (mapcar #'car
166 muse-wiki-interwiki-alist
)))
167 (when interwiki-rules
168 (concat "\\|" (regexp-opt interwiki-rules
)))))
169 "\\)\\(?:\\(" muse-wiki-interwiki-delimiter
171 (when muse-wiki-match-all-project-files
172 ;; append the files from the project
174 (dolist (proj muse-project-alist
)
176 (nconc (muse-wiki-project-files-with-spaces
180 (concat (regexp-opt files
) "\\|"))))
181 "\\sw+\\)\\(#\\S-+\\)?\\)?\\>"))
182 (when (featurep 'muse-colors
)
183 (muse-configure-highlighting 'muse-colors-markup muse-colors-markup
))))
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.
189 The format of this table is an alist, or series of cons cells.
190 Each cons cell must be of the form:
192 (WIKINAME . STRING-OR-FUNCTION)
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.
200 Here are some examples:
202 (\"JohnWiki\" . \"http://alice.dynodns.net/wiki?\")
204 Referring to [[JohnWiki::EmacsModules]] then really means:
206 http://alice.dynodns.net/wiki?EmacsModules
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
213 :type
'(repeat (cons (string :tag
"WikiName")
214 (choice (string :tag
"URL") function
)))
218 (muse-wiki-update-interwiki-regexp)))
221 (add-hook 'muse-update-values-hook
222 'muse-wiki-update-interwiki-regexp
)
224 (defun muse-wiki-resolve-project-page (&optional project page
)
225 "Return the published path from the current page to PAGE of PROJECT.
227 If PAGE is not specified, use the value of :default in PROJECT.
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'.
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
))
241 (car muse-project-alist
))
242 page
(or page
(muse-get-keyword :default
244 (let* ((page-path (and muse-project-alist
245 (muse-project-page-file page project
)))
246 (remote-styles (and page-path
(muse-project-applicable-styles
247 page-path
(cddr project
))))
248 (local-style (muse-project-current-output-style)))
249 (cond ((and remote-styles local-style muse-publishing-p
)
250 (muse-project-resolve-link page local-style remote-styles
))
251 ((not muse-publishing-p
)
254 (when muse-wiki-allow-nonexistent-wikiword
255 ;; make a path to a nonexistent file in project
256 (setq page-path
(expand-file-name
257 page
(car (cadr project
))))
258 (if (and muse-file-extension
259 (not (string= muse-file-extension
"")))
260 (concat page-path
"." muse-file-extension
)
263 (defun muse-wiki-handle-implicit-interwiki (&optional string
)
264 "If STRING or point has an interwiki link, resolve it to a filename.
266 Match string 0 is set to the link."
267 (when (and muse-wiki-interwiki-regexp
268 (if string
(string-match muse-wiki-interwiki-regexp string
)
269 (looking-at muse-wiki-interwiki-regexp
)))
270 (let* ((project (match-string 1 string
))
271 (subst (cdr (assoc project muse-wiki-interwiki-alist
)))
272 (word (match-string 3 string
))
273 (anchor (if (match-beginning 4)
274 (match-string 4 string
)
277 (if (functionp subst
)
278 (and (setq word
(funcall subst word
))
279 (concat word anchor
))
280 (concat subst word anchor
))
281 (and (assoc project muse-project-alist
)
282 (or word
(not muse-wiki-ignore-bare-project-names
))
283 (setq word
(muse-wiki-resolve-project-page project word
))
284 (concat word anchor
))))))
286 (defun muse-wiki-handle-explicit-interwiki (&optional string
)
287 "If STRING or point has an interwiki link, resolve it to a filename."
288 (let ((right-pos (if string
(length string
) (match-end 1))))
289 (when (and muse-wiki-interwiki-regexp
290 (if string
(string-match muse-wiki-interwiki-regexp string
)
292 (narrow-to-region (point) right-pos
)
293 (looking-at muse-wiki-interwiki-regexp
))))
294 (let* ((project (match-string 1 string
))
295 (subst (cdr (assoc project muse-wiki-interwiki-alist
)))
296 (anchor (and (match-beginning 4)
297 (match-string 4 string
)))
298 (word (when (match-end 2)
299 (cond (anchor (match-string 3 string
))
300 (string (substring string
(match-end 2)))
301 (right-pos (buffer-substring (match-end 2)
306 (not (= right-pos
(match-end 1))))
307 ;; if only a project name was found, it must take up the
308 ;; entire string or link
312 (not (string-match "#[^#]+\\'" word
)))
314 (setq anchor
(match-string 0 word
))
315 (setq word
(substring word
0 (match-beginning 0)))))
317 (if (functionp subst
)
318 (and (setq word
(funcall subst word
))
319 (concat word anchor
))
320 (concat subst word anchor
))
321 (and (assoc project muse-project-alist
)
322 (or word
(not muse-wiki-ignore-bare-project-names
))
323 (setq word
(muse-wiki-resolve-project-page project word
))
324 (concat word anchor
))))))))
326 (defun muse-wiki-handle-wikiword (&optional string
)
327 "If STRING or point has a WikiWord, return it.
329 Match 1 is set to the WikiWord."
330 (when (and (or (and muse-wiki-match-all-project-files
331 muse-wiki-project-file-regexp
333 (string-match muse-wiki-project-file-regexp string
)
334 (looking-at muse-wiki-project-file-regexp
)))
335 (and muse-wiki-use-wikiword
337 (string-match muse-wiki-wikiword-regexp string
)
338 (looking-at muse-wiki-wikiword-regexp
))))
340 (muse-wiki-allow-nonexistent-wikiword
342 ((and muse-wiki-ignore-implicit-links-to-current-page
343 (string= (match-string 1 string
) (muse-page-name)))
345 ((and (muse-project-of-file)
346 (muse-project-page-file
347 (match-string 1 string
) muse-current-project t
))
349 ((file-exists-p (match-string 1 string
))
352 (match-string 1 string
)))
356 (defcustom muse-wiki-publish-small-title-words
357 '("the" "and" "at" "on" "of" "for" "in" "an" "a")
358 "Strings that should be downcased in a page title.
360 This is used by `muse-wiki-publish-pretty-title', which must be
362 :type
'(repeat string
)
365 (defcustom muse-wiki-hide-nop-tag t
366 "If non-nil, hide <nop> tags when coloring a Muse buffer."
370 (defun muse-wiki-publish-pretty-title (&optional title explicit
)
371 "Return a pretty version of the given TITLE.
373 If EXPLICIT is non-nil, TITLE will be returned unmodified."
374 (unless title
(setq title
(or (muse-publishing-directive "title") "")))
376 (save-match-data (string-match muse-url-regexp title
)))
379 (let ((case-fold-search nil
))
380 (while (string-match (concat "\\([" muse-regexp-lower
381 "]\\)\\([" muse-regexp-upper
384 (setq title
(replace-match "\\1 \\2" t nil title
)))
385 (let* ((words (split-string title
))
388 (if (member (downcase (car w
))
389 muse-wiki-publish-small-title-words
)
390 (setcar w
(downcase (car w
))))
392 (mapconcat 'identity words
" "))))))
394 (defun muse-wiki-publish-pretty-interwiki (desc &optional explicit
)
395 "Replace instances of `muse-wiki-interwiki-delimiter' with
396 `muse-wiki-interwiki-replacement'."
398 (save-match-data (string-match muse-url-regexp desc
)))
400 (muse-replace-regexp-in-string muse-wiki-interwiki-delimiter
401 muse-wiki-interwiki-replacement
406 (eval-after-load "muse-colors"
408 (defun muse-wiki-colors-nop-tag (beg end
)
409 (when muse-wiki-hide-nop-tag
410 (add-text-properties beg
(+ beg
5)
411 '(invisible muse intangible t
))))
412 (defun muse-colors-wikiword-separate ()
413 (add-text-properties (match-beginning 0) (match-end 0)
414 '(invisible muse intangible t
)))
416 (add-to-list 'muse-colors-tags
417 '("nop" nil nil nil muse-wiki-colors-nop-tag
)
420 (add-to-list 'muse-colors-markup
421 '(muse-wiki-interwiki-regexp t muse-colors-implicit-link
)
423 (add-to-list 'muse-colors-markup
424 '(muse-wiki-wikiword-regexp t muse-colors-implicit-link
)
426 (add-to-list 'muse-colors-markup
427 '(muse-wiki-project-file-regexp t muse-colors-implicit-link
)
429 (add-to-list 'muse-colors-markup
430 '("''''" ?
\' muse-colors-wikiword-separate
)
433 (muse-configure-highlighting 'muse-colors-markup muse-colors-markup
)))
437 (eval-after-load "muse-publish"
439 (add-to-list 'muse-publish-markup-regexps
440 '(3100 muse-wiki-interwiki-regexp
0 link
)
442 (add-to-list 'muse-publish-markup-regexps
443 '(3200 muse-wiki-wikiword-regexp
0 link
)
445 (add-to-list 'muse-publish-markup-regexps
446 '(3250 muse-wiki-project-file-regexp
0 link
)
448 (add-to-list 'muse-publish-markup-regexps
452 (custom-add-option 'muse-publish-desc-transforms
453 'muse-wiki-publish-pretty-interwiki
)
454 (custom-add-option 'muse-publish-desc-transforms
455 'muse-wiki-publish-pretty-title
)))
457 ;;; Insinuate link handling
459 (custom-add-option 'muse-implicit-link-functions
460 'muse-wiki-handle-implicit-interwiki
)
461 (custom-add-option 'muse-implicit-link-functions
462 'muse-wiki-handle-wikiword
)
464 (custom-add-option 'muse-explicit-link-functions
465 'muse-wiki-handle-explicit-interwiki
)
467 (add-to-list 'muse-implicit-link-functions
468 'muse-wiki-handle-implicit-interwiki t
)
469 (add-to-list 'muse-implicit-link-functions
470 'muse-wiki-handle-wikiword t
)
472 (add-to-list 'muse-explicit-link-functions
473 'muse-wiki-handle-explicit-interwiki t
)
475 ;;; Obsolete functions
477 (defun muse-wiki-update-custom-values ()
478 (muse-display-warning
479 (concat "Please remove `muse-wiki-update-custom-values' from"
480 " `muse-mode-hook'. Its use is now deprecated.")))
483 ;;; muse-wiki.el ends here