1 ;;; muse.el --- an authoring and publishing tool for Emacs
3 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
5 ;; Emacs Lisp Archive Entry
8 ;; Date: Sat 17-Dec-2005
9 ;; Keywords: hypermedia
10 ;; Author: John Wiegley (johnw AT gnu DOT org)
11 ;; Maintainer: Michael Olson (mwolson AT gnu DOT org)
12 ;; Description: An authoring and publishing tool for Emacs
13 ;; URL: http://www.mwolson.org/projects/MuseMode.html
14 ;; Compatibility: Emacs21 XEmacs21 Emacs22
16 ;; This file is not part of GNU Emacs.
18 ;; This is free software; you can redistribute it and/or modify it under
19 ;; the terms of the GNU General Public License as published by the Free
20 ;; Software Foundation; either version 2, or (at your option) any later
23 ;; This is distributed in the hope that it will be useful, but WITHOUT
24 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
25 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
28 ;; You should have received a copy of the GNU General Public License
29 ;; along with GNU Emacs; see the file COPYING. If not, write to the
30 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
31 ;; Boston, MA 02110-1301, USA.
35 ;; Muse is a tool for easily authoring and publishing documents. It
36 ;; allows for rapid prototyping of hyperlinked text, which may then be
37 ;; exported to multiple output formats -- such as HTML, LaTeX,
40 ;; The markup rules used by Muse are intended to be very friendly to
41 ;; people familiar with Emacs. See the included manual for more
48 (defvar muse-version
"3.02.5"
49 "The version of Muse currently loaded")
51 (defun muse-version (&optional insert
)
52 "Display the version of Muse that is currently loaded.
53 If INSERT is non-nil, insert the text instead of displaying it."
57 (message muse-version
)))
60 "Options controlling the behavior of Muse.
61 The markup used by Muse is intended to be very friendly to people
65 (defvar muse-under-windows-p
(memq system-type
'(ms-dos windows-nt
)))
68 (require 'muse-regexps
)
70 ;; Default file extension
73 (defvar muse-ignored-extensions
))
75 (defvar muse-ignored-extensions-regexp nil
76 "A regexp of extensions to omit from the ending of a Muse page name.
77 This is autogenerated from `muse-ignored-extensions'.")
79 (defun muse-update-file-extension (sym val
)
80 "Update the value of `muse-file-extension'."
81 (when (and (boundp sym
) (symbol-value sym
))
82 ;; remove old auto-mode-alist association
84 (delete (cons (concat "\\." (symbol-value sym
) "\\'")
85 'muse-mode-choose-mode
)
88 ;; associate .muse with muse-mode
90 (add-to-list 'auto-mode-alist
91 (cons (concat "\\." val
"\\'")
92 'muse-mode-choose-mode
)))
93 (when (fboundp 'muse-update-ignored-extensions-regexp
)
94 (muse-update-ignored-extensions-regexp
95 'muse-ignored-extensions muse-ignored-extensions
)))
97 (defcustom muse-file-extension
"muse"
98 "File extension of Muse files. Omit the period at the beginning."
100 (const :tag
"None" nil
)
102 :set
'muse-update-file-extension
105 (defun muse-update-ignored-extensions-regexp (sym val
)
106 "Update the value of `muse-ignored-extensions-regexp'."
109 (setq muse-ignored-extensions-regexp
111 (regexp-quote (or muse-file-extension
"")) "\\|"
112 (mapconcat 'identity val
"\\|")
114 (setq muse-ignored-extensions-regexp
115 (if muse-file-extension
116 (concat "\\.\\(" muse-file-extension
"\\)\\'")
119 (defcustom muse-ignored-extensions
'("bz2" "gz" "[Zz]")
120 "A list of extensions to omit from the ending of a Muse page name.
123 Don't put a period at the beginning of each extension unless you
124 understand that it is part of a regexp."
125 :type
'(repeat (regexp :tag
"Extension"))
126 :set
'muse-update-ignored-extensions-regexp
131 (require 'muse-protocols
)
133 ;;; Return an list of known wiki names and the files they represent.
135 (defsubst muse-delete-file-if-exists
(file)
136 (when (file-exists-p file
)
138 (message "Removed %s" file
)))
140 (defsubst muse-time-less-p
(t1 t2
)
141 "Say whether time T1 is less than time T2."
142 (or (< (car t1
) (car t2
))
143 (and (= (car t1
) (car t2
))
144 (< (nth 1 t1
) (nth 1 t2
)))))
147 (defvar muse-publishing-current-file nil
))
149 (defun muse-current-file ()
150 "Return the name of the currently visited or published file."
151 (or (and (boundp 'muse-publishing-current-file
)
152 muse-publishing-current-file
)
154 (concat default-directory
(buffer-name))))
156 (defun muse-page-name (&optional name
)
157 "Return the canonical form of a Muse page name.
158 All this means is that certain extensions, like .gz, are removed."
160 (unless (and name
(not (string= name
"")))
161 (setq name
(muse-current-file)))
163 (let ((page (file-name-nondirectory name
)))
164 (if (and muse-ignored-extensions-regexp
165 (string-match muse-ignored-extensions-regexp page
))
166 (replace-match "" t t page
)
169 (defun muse-eval-lisp (form)
170 "Evaluate the given form and return the result as a string."
174 (let ((object (eval (read form
))))
176 ((stringp object
) object
)
178 (not (eq object nil
)))
179 (let ((string (pp-to-string object
)))
180 (substring string
0 (1- (length string
)))))
182 (number-to-string object
))
185 (pp-to-string object
))))
187 (if (fboundp 'display-warning
)
188 (display-warning 'muse
189 (format "%s: Error evaluating %s: %s"
190 (muse-page-name) form err
)
191 (if (featurep 'xemacs
)
194 (message "%s: Error evaluating %s: %s"
195 (muse-page-name) form err
))
196 "<!--INVALID LISP CODE-->"))))
198 (defmacro muse-with-temp-buffer
(&rest body
)
199 "Create a temporary buffer, and evaluate BODY there like `progn'.
200 See also `with-temp-file' and `with-output-to-string'.
201 Unlike `with-temp-buffer', this will never attempt to save the temp buffer."
202 (let ((temp-buffer (make-symbol "temp-buffer")))
203 `(let ((,temp-buffer
(generate-new-buffer " *muse-temp*")))
206 (with-current-buffer ,temp-buffer
209 (with-current-buffer ,temp-buffer
212 (if (and (boundp 'muse-batch-publishing-p
)
213 muse-batch-publishing-p
)
215 (message "%s: Error occured: %s"
216 (muse-page-name) err
)
218 (if (fboundp 'display-warning
)
219 (display-warning 'muse
220 (format "%s: Error occurred: %s\n\n%s"
223 (if (featurep 'xemacs
)
226 (message "%s: Error occured: %s\n\n%s"
227 (muse-page-name) err
(pp (quote ,body
))))))))
228 (when (buffer-live-p ,temp-buffer
)
229 (with-current-buffer ,temp-buffer
230 (set-buffer-modified-p nil
))
231 (unless debug-on-error
(kill-buffer ,temp-buffer
)))))))
232 (put 'muse-with-temp-buffer
'lisp-indent-function
0)
233 (put 'muse-with-temp-buffer
'edebug-form-spec
'(body))
235 ;; The following code was extracted from cl
237 (defun muse-const-expr-p (x)
239 (or (eq (car x
) 'quote
)
240 (and (memq (car x
) '(function function
*))
241 (or (symbolp (nth 1 x
))
242 (and (eq (and (consp (nth 1 x
))
243 (car (nth 1 x
))) 'lambda
) 'func
)))))
244 ((symbolp x
) (and (memq x
'(nil t
)) t
))
247 (put 'muse-assertion-failed
'error-conditions
'(error))
248 (put 'muse-assertion-failed
'error-message
"Assertion failed")
250 (defun muse-list* (arg &rest rest
)
251 "Return a new list with specified args as elements, cons'd to last arg.
252 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
253 `(cons A (cons B (cons C D)))'."
254 (cond ((not rest
) arg
)
255 ((not (cdr rest
)) (cons arg
(car rest
)))
256 (t (let* ((n (length rest
))
257 (copy (copy-sequence rest
))
258 (last (nthcdr (- n
2) copy
)))
259 (setcdr last
(car (cdr last
)))
262 (defmacro muse-assert
(form &optional show-args string
&rest args
)
263 "Verify that FORM returns non-nil; signal an error if not.
264 Second arg SHOW-ARGS means to include arguments of FORM in message.
265 Other args STRING and ARGS... are arguments to be passed to `error'.
266 They are not evaluated unless the assertion fails. If STRING is
267 omitted, a default message listing FORM itself is used."
273 (and (not (muse-const-expr-p x
)) x
)))
278 (muse-list* 'error string
(append sargs args
))
279 (list 'signal
'(quote muse-assertion-failed
)
280 (muse-list* 'list
(list 'quote form
) sargs
))))
283 ;; Compatibility functions
285 (defun muse-looking-back (regexp &optional limit
)
286 (if (fboundp 'looking-back
)
287 (looking-back regexp limit
)
289 (re-search-backward (concat "\\(?:" regexp
"\\)\\=") limit t
))))
291 (defun muse-line-end-position (&optional n
)
292 (if (fboundp 'line-end-position
)
293 (line-end-position n
)
294 (save-excursion (end-of-line n
) (point))))
296 (defun muse-line-beginning-position (&optional n
)
297 (if (fboundp 'line-beginning-position
)
298 (line-beginning-position n
)
299 (save-excursion (beginning-of-line n
) (point))))
301 (defun muse-match-string-no-properties (num &optional string
)
302 (if (fboundp 'match-string-no-properties
)
303 (match-string-no-properties num string
)
304 (match-string num string
)))
306 (defun muse-replace-regexp-in-string (regexp replacement text
&optional fixedcase literal
)
307 "Replace REGEXP with REPLACEMENT in TEXT.
308 If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
309 If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
311 ((fboundp 'replace-regexp-in-string
)
312 (replace-regexp-in-string regexp replacement text fixedcase literal
))
313 ((fboundp 'replace-in-string
)
314 (replace-in-string text regexp replacement literal
))
315 (t (while (string-match regexp text
)
316 (setq text
(replace-match replacement fixedcase literal text
)))
319 (defun muse-add-to-invisibility-spec (element)
320 "Add ELEMENT to `buffer-invisibility-spec'.
321 See documentation for `buffer-invisibility-spec' for the kind of elements
323 (if (fboundp 'add-to-invisibility-spec
)
324 (add-to-invisibility-spec element
)
325 (if (eq buffer-invisibility-spec t
)
326 (setq buffer-invisibility-spec
(list t
)))
327 (setq buffer-invisibility-spec
328 (cons element buffer-invisibility-spec
))))
330 (defun muse-read-directory-name (prompt &optional dir default-dirname mustmatch initial
)
331 "Read directory name - see `read-file-name' for details."
332 (if (fboundp 'read-directory-name
)
333 (read-directory-name prompt dir default-dirname mustmatch initial
)
335 (setq dir default-directory
))
336 (read-file-name prompt dir
(or default-dirname
337 (if initial
(expand-file-name initial dir
)
341 ;; Widget compatibility functions
343 (defun muse-widget-type-value-create (widget)
344 "Convert and instantiate the value of the :type attribute of WIDGET.
345 Store the newly created widget in the :children attribute.
347 The value of the :type attribute should be an unconverted widget type."
348 (let ((value (widget-get widget
:value
))
349 (type (widget-get widget
:type
)))
350 (widget-put widget
:children
351 (list (widget-create-child-value widget
352 (widget-convert type
)
355 (defun muse-widget-child-value-get (widget)
356 "Get the value of the first member of :children in WIDGET."
357 (widget-value (car (widget-get widget
:children
))))
359 (defun muse-widget-type-match (widget value
)
360 "Non-nil if the :type value of WIDGET matches VALUE.
362 The value of the :type attribute should be an unconverted widget type."
363 (widget-apply (widget-convert (widget-get widget
:type
)) :match value
))
365 ;; Link-handling functions and variables
367 (defun muse-handle-url (&optional string
)
368 "If STRING or point has a URL, match and return it."
369 (if (if string
(string-match muse-url-regexp string
)
370 (looking-at muse-url-regexp
))
371 (match-string 0 string
)))
373 (defcustom muse-implicit-link-functions
'(muse-handle-url)
374 "A list of functions to handle an implicit link.
375 An implicit link is one that is not surrounded by brackets.
377 By default, Muse handles URLs only.
378 If you want to handle WikiWords, load muse-wiki.el."
380 :options
'(muse-handle-url)
383 (defun muse-handle-implicit-link (&optional link
)
384 "Handle implicit links. If LINK is not specified, look at point.
385 An implicit link is one that is not surrounded by brackets.
386 By default, Muse handles URLs only.
387 If you want to handle WikiWords, load muse-wiki.el.
389 This function modifies the match data so that match 1 is the
390 link. Match 2 will usually be nil, unless the description is
391 embedded in the text of the buffer.
393 The match data is restored after each unsuccessful handler
394 function call. If LINK is specified, only restore at very end.
396 This behavior is needed because the part of the buffer that
397 `muse-implicit-link-regexp' matches must be narrowed to the part
398 that is an accepted link."
399 (let ((funcs muse-implicit-link-functions
)
401 (data (match-data t
)))
403 (setq res
(funcall (car funcs
) link
))
406 (unless link
(set-match-data data
))
407 (setq funcs
(cdr funcs
))))
408 (when link
(set-match-data data
))
411 (defcustom muse-explicit-link-functions nil
412 "A list of functions to handle an explicit link.
413 An explicit link is one [[like][this]] or [[this]]."
417 (defun muse-handle-explicit-link (&optional link
)
418 "Handle explicit links. If LINK is not specified, look at point.
419 An explicit link is one that looks [[like][this]] or [[this]].
421 This function modifies the match data so that match 1 is the link
422 and match 2 is the description. Perhaps someday match 3 might be
423 the text to use for the alt element of an <a> or <img> tag.
425 The match data is saved. If no handlers are able to process
426 LINK, return LINK (if specified) or the 1st match string. If
427 LINK is not specified, it is assumed that Muse has matched
428 against `muse-explicit-link-regexp' before calling this
430 (let ((funcs muse-explicit-link-functions
)
434 (setq res
(funcall (car funcs
) link
))
437 (setq funcs
(cdr funcs
)))))
440 (or link
(match-string 1)))))
444 ;;; muse.el ends here