1 ;;; muse.el --- an authoring and publishing tool for Emacs
3 ;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
5 ;; Emacs Lisp Archive Entry
7 ;; Version: 3.02.90 (3.03 RC1)
8 ;; Date: Fri 7-Apr-2006
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/EmacsMuse.html
14 ;; Compatibility: Emacs21 XEmacs21 Emacs22
16 ;; This file is part of Emacs Muse. It is not part of GNU Emacs.
18 ;; Emacs Muse is free software; you can redistribute it and/or modify
19 ;; it under the terms of the GNU General Public License as published
20 ;; by the Free Software Foundation; either version 2, or (at your
21 ;; option) any later version.
23 ;; Emacs Muse is distributed in the hope that it will be useful, but
24 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
26 ;; General Public License for more details.
28 ;; You should have received a copy of the GNU General Public License
29 ;; along with Emacs Muse; 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.90"
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 (defvar muse-update-values-hook nil
71 "Hook for values that are automatically generated.
72 This is to be used by add-on modules for Muse.
73 It is run just before colorizing or publishing a buffer.")
75 ;; Default file extension
78 (defvar muse-ignored-extensions
))
80 (defvar muse-ignored-extensions-regexp nil
81 "A regexp of extensions to omit from the ending of a Muse page name.
82 This is autogenerated from `muse-ignored-extensions'.")
84 (defun muse-update-file-extension (sym val
)
85 "Update the value of `muse-file-extension'."
86 (when (and (featurep 'muse-mode
)
87 (boundp sym
) (stringp (symbol-value sym
))
88 (or (not (stringp val
))
89 (not (string= (symbol-value sym
) val
))))
90 ;; remove old auto-mode-alist association
92 (delete (cons (concat "\\." (symbol-value sym
) "\\'")
93 'muse-mode-choose-mode
)
96 ;; associate .muse with muse-mode
97 (when (and (featurep 'muse-mode
)
99 (or (not (stringp (symbol-value sym
)))
100 (not (string= (symbol-value sym
) val
))))
101 (add-to-list 'auto-mode-alist
102 (cons (concat "\\." val
"\\'")
103 'muse-mode-choose-mode
)))
104 ;; update the ignored extensions regexp
105 (when (and (fboundp 'muse-update-ignored-extensions-regexp
)
106 (or (not (stringp (symbol-value sym
)))
108 (not (string= (symbol-value sym
) val
))))
109 (muse-update-ignored-extensions-regexp
110 'muse-ignored-extensions muse-ignored-extensions
)))
112 (defcustom muse-file-extension
"muse"
113 "File extension of Muse files. Omit the period at the beginning.
114 If you don't want Muse files to have an extension, set this to nil."
116 (const :tag
"None" nil
)
118 :set
'muse-update-file-extension
121 (defun muse-update-ignored-extensions-regexp (sym val
)
122 "Update the value of `muse-ignored-extensions-regexp'."
125 (setq muse-ignored-extensions-regexp
127 (regexp-quote (or muse-file-extension
"")) "\\|"
128 (mapconcat 'identity val
"\\|")
130 (setq muse-ignored-extensions-regexp
131 (if muse-file-extension
132 (concat "\\.\\(" muse-file-extension
"\\)\\'")
135 (add-hook 'muse-update-values-hook
137 (muse-update-ignored-extensions-regexp
138 'muse-ignored-extensions muse-ignored-extensions
)))
140 (defcustom muse-ignored-extensions
'("bz2" "gz" "[Zz]")
141 "A list of extensions to omit from the ending of a Muse page name.
144 Don't put a period at the beginning of each extension unless you
145 understand that it is part of a regexp."
146 :type
'(repeat (regexp :tag
"Extension"))
147 :set
'muse-update-ignored-extensions-regexp
150 (add-to-list 'auto-mode-alist
151 (cons (concat "\\." muse-file-extension
"\\'")
152 'muse-mode-choose-mode
))
154 (defun muse-update-file-extension-after-init ()
155 ;; This is short, but it has to be a function, otherwise Emacs21
156 ;; does not load it properly when running after-init-hook
157 (muse-update-file-extension 'muse-file-extension muse-file-extension
))
159 ;; Once the user's init file has been processed, determine whether
160 ;; they want a file extension
161 (add-hook 'after-init-hook
'muse-update-file-extension-after-init
)
165 (require 'muse-protocols
)
167 ;;; Return an list of known wiki names and the files they represent.
169 (defsubst muse-delete-file-if-exists
(file)
170 (when (file-exists-p file
)
172 (message "Removed %s" file
)))
174 (defsubst muse-time-less-p
(t1 t2
)
175 "Say whether time T1 is less than time T2."
176 (or (< (car t1
) (car t2
))
177 (and (= (car t1
) (car t2
))
178 (< (nth 1 t1
) (nth 1 t2
)))))
181 (defvar muse-publishing-current-file nil
))
183 (defun muse-current-file ()
184 "Return the name of the currently visited or published file."
185 (or (and (boundp 'muse-publishing-current-file
)
186 muse-publishing-current-file
)
188 (concat default-directory
(buffer-name))))
190 (defun muse-page-name (&optional name
)
191 "Return the canonical form of a Muse page name.
192 All this means is that certain extensions, like .gz, are removed."
194 (unless (and name
(not (string= name
"")))
195 (setq name
(muse-current-file)))
197 (let ((page (file-name-nondirectory name
)))
198 (if (and muse-ignored-extensions-regexp
199 (string-match muse-ignored-extensions-regexp page
))
200 (replace-match "" t t page
)
203 (defun muse-display-warning (message)
204 "Display the given MESSAGE as a warning."
205 (if (fboundp 'display-warning
)
206 (display-warning 'muse message
207 (if (featurep 'xemacs
)
212 (defun muse-eval-lisp (form)
213 "Evaluate the given form and return the result as a string."
217 (let ((object (eval (read form
))))
219 ((stringp object
) object
)
221 (not (eq object nil
)))
222 (let ((string (pp-to-string object
)))
223 (substring string
0 (1- (length string
)))))
225 (number-to-string object
))
228 (pp-to-string object
))))
230 (muse-display-warning (format "%s: Error evaluating %s: %s"
231 (muse-page-name) form err
))
232 "; INVALID LISP CODE"))))
234 (defmacro muse-with-temp-buffer
(&rest body
)
235 "Create a temporary buffer, and evaluate BODY there like `progn'.
236 See also `with-temp-file' and `with-output-to-string'.
237 Unlike `with-temp-buffer', this will never attempt to save the temp buffer.
238 It is meant to be used along with `insert-file-contents'."
239 (let ((temp-buffer (make-symbol "temp-buffer")))
240 `(let ((,temp-buffer
(generate-new-buffer " *muse-temp*")))
243 (with-current-buffer ,temp-buffer
246 (with-current-buffer ,temp-buffer
249 (if (and (boundp 'muse-batch-publishing-p
)
250 muse-batch-publishing-p
)
252 (message "%s: Error occured: %s"
253 (muse-page-name) err
)
255 (muse-display-warning
256 (format (concat "An error occurred while publishing"
257 " %s: %s\n\nSet debug-on-error to"
258 " `t' if you would like a backtrace.")
259 (muse-page-name) err
))))))
260 (when (buffer-live-p ,temp-buffer
)
261 (with-current-buffer ,temp-buffer
262 (set-buffer-modified-p nil
))
263 (unless debug-on-error
(kill-buffer ,temp-buffer
)))))))
265 (put 'muse-with-temp-buffer
'lisp-indent-function
0)
266 (put 'muse-with-temp-buffer
'edebug-form-spec
'(body))
268 ;; The following code was extracted from cl
270 (defun muse-const-expr-p (x)
272 (or (eq (car x
) 'quote
)
273 (and (memq (car x
) '(function function
*))
274 (or (symbolp (nth 1 x
))
275 (and (eq (and (consp (nth 1 x
))
276 (car (nth 1 x
))) 'lambda
) 'func
)))))
277 ((symbolp x
) (and (memq x
'(nil t
)) t
))
280 (put 'muse-assertion-failed
'error-conditions
'(error))
281 (put 'muse-assertion-failed
'error-message
"Assertion failed")
283 (defun muse-list* (arg &rest rest
)
284 "Return a new list with specified args as elements, cons'd to last arg.
285 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
286 `(cons A (cons B (cons C D)))'."
287 (cond ((not rest
) arg
)
288 ((not (cdr rest
)) (cons arg
(car rest
)))
289 (t (let* ((n (length rest
))
290 (copy (copy-sequence rest
))
291 (last (nthcdr (- n
2) copy
)))
292 (setcdr last
(car (cdr last
)))
295 (defmacro muse-assert
(form &optional show-args string
&rest args
)
296 "Verify that FORM returns non-nil; signal an error if not.
297 Second arg SHOW-ARGS means to include arguments of FORM in message.
298 Other args STRING and ARGS... are arguments to be passed to `error'.
299 They are not evaluated unless the assertion fails. If STRING is
300 omitted, a default message listing FORM itself is used."
306 (and (not (muse-const-expr-p x
)) x
)))
311 (muse-list* 'error string
(append sargs args
))
312 (list 'signal
'(quote muse-assertion-failed
)
313 (muse-list* 'list
(list 'quote form
) sargs
))))
316 ;; Compatibility functions
318 (defun muse-looking-back (regexp &optional limit
)
319 (if (fboundp 'looking-back
)
320 (looking-back regexp limit
)
322 (re-search-backward (concat "\\(?:" regexp
"\\)\\=") limit t
))))
324 (defun muse-line-end-position (&optional n
)
325 (if (fboundp 'line-end-position
)
326 (line-end-position n
)
327 (save-excursion (end-of-line n
) (point))))
329 (defun muse-line-beginning-position (&optional n
)
330 (if (fboundp 'line-beginning-position
)
331 (line-beginning-position n
)
332 (save-excursion (beginning-of-line n
) (point))))
334 (defun muse-match-string-no-properties (num &optional string
)
335 (if (fboundp 'match-string-no-properties
)
336 (match-string-no-properties num string
)
337 (match-string num string
)))
339 (defun muse-replace-regexp-in-string (regexp replacement text
&optional fixedcase literal
)
340 "Replace REGEXP with REPLACEMENT in TEXT.
341 If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
342 If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
344 ((fboundp 'replace-in-string
)
345 (replace-in-string text regexp replacement literal
))
346 ((fboundp 'replace-regexp-in-string
)
347 (replace-regexp-in-string regexp replacement text fixedcase literal
))
348 (t (let ((repl-len (length replacement
))
350 (while (setq start
(string-match regexp text start
))
351 (setq start
(+ start repl-len
)
352 text
(replace-match replacement fixedcase literal text
))))
355 (defun muse-add-to-invisibility-spec (element)
356 "Add ELEMENT to `buffer-invisibility-spec'.
357 See documentation for `buffer-invisibility-spec' for the kind of elements
359 (if (fboundp 'add-to-invisibility-spec
)
360 (add-to-invisibility-spec element
)
361 (if (eq buffer-invisibility-spec t
)
362 (setq buffer-invisibility-spec
(list t
)))
363 (setq buffer-invisibility-spec
364 (cons element buffer-invisibility-spec
))))
366 (defun muse-read-directory-name (prompt &optional dir default-dirname mustmatch initial
)
367 "Read directory name - see `read-file-name' for details."
368 (if (fboundp 'read-directory-name
)
369 (read-directory-name prompt dir default-dirname mustmatch initial
)
371 (setq dir default-directory
))
372 (read-file-name prompt dir
(or default-dirname
373 (if initial
(expand-file-name initial dir
)
377 ;; Set face globally in a predictable fashion
378 (defun muse-copy-face (old new
)
379 "Copy face OLD to NEW."
380 (if (featurep 'xemacs
)
381 (copy-face old new
'all
)
382 (copy-face old new
)))
384 ;; Widget compatibility functions
386 (defun muse-widget-type-value-create (widget)
387 "Convert and instantiate the value of the :type attribute of WIDGET.
388 Store the newly created widget in the :children attribute.
390 The value of the :type attribute should be an unconverted widget type."
391 (let ((value (widget-get widget
:value
))
392 (type (widget-get widget
:type
)))
393 (widget-put widget
:children
394 (list (widget-create-child-value widget
395 (widget-convert type
)
398 (defun muse-widget-child-value-get (widget)
399 "Get the value of the first member of :children in WIDGET."
400 (widget-value (car (widget-get widget
:children
))))
402 (defun muse-widget-type-match (widget value
)
403 "Non-nil if the :type value of WIDGET matches VALUE.
405 The value of the :type attribute should be an unconverted widget type."
406 (widget-apply (widget-convert (widget-get widget
:type
)) :match value
))
408 ;; Link-handling functions and variables
410 (defun muse-get-link (&optional target
)
411 "Based on the match data, retrieve the link.
412 Use TARGET to get the string, if it is specified."
413 (muse-match-string-no-properties 1 target
))
415 (defun muse-get-link-desc (&optional target
)
416 "Based on the match data, retrieve the link description.
417 Use TARGET to get the string, if it is specified."
418 (muse-match-string-no-properties 2 target
))
420 (defun muse-link-escape (text)
421 "Escape characters in TEXT that conflict with the explicit link
425 (muse-replace-regexp-in-string "\\[" "%5B" text t t
)
426 (muse-replace-regexp-in-string "\\]" "%5D" text t t
)
430 (defun muse-link-unescape (text)
431 "Un-escape characters in TEXT that conflict with the explicit
435 (muse-replace-regexp-in-string "%5B" "[" text t t
)
436 (muse-replace-regexp-in-string "%5D" "]" text t t
)
440 (defun muse-handle-url (&optional string
)
441 "If STRING or point has a URL, match and return it."
442 (if (if string
(string-match muse-url-regexp string
)
443 (looking-at muse-url-regexp
))
444 (match-string 0 string
)))
446 (defcustom muse-implicit-link-functions
'(muse-handle-url)
447 "A list of functions to handle an implicit link.
448 An implicit link is one that is not surrounded by brackets.
450 By default, Muse handles URLs only.
451 If you want to handle WikiWords, load muse-wiki.el."
453 :options
'(muse-handle-url)
456 (defun muse-handle-implicit-link (&optional link
)
457 "Handle implicit links. If LINK is not specified, look at point.
458 An implicit link is one that is not surrounded by brackets.
459 By default, Muse handles URLs only.
460 If you want to handle WikiWords, load muse-wiki.el.
462 This function modifies the match data so that match 1 is the
463 link. Match 2 will usually be nil, unless the description is
464 embedded in the text of the buffer.
466 The match data is restored after each unsuccessful handler
467 function call. If LINK is specified, only restore at very end.
469 This behavior is needed because the part of the buffer that
470 `muse-implicit-link-regexp' matches must be narrowed to the part
471 that is an accepted link."
472 (let ((funcs muse-implicit-link-functions
)
474 (data (match-data t
)))
476 (setq res
(funcall (car funcs
) link
))
479 (unless link
(set-match-data data
))
480 (setq funcs
(cdr funcs
))))
481 (when link
(set-match-data data
))
484 (defcustom muse-explicit-link-functions nil
485 "A list of functions to handle an explicit link.
486 An explicit link is one [[like][this]] or [[this]]."
490 (defun muse-handle-explicit-link (&optional link
)
491 "Handle explicit links. If LINK is not specified, look at point.
492 An explicit link is one that looks [[like][this]] or [[this]].
494 This function modifies the match data so that match 1 is the link
495 and match 2 is the description. Perhaps someday match 3 might be
496 the text to use for the alt element of an <a> or <img> tag.
498 The match data is saved. If no handlers are able to process
499 LINK, return LINK (if specified) or the 1st match string. If
500 LINK is not specified, it is assumed that Muse has matched
501 against `muse-explicit-link-regexp' before calling this
503 (let ((funcs muse-explicit-link-functions
)
507 (setq res
(funcall (car funcs
) link
))
510 (setq funcs
(cdr funcs
)))))
514 (or link
(muse-get-link))))))
516 ;; Movement functions
518 (defun muse-list-item-type (str)
519 "Determine the type of list given STR.
520 Returns either 'ul, 'ol, 'dl-term, or 'dl-entry."
521 (cond ((or (string= str
"")
524 ((and (= (aref str
0) ?\
)
528 (string-match (concat "\\`[" muse-regexp-blank
"][0-9]+\\.") str
))
531 (not (string-match (concat "\\`[" muse-regexp-blank
"]*::") str
)))
532 ;; if str is not any kind of list, it will be interpreted as
537 (defun muse-list-item-critical-point (&optional offset
)
538 "Figure out where the important markup character for the
539 currently-matched list item is.
541 If OFFSET is specified, it is the number of groupings outside of
542 the contents of `muse-list-item-regexp'."
543 (unless offset
(setq offset
0))
544 (if (match-end (+ offset
2))
545 ;; at a definition list
546 (match-end (+ offset
2))
547 ;; at a different kind of list
548 (match-beginning (+ offset
1))))
550 (defun muse-forward-paragraph (&optional pattern
)
551 "Move forward safely by one paragraph, or according to PATTERN."
552 (when (get-text-property (point) 'end-list
)
553 (goto-char (next-single-property-change (point) 'end-list
)))
554 (setq pattern
(if pattern
555 (concat "^\\(?:" pattern
"\\|\n\\|\\'\\)")
556 "^\\s-*\\(\n\\|\\'\\)"))
557 (let ((next-list-end (or (next-single-property-change (point) 'end-list
)
560 (if (re-search-forward pattern nil t
)
561 (goto-char (match-beginning 0))
562 (goto-char (point-max)))
563 (when (> (point) next-list-end
)
564 (goto-char next-list-end
))))
566 (defun muse-forward-list-item-1 (type empty-line indented-line
)
567 "Determine whether a nested list item is after point."
568 (if (match-beginning 1)
569 ;; if we are given a dl entry, skip past everything on the same
570 ;; level, except for other dl entries
571 (and (eq type
'dl-entry
)
572 (not (eq (char-after (match-beginning 2)) ?\
:)))
573 ;; blank line encountered with no list item on the same
578 (and (looking-at indented-line
)
579 (not (looking-at empty-line
))))
580 ;; found that this blank line is followed by some
581 ;; indentation, plus other text, so we'll keep
587 (defun muse-forward-list-item (type indent
&optional no-skip-nested
)
588 "Move forward to the next item of TYPE.
589 Return non-nil if successful, nil otherwise.
590 The beginning indentation is given by INDENT.
592 If NO-SKIP-NESTED is non-nil, do not skip past nested items.
593 Note that if you desire this behavior, you will also need to
594 provide a very liberal INDENT value, such as
595 \(concat \"[\" muse-regexp-blank \"]*\")."
596 (let* ((list-item (format muse-list-item-regexp indent
))
597 (empty-line (concat "^[" muse-regexp-blank
"]*\n"))
598 (indented-line (concat "^" indent
"[" muse-regexp-blank
"]"))
599 (list-pattern (concat "\\(?:" empty-line
"\\)?"
600 "\\(" list-item
"\\)")))
602 (muse-forward-paragraph list-pattern
)
603 ;; make sure we don't go past boundary
604 (and (not (or (get-text-property (point) 'end-list
)
605 (>= (point) (point-max))))
606 ;; move past markup that is part of another construct
607 (or (and (match-beginning 1)
608 (or (get-text-property
609 (muse-list-item-critical-point 1) 'muse-link
)
611 (muse-list-item-critical-point 1) 'face
)))
613 (and (not no-skip-nested
)
614 (muse-forward-list-item-1 type empty-line
616 (cond ((or (get-text-property (point) 'end-list
)
617 (>= (point) (point-max)))
618 ;; at a list boundary, so stop
620 ((and (match-string 2)
621 (eq type
(muse-list-item-type (match-string 2))))
622 ;; same type, so indicate that there are more items to be
624 (goto-char (match-beginning 1)))
626 (when (match-beginning 1)
627 (goto-char (match-beginning 1)))
628 ;; move to just before foreign list item markup
633 ;;; muse.el ends here