Merged from mwolson@gnu.org--2006 (patch 206)
[muse-el.git] / lisp / muse.el
blobb2ab0493398aa4c5221ea3e297556902948b9aa8
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
6 ;; Filename: muse.el
7 ;; Version: 3.02.92 (3.03 RC2)
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.
33 ;;; Commentary:
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,
38 ;; Texinfo, etc.
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
42 ;; information.
44 ;;; Contributors:
46 ;;; Code:
48 (defvar muse-version "3.02.92"
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."
54 (interactive "P")
55 (if insert
56 (insert muse-version)
57 (message muse-version)))
59 (defgroup muse nil
60 "Options controlling the behavior of Muse.
61 The markup used by Muse is intended to be very friendly to people
62 familiar with Emacs."
63 :group 'hypermedia)
65 (defvar muse-under-windows-p (memq system-type '(ms-dos windows-nt)))
67 (require 'wid-edit)
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
77 (eval-when-compile
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
91 (setq auto-mode-alist
92 (delete (cons (concat "\\." (symbol-value sym) "\\'")
93 'muse-mode-choose-mode)
94 auto-mode-alist)))
95 (set sym val)
96 ;; associate .muse with muse-mode
97 (when (and (featurep 'muse-mode)
98 (stringp val)
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)))
107 (not (stringp val))
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."
115 :type '(choice
116 (const :tag "None" nil)
117 (string))
118 :set 'muse-update-file-extension
119 :group 'muse)
121 (defun muse-update-ignored-extensions-regexp (sym val)
122 "Update the value of `muse-ignored-extensions-regexp'."
123 (set sym val)
124 (if val
125 (setq muse-ignored-extensions-regexp
126 (concat "\\.\\("
127 (regexp-quote (or muse-file-extension "")) "\\|"
128 (mapconcat 'identity val "\\|")
129 "\\)\\'"))
130 (setq muse-ignored-extensions-regexp
131 (if muse-file-extension
132 (concat "\\.\\(" muse-file-extension "\\)\\'")
133 nil))))
135 (add-hook 'muse-update-values-hook
136 (lambda ()
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.
142 These are regexps.
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
148 :group 'muse)
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)
163 ;; URL protocols
165 (require 'muse-protocols)
167 ;; Helper functions
169 (defsubst muse-delete-file-if-exists (file)
170 (when (file-exists-p file)
171 (delete-file 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)))))
180 (eval-when-compile
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)
187 (buffer-file-name)
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."
193 (save-match-data
194 (unless (and name (not (string= name "")))
195 (setq name (muse-current-file)))
196 (if name
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)
201 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)
208 'warning
209 :warning))
210 (let ((buf (get-buffer-create "*Muse warnings*")))
211 (with-current-buffer buf
212 (goto-char (point-max))
213 (insert "Warning (muse): " message)
214 (unless (bolp)
215 (newline)))
216 (display-buffer buf)
217 (sit-for 0))))
219 (defun muse-eval-lisp (form)
220 "Evaluate the given form and return the result as a string."
221 (require 'pp)
222 (save-match-data
223 (condition-case err
224 (let ((object (eval (read form))))
225 (cond
226 ((stringp object) object)
227 ((and (listp object)
228 (not (eq object nil)))
229 (let ((string (pp-to-string object)))
230 (substring string 0 (1- (length string)))))
231 ((numberp object)
232 (number-to-string object))
233 ((eq object nil) "")
235 (pp-to-string object))))
236 (error
237 (muse-display-warning (format "%s: Error evaluating %s: %s"
238 (muse-page-name) form err))
239 "; INVALID LISP CODE"))))
241 (defmacro muse-with-temp-buffer (&rest body)
242 "Create a temporary buffer, and evaluate BODY there like `progn'.
243 See also `with-temp-file' and `with-output-to-string'.
245 Unlike `with-temp-buffer', this will never attempt to save the temp buffer.
246 It is meant to be used along with `insert-file-contents'."
247 (let ((temp-buffer (make-symbol "temp-buffer")))
248 `(let ((,temp-buffer (generate-new-buffer " *muse-temp*")))
249 (unwind-protect
250 (if debug-on-error
251 (with-current-buffer ,temp-buffer
252 ,@body)
253 (condition-case err
254 (with-current-buffer ,temp-buffer
255 ,@body)
256 (error
257 (if (and (boundp 'muse-batch-publishing-p)
258 muse-batch-publishing-p)
259 (progn
260 (message "%s: Error occured: %s"
261 (muse-page-name) err)
262 (backtrace))
263 (muse-display-warning
264 (format (concat "An error occurred while publishing"
265 " %s: %s\n\nSet debug-on-error to"
266 " `t' if you would like a backtrace.")
267 (muse-page-name) err))))))
268 (when (buffer-live-p ,temp-buffer)
269 (with-current-buffer ,temp-buffer
270 (set-buffer-modified-p nil))
271 (unless debug-on-error (kill-buffer ,temp-buffer)))))))
273 (put 'muse-with-temp-buffer 'lisp-indent-function 0)
274 (put 'muse-with-temp-buffer 'edebug-form-spec '(body))
276 (defun muse-collect-alist (list element &optional test)
277 "Collect items from LIST whose car is equal to ELEMENT.
278 If TEST is specified, use it to compare ELEMENT."
279 (unless test (setq test 'equal))
280 (let ((items nil))
281 (dolist (item list)
282 (when (funcall test element (car item))
283 (setq items (cons item items))))
284 items))
286 (defmacro muse-sort-with-closure (list predicate closure)
287 "Sort LIST, stably, comparing elements using PREDICATE.
288 Returns the sorted list. LIST is modified by side effects.
289 PREDICATE is called with two elements of list and CLOSURE.
290 PREDICATE should return non-nil if the first element should sort
291 before the second."
292 `(sort ,list (lambda (a b) (funcall ,predicate a b ,closure))))
294 (put 'muse-sort-with-closure 'lisp-indent-function 0)
295 (put 'muse-sort-with-closure 'edebug-form-spec '(form function-form form))
297 (defun muse-sort-by-rating (rated-list &optional test)
298 "Sort RATED-LIST according to the rating of each element.
299 The rating is stripped out in the returned list.
300 Default sorting is highest-first.
302 If TEST if specified, use it to sort the list."
303 (unless test (setq test '>))
304 (mapcar (function cdr)
305 (muse-sort-with-closure
306 rated-list
307 (lambda (a b closure)
308 (let ((na (numberp (car a)))
309 (nb (numberp (car b))))
310 (cond ((and na nb) (funcall closure (car a) (car b)))
311 (na (not nb))
312 (t nil))))
313 test)))
315 (defun muse-escape-specials-in-string (specials string &optional reverse)
316 "Apply the transformations in SPECIALS to STRING.
318 The transforms should form a fully reversible and non-ambiguous
319 syntax when STRING is parsed from left to right.
321 If REVERSE is specified, reverse an already-escaped string."
322 (let ((rules (mapcar (lambda (rule)
323 (cons (regexp-quote (if reverse
324 (cdr rule)
325 (car rule)))
326 (if reverse (car rule) (cdr rule))))
327 specials)))
328 (with-temp-buffer
329 (insert string)
330 (goto-char (point-min))
331 (save-match-data
332 (while (not (eobp))
333 (unless (catch 'found
334 (dolist (rule rules)
335 (when (looking-at (car rule))
336 (replace-match (cdr rule) t t)
337 (throw 'found t))))
338 (forward-char))))
339 (buffer-string))))
341 (defun muse-trim-whitespace (string)
342 "Return a version of STRING with no initial nor trailing whitespace."
343 (muse-replace-regexp-in-string
344 (concat "\\`[" muse-regexp-blank "]+\\|[" muse-regexp-blank "]+\\'")
345 "" string))
347 (defun muse-path-sans-extension (path)
348 "Return PATH sans final \"extension\".
350 The extension, in a file name, is the part that follows the last `.',
351 except that a leading `.', if any, doesn't count.
353 This differs from `file-name-sans-extension' in that it will
354 never modify the directory part of the path."
355 (concat (file-name-directory path)
356 (file-name-nondirectory (file-name-sans-extension path))))
358 ;; The following code was extracted from cl
360 (defun muse-const-expr-p (x)
361 (cond ((consp x)
362 (or (eq (car x) 'quote)
363 (and (memq (car x) '(function function*))
364 (or (symbolp (nth 1 x))
365 (and (eq (and (consp (nth 1 x))
366 (car (nth 1 x))) 'lambda) 'func)))))
367 ((symbolp x) (and (memq x '(nil t)) t))
368 (t t)))
370 (put 'muse-assertion-failed 'error-conditions '(error))
371 (put 'muse-assertion-failed 'error-message "Assertion failed")
373 (defun muse-list* (arg &rest rest)
374 "Return a new list with specified args as elements, cons'd to last arg.
375 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
376 `(cons A (cons B (cons C D)))'."
377 (cond ((not rest) arg)
378 ((not (cdr rest)) (cons arg (car rest)))
379 (t (let* ((n (length rest))
380 (copy (copy-sequence rest))
381 (last (nthcdr (- n 2) copy)))
382 (setcdr last (car (cdr last)))
383 (cons arg copy)))))
385 (defmacro muse-assert (form &optional show-args string &rest args)
386 "Verify that FORM returns non-nil; signal an error if not.
387 Second arg SHOW-ARGS means to include arguments of FORM in message.
388 Other args STRING and ARGS... are arguments to be passed to `error'.
389 They are not evaluated unless the assertion fails. If STRING is
390 omitted, a default message listing FORM itself is used."
391 (let ((sargs
392 (and show-args
393 (delq nil (mapcar
394 (function
395 (lambda (x)
396 (and (not (muse-const-expr-p x)) x)))
397 (cdr form))))))
398 (list 'progn
399 (list 'or form
400 (if string
401 (muse-list* 'error string (append sargs args))
402 (list 'signal '(quote muse-assertion-failed)
403 (muse-list* 'list (list 'quote form) sargs))))
404 nil)))
406 ;; Compatibility functions
408 (if (fboundp 'looking-back)
409 (defalias 'muse-looking-back 'looking-back)
410 (defun muse-looking-back (regexp &optional limit &rest ignored)
411 (save-excursion
412 (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
414 (if (fboundp 'line-end-position)
415 (defalias 'muse-line-end-position 'line-end-position)
416 (defun muse-line-end-position (&optional n)
417 (save-excursion (end-of-line n) (point))))
419 (if (fboundp 'line-beginning-position)
420 (defalias 'muse-line-beginning-position 'line-beginning-position)
421 (defun muse-line-beginning-position (&optional n)
422 (save-excursion (beginning-of-line n) (point))))
424 (eval-and-compile
425 (if (fboundp 'match-string-no-properties)
426 (defalias 'muse-match-string-no-properties 'match-string-no-properties)
427 (defun muse-match-string-no-properties (num &optional string)
428 (match-string num string))))
430 (defun muse-replace-regexp-in-string (regexp replacement text &optional fixedcase literal)
431 "Replace REGEXP with REPLACEMENT in TEXT.
433 Return a new string containing the replacements.
435 If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
436 If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
437 (cond
438 ((fboundp 'replace-in-string)
439 (replace-in-string text regexp replacement literal))
440 ((fboundp 'replace-regexp-in-string)
441 (replace-regexp-in-string regexp replacement text fixedcase literal))
442 (t (let ((repl-len (length replacement))
443 start)
444 (save-match-data
445 (while (setq start (string-match regexp text start))
446 (setq start (+ start repl-len)
447 text (replace-match replacement fixedcase literal text)))))
448 text)))
450 (if (fboundp 'add-to-invisibility-spec)
451 (defalias 'muse-add-to-invisibility-spec 'add-to-invisibility-spec)
452 (defun muse-add-to-invisibility-spec (element)
453 "Add ELEMENT to `buffer-invisibility-spec'.
454 See documentation for `buffer-invisibility-spec' for the kind of elements
455 that can be added."
456 (if (eq buffer-invisibility-spec t)
457 (setq buffer-invisibility-spec (list t)))
458 (setq buffer-invisibility-spec
459 (cons element buffer-invisibility-spec))))
461 (if (fboundp 'read-directory-name)
462 (defalias 'muse-read-directory-name 'read-directory-name)
463 (defun muse-read-directory-name (prompt &optional dir default-dirname mustmatch initial)
464 "Read directory name - see `read-file-name' for details."
465 (unless dir
466 (setq dir default-directory))
467 (read-file-name prompt dir (or default-dirname
468 (if initial (expand-file-name initial dir)
469 dir))
470 mustmatch initial)))
472 (defun muse-file-remote-p (file)
473 "Test whether FILE specifies a location on a remote system.
474 Return non-nil if the location is indeed remote.
476 For example, the filename \"/user@host:/foo\" specifies a location
477 on the system \"/user@host:\"."
478 (cond ((fboundp 'file-remote-p)
479 (file-remote-p file))
480 ((fboundp 'tramp-handle-file-remote-p)
481 (tramp-handle-file-remote-p file))
482 ((and (boundp 'ange-ftp-name-format)
483 (string-match ange-ftp-name-format file))
485 (t nil)))
487 ;; Set face globally in a predictable fashion
488 (defun muse-copy-face (old new)
489 "Copy face OLD to NEW."
490 (if (featurep 'xemacs)
491 (copy-face old new 'all)
492 (copy-face old new)))
494 ;; Widget compatibility functions
496 (defun muse-widget-type-value-create (widget)
497 "Convert and instantiate the value of the :type attribute of WIDGET.
498 Store the newly created widget in the :children attribute.
500 The value of the :type attribute should be an unconverted widget type."
501 (let ((value (widget-get widget :value))
502 (type (widget-get widget :type)))
503 (widget-put widget :children
504 (list (widget-create-child-value widget
505 (widget-convert type)
506 value)))))
508 (defun muse-widget-child-value-get (widget)
509 "Get the value of the first member of :children in WIDGET."
510 (widget-value (car (widget-get widget :children))))
512 (defun muse-widget-type-match (widget value)
513 "Non-nil if the :type value of WIDGET matches VALUE.
515 The value of the :type attribute should be an unconverted widget type."
516 (widget-apply (widget-convert (widget-get widget :type)) :match value))
518 ;; Link-handling functions and variables
520 (defun muse-get-link (&optional target)
521 "Based on the match data, retrieve the link.
522 Use TARGET to get the string, if it is specified."
523 (muse-match-string-no-properties 1 target))
525 (defun muse-get-link-desc (&optional target)
526 "Based on the match data, retrieve the link description.
527 Use TARGET to get the string, if it is specified."
528 (muse-match-string-no-properties 2 target))
530 (defvar muse-link-specials
531 '(("[" . "%5B")
532 ("]" . "%5D")
533 ("%" . "%%"))
534 "Syntax used for escaping and unescaping links.
535 This allows brackets to occur in explicit links as long as you
536 use the standard Muse functions to create them.")
538 (defun muse-link-escape (text)
539 "Escape characters in TEXT that conflict with the explicit link
540 regexp."
541 (when (stringp text)
542 (muse-escape-specials-in-string muse-link-specials text)))
544 (defun muse-link-unescape (text)
545 "Un-escape characters in TEXT that conflict with the explicit
546 link regexp."
547 (when (stringp text)
548 (muse-escape-specials-in-string muse-link-specials text t)))
550 (defun muse-handle-url (&optional string)
551 "If STRING or point has a URL, match and return it."
552 (if (if string (string-match muse-url-regexp string)
553 (looking-at muse-url-regexp))
554 (match-string 0 string)))
556 (defcustom muse-implicit-link-functions '(muse-handle-url)
557 "A list of functions to handle an implicit link.
558 An implicit link is one that is not surrounded by brackets.
560 By default, Muse handles URLs only.
561 If you want to handle WikiWords, load muse-wiki.el."
562 :type 'hook
563 :options '(muse-handle-url)
564 :group 'muse)
566 (defun muse-handle-implicit-link (&optional link)
567 "Handle implicit links. If LINK is not specified, look at point.
568 An implicit link is one that is not surrounded by brackets.
569 By default, Muse handles URLs only.
570 If you want to handle WikiWords, load muse-wiki.el.
572 This function modifies the match data so that match 1 is the
573 link. Match 2 will usually be nil, unless the description is
574 embedded in the text of the buffer.
576 The match data is restored after each unsuccessful handler
577 function call. If LINK is specified, only restore at very end.
579 This behavior is needed because the part of the buffer that
580 `muse-implicit-link-regexp' matches must be narrowed to the part
581 that is an accepted link."
582 (let ((funcs muse-implicit-link-functions)
583 (res nil)
584 (data (match-data t)))
585 (while funcs
586 (setq res (funcall (car funcs) link))
587 (if res
588 (setq funcs nil)
589 (unless link (set-match-data data))
590 (setq funcs (cdr funcs))))
591 (when link (set-match-data data))
592 res))
594 (defcustom muse-explicit-link-functions nil
595 "A list of functions to handle an explicit link.
596 An explicit link is one [[like][this]] or [[this]]."
597 :type 'hook
598 :group 'muse)
600 (defun muse-handle-explicit-link (&optional link)
601 "Handle explicit links. If LINK is not specified, look at point.
602 An explicit link is one that looks [[like][this]] or [[this]].
604 This function modifies the match data so that match 1 is the link
605 and match 2 is the description. Perhaps someday match 3 might be
606 the text to use for the alt element of an <a> or <img> tag.
608 The match data is saved. If no handlers are able to process
609 LINK, return LINK (if specified) or the 1st match string. If
610 LINK is not specified, it is assumed that Muse has matched
611 against `muse-explicit-link-regexp' before calling this
612 function."
613 (let ((funcs muse-explicit-link-functions)
614 (res nil))
615 (save-match-data
616 (while funcs
617 (setq res (funcall (car funcs) link))
618 (if res
619 (setq funcs nil)
620 (setq funcs (cdr funcs)))))
621 (muse-link-unescape
622 (if res
624 (or link (muse-get-link))))))
626 ;; Movement functions
628 (defun muse-list-item-type (str)
629 "Determine the type of list given STR.
630 Returns either 'ul, 'ol, 'dl-term, or 'dl-entry."
631 (cond ((or (string= str "")
632 (< (length str) 2))
633 nil)
634 ((and (= (aref str 0) ?\ )
635 (= (aref str 1) ?-))
636 'ul)
637 ((save-match-data
638 (string-match (concat "\\`[" muse-regexp-blank "][0-9]+\\.") str))
639 'ol)
640 ((save-match-data
641 (not (string-match (concat "\\`[" muse-regexp-blank "]*::") str)))
642 ;; if str is not any kind of list, it will be interpreted as
643 ;; a dl-term
644 'dl-term)
645 (t 'dl-entry)))
647 (defun muse-list-item-critical-point (&optional offset)
648 "Figure out where the important markup character for the
649 currently-matched list item is.
651 If OFFSET is specified, it is the number of groupings outside of
652 the contents of `muse-list-item-regexp'."
653 (unless offset (setq offset 0))
654 (if (match-end (+ offset 2))
655 ;; at a definition list
656 (match-end (+ offset 2))
657 ;; at a different kind of list
658 (match-beginning (+ offset 1))))
660 (defun muse-forward-paragraph (&optional pattern)
661 "Move forward safely by one paragraph, or according to PATTERN."
662 (when (get-text-property (point) 'end-list)
663 (goto-char (next-single-property-change (point) 'end-list)))
664 (setq pattern (if pattern
665 (concat "^\\(?:" pattern "\\|\n\\|\\'\\)")
666 "^\\s-*\\(\n\\|\\'\\)"))
667 (let ((next-list-end (or (next-single-property-change (point) 'end-list)
668 (point-max))))
669 (forward-line 1)
670 (if (re-search-forward pattern nil t)
671 (goto-char (match-beginning 0))
672 (goto-char (point-max)))
673 (when (> (point) next-list-end)
674 (goto-char next-list-end))))
676 (defun muse-forward-list-item-1 (type empty-line indented-line)
677 "Determine whether a nested list item is after point."
678 (if (match-beginning 1)
679 ;; if we are given a dl entry, skip past everything on the same
680 ;; level, except for other dl entries
681 (and (eq type 'dl-entry)
682 (not (eq (char-after (match-beginning 2)) ?\:)))
683 ;; blank line encountered with no list item on the same
684 ;; level after it
685 (let ((beg (point)))
686 (forward-line 1)
687 (if (save-match-data
688 (and (looking-at indented-line)
689 (not (looking-at empty-line))))
690 ;; found that this blank line is followed by some
691 ;; indentation, plus other text, so we'll keep
692 ;; going
694 (goto-char beg)
695 nil))))
697 (defun muse-forward-list-item (type indent &optional no-skip-nested)
698 "Move forward to the next item of TYPE.
699 Return non-nil if successful, nil otherwise.
700 The beginning indentation is given by INDENT.
702 If NO-SKIP-NESTED is non-nil, do not skip past nested items.
703 Note that if you desire this behavior, you will also need to
704 provide a very liberal INDENT value, such as
705 \(concat \"[\" muse-regexp-blank \"]*\")."
706 (let* ((list-item (format muse-list-item-regexp indent))
707 (empty-line (concat "^[" muse-regexp-blank "]*\n"))
708 (indented-line (concat "^" indent "[" muse-regexp-blank "]"))
709 (list-pattern (concat "\\(?:" empty-line "\\)?"
710 "\\(" list-item "\\)")))
711 (while (progn
712 (muse-forward-paragraph list-pattern)
713 ;; make sure we don't go past boundary
714 (and (not (or (get-text-property (point) 'end-list)
715 (>= (point) (point-max))))
716 ;; move past markup that is part of another construct
717 (or (and (match-beginning 1)
718 (or (get-text-property
719 (muse-list-item-critical-point 1) 'muse-link)
720 (get-text-property
721 (muse-list-item-critical-point 1) 'face)))
722 ;; skip nested items
723 (and (not no-skip-nested)
724 (muse-forward-list-item-1 type empty-line
725 indented-line))))))
726 (cond ((or (get-text-property (point) 'end-list)
727 (>= (point) (point-max)))
728 ;; at a list boundary, so stop
729 nil)
730 ((and (match-string 2)
731 (eq type (muse-list-item-type (match-string 2))))
732 ;; same type, so indicate that there are more items to be
733 ;; parsed
734 (goto-char (match-beginning 1)))
736 (when (match-beginning 1)
737 (goto-char (match-beginning 1)))
738 ;; move to just before foreign list item markup
739 nil))))
741 (provide 'muse)
743 ;;; muse.el ends here