1 ;;; muse.el --- Authoring and publishing tool for Emacs
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 ;; Free Software Foundation, Inc.
6 ;; Emacs Lisp Archive Entry
9 ;; Date: Sun 31 Jan-2010
10 ;; Keywords: hypermedia
11 ;; Author: John Wiegley <johnw@gnu.org>
12 ;; Maintainer: Michael Olson <mwolson@gnu.org>
13 ;; Description: An authoring and publishing tool for Emacs
14 ;; URL: http://mwolson.org/projects/EmacsMuse.html
15 ;; Compatibility: Emacs21 XEmacs21 Emacs22
17 ;; This file is part of Emacs Muse. It is not part of GNU Emacs.
19 ;; Emacs Muse is free software; you can redistribute it and/or modify
20 ;; it under the terms of the GNU General Public License as published
21 ;; by the Free Software Foundation; either version 3, or (at your
22 ;; option) any later version.
24 ;; Emacs Muse is distributed in the hope that it will be useful, but
25 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
26 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
27 ;; General Public License for more details.
29 ;; You should have received a copy of the GNU General Public License
30 ;; along with Emacs Muse; see the file COPYING. If not, write to the
31 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
32 ;; Boston, MA 02110-1301, USA.
36 ;; Muse is a tool for easily authoring and publishing documents. It
37 ;; allows for rapid prototyping of hyperlinked text, which may then be
38 ;; exported to multiple output formats -- such as HTML, LaTeX,
41 ;; The markup rules used by Muse are intended to be very friendly to
42 ;; people familiar with Emacs. See the included manual for more
49 ;; Indicate that this version of Muse supports nested tags
50 (provide 'muse-nested-tags)
52 (defvar muse-version "3.20"
53 "The version of Muse currently loaded")
55 (defun muse-version (&optional insert)
56 "Display the version of Muse that is currently loaded.
57 If INSERT is non-nil, insert the text instead of displaying it."
61 (message muse-version)))
64 "Options controlling the behavior of Muse.
65 The markup used by Muse is intended to be very friendly to people
69 (defvar muse-under-windows-p (memq system-type '(ms-dos windows-nt)))
77 (require 'muse-regexps)
79 (defvar muse-update-values-hook nil
80 "Hook for values that are automatically generated.
81 This is to be used by add-on modules for Muse.
82 It is run just before colorizing or publishing a buffer.")
84 (defun muse-update-values ()
85 "Update various values that are automatically generated.
87 Call this after changing `muse-project-alist'."
89 (run-hooks 'muse-update-values-hook)
90 (dolist (buffer (buffer-list))
91 (when (buffer-live-p buffer)
92 (with-current-buffer buffer
93 (when (derived-mode-p 'muse-mode)
94 (and (boundp 'muse-current-project)
95 (fboundp 'muse-project-of-file)
96 (setq muse-current-project nil)
97 (setq muse-current-project (muse-project-of-file))))))))
99 ;; Default file extension
101 ;; By default, use the .muse file extension.
102 ;;;###autoload (add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode))
104 ;; We need to have this at top-level, as well, so that any Muse or
105 ;; Planner documents opened during init will just work.
106 (add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode))
109 (defvar muse-ignored-extensions))
111 (defvar muse-ignored-extensions-regexp nil
112 "A regexp of extensions to omit from the ending of a Muse page name.
113 This is autogenerated from `muse-ignored-extensions'.")
115 (defun muse-update-file-extension (sym val)
116 "Update the value of `muse-file-extension'."
117 (let ((old (and (boundp sym) (symbol-value sym))))
119 (when (and (featurep 'muse-mode)
120 (or (not (stringp val))
122 (not (string= old val))))
123 ;; remove old auto-mode-alist association
124 (when (and (boundp sym) (stringp old))
125 (setq auto-mode-alist
126 (delete (cons (concat "\\." old "\\'")
127 'muse-mode-choose-mode)
129 ;; associate the new file extension with muse-mode
131 (add-to-list 'auto-mode-alist
132 (cons (concat "\\." val "\\'")
133 'muse-mode-choose-mode)))
134 ;; update the ignored extensions regexp
135 (when (fboundp 'muse-update-ignored-extensions-regexp)
136 (muse-update-ignored-extensions-regexp
137 'muse-ignored-extensions muse-ignored-extensions)))))
139 (defcustom muse-file-extension "muse"
140 "File extension of Muse files. Omit the period at the beginning.
141 If you don't want Muse files to have an extension, set this to nil."
143 (const :tag "None" nil)
145 :set 'muse-update-file-extension
148 (defcustom muse-completing-read-function 'completing-read
149 "Function to call when prompting user to choose between a list of options.
150 This should take the same arguments as `completing-read'."
154 (defun muse-update-ignored-extensions-regexp (sym val)
155 "Update the value of `muse-ignored-extensions-regexp'."
158 (setq muse-ignored-extensions-regexp
160 (regexp-quote (or muse-file-extension "")) "\\|"
161 (mapconcat 'identity val "\\|")
163 (setq muse-ignored-extensions-regexp
164 (if muse-file-extension
165 (concat "\\.\\(" muse-file-extension "\\)\\'")
168 (add-hook 'muse-update-values-hook
170 (muse-update-ignored-extensions-regexp
171 'muse-ignored-extensions muse-ignored-extensions)))
173 (defcustom muse-ignored-extensions '("bz2" "gz" "[Zz]")
174 "A list of extensions to omit from the ending of a Muse page name.
177 Don't put a period at the beginning of each extension unless you
178 understand that it is part of a regexp."
179 :type '(repeat (regexp :tag "Extension"))
180 :set 'muse-update-ignored-extensions-regexp
183 (defun muse-update-file-extension-after-init ()
184 ;; This is short, but it has to be a function, otherwise Emacs21
185 ;; does not load it properly when running after-init-hook
186 (unless (string= muse-file-extension "muse")
187 (let ((val muse-file-extension)
188 (muse-file-extension "muse"))
189 (muse-update-file-extension 'muse-file-extension val))))
191 ;; Once the user's init file has been processed, determine whether
192 ;; they want a file extension
193 (add-hook 'after-init-hook 'muse-update-file-extension-after-init)
197 (require 'muse-protocols)
201 (defsubst muse-delete-file-if-exists (file)
202 (when (file-exists-p file)
204 (message "Removed %s" file)))
206 (defsubst muse-time-less-p (t1 t2)
207 "Say whether time T1 is less than time T2."
208 (or (< (car t1) (car t2))
209 (and (= (car t1) (car t2))
210 (< (nth 1 t1) (nth 1 t2)))))
213 (defvar muse-publishing-current-file nil))
215 (defun muse-current-file ()
216 "Return the name of the currently visited or published file."
217 (or (and (boundp 'muse-publishing-current-file)
218 muse-publishing-current-file)
220 (concat default-directory (buffer-name))))
222 (defun muse-page-name (&optional name)
223 "Return the canonical form of a Muse page name.
225 What this means is that the directory part of NAME is removed,
226 and the file extensions in `muse-ignored-extensions' are also
229 (unless (and name (not (string= name "")))
230 (setq name (muse-current-file)))
232 (let ((page (file-name-nondirectory name)))
233 (if (and muse-ignored-extensions-regexp
234 (string-match muse-ignored-extensions-regexp page))
235 (replace-match "" t t page)
238 (defun muse-display-warning (message)
239 "Display the given MESSAGE as a warning."
240 (if (fboundp 'display-warning)
241 (display-warning 'muse message
242 (if (featurep 'xemacs)
245 (let ((buf (get-buffer-create "*Muse warnings*")))
246 (with-current-buffer buf
247 (goto-char (point-max))
248 (insert "Warning (muse): " message)
254 (defun muse-eval-lisp (form)
255 "Evaluate the given form and return the result as a string."
259 (let ((object (eval (read form))))
261 ((stringp object) object)
263 (not (eq object nil)))
264 (let ((string (pp-to-string object)))
265 (substring string 0 (1- (length string)))))
267 (number-to-string object))
270 (pp-to-string object))))
272 (muse-display-warning (format "%s: Error evaluating %s: %s"
273 (muse-page-name) form err))
274 "; INVALID LISP CODE"))))
276 (defmacro muse-with-temp-buffer (&rest body)
277 "Create a temporary buffer, and evaluate BODY there like `progn'.
278 See also `with-temp-file' and `with-output-to-string'.
280 Unlike `with-temp-buffer', this will never attempt to save the
281 temp buffer. It is meant to be used along with
282 `insert-file-contents' or `muse-insert-file-contents'.
284 The undo feature will be disabled in the new buffer.
286 If `debug-on-error' is set to t, keep the buffer around for
287 debugging purposes rather than removing it."
288 (let ((temp-buffer (make-symbol "temp-buffer")))
289 `(let ((,temp-buffer (generate-new-buffer " *muse-temp*")))
290 (buffer-disable-undo ,temp-buffer)
293 (with-current-buffer ,temp-buffer
296 (with-current-buffer ,temp-buffer
299 (if (and (boundp 'muse-batch-publishing-p)
300 muse-batch-publishing-p)
302 (message "%s: Error occured: %s"
303 (muse-page-name) err)
305 (muse-display-warning
306 (format (concat "An error occurred while publishing"
307 " %s:\n %s\n\nSet debug-on-error to"
308 " `t' if you would like a backtrace.")
309 (muse-page-name) err))))))
310 (when (buffer-live-p ,temp-buffer)
311 (with-current-buffer ,temp-buffer
312 (set-buffer-modified-p nil))
313 (unless debug-on-error (kill-buffer ,temp-buffer)))))))
315 (put 'muse-with-temp-buffer 'lisp-indent-function 0)
316 (put 'muse-with-temp-buffer 'edebug-form-spec '(body))
318 (defun muse-insert-file-contents (filename &optional visit)
319 "Insert the contents of file FILENAME after point.
320 Do character code conversion and end-of-line conversion, but none
321 of the other unnecessary things like format decoding or
324 If VISIT is non-nil, the buffer's visited filename
325 and last save file modtime are set, and it is marked unmodified.
326 If visiting and the file does not exist, visiting is completed
327 before the error is signaled."
328 (let ((format-alist nil)
329 (after-insert-file-functions nil)
330 (inhibit-file-name-handlers
331 (append '(jka-compr-handler image-file-handler epa-file-handler)
332 inhibit-file-name-handlers))
333 (inhibit-file-name-operation 'insert-file-contents))
334 (insert-file-contents filename visit)))
336 (defun muse-write-file (filename &optional nomessage)
337 "Write current buffer into file FILENAME.
338 Unlike `write-file', this does not visit the file, try to back it
339 up, or interact with vc.el in any way.
341 If the file was not written successfully, return nil. Otherwise,
344 If the NOMESSAGE argument is non-nil, suppress the \"Wrote file\"
346 (when nomessage (setq nomessage 'nomessage))
347 (let ((backup-inhibited t)
348 (buffer-file-name filename)
349 (buffer-file-truename (file-truename filename)))
353 (if (not (file-writable-p buffer-file-name))
355 (muse-display-warning
356 (format "Cannot write file %s:\n %s" buffer-file-name
357 (let ((dir (file-name-directory buffer-file-name)))
358 (if (not (file-directory-p dir))
359 (if (file-exists-p dir)
360 (format "%s is not a directory" dir)
361 (format "No directory named %s exists" dir))
362 (if (not (file-exists-p buffer-file-name))
363 (format "Directory %s write-protected" dir)
364 "File is write-protected"))))))
365 (let ((coding-system-for-write
366 (or (and (boundp 'save-buffer-coding-system)
367 save-buffer-coding-system)
368 coding-system-for-write)))
369 (write-region (point-min) (point-max) buffer-file-name
371 (when (boundp 'last-file-coding-system-used)
372 (when (boundp 'buffer-file-coding-system-explicit)
373 (setq buffer-file-coding-system-explicit
374 last-coding-system-used))
375 (if save-buffer-coding-system
376 (setq save-buffer-coding-system last-coding-system-used)
377 (setq buffer-file-coding-system last-coding-system-used)))
380 (defun muse-collect-alist (list element &optional test)
381 "Collect items from LIST whose car is equal to ELEMENT.
382 If TEST is specified, use it to compare ELEMENT."
383 (unless test (setq test 'equal))
386 (when (funcall test element (car item))
387 (setq items (cons item items))))
390 (defmacro muse-sort-with-closure (list predicate closure)
391 "Sort LIST, stably, comparing elements using PREDICATE.
392 Returns the sorted list. LIST is modified by side effects.
393 PREDICATE is called with two elements of list and CLOSURE.
394 PREDICATE should return non-nil if the first element should sort
396 `(sort ,list (lambda (a b) (funcall ,predicate a b ,closure))))
398 (put 'muse-sort-with-closure 'lisp-indent-function 0)
399 (put 'muse-sort-with-closure 'edebug-form-spec '(form function-form form))
401 (defun muse-sort-by-rating (rated-list &optional test)
402 "Sort RATED-LIST according to the rating of each element.
403 The rating is stripped out in the returned list.
404 Default sorting is highest-first.
406 If TEST if specified, use it to sort the list. The default test is '>."
407 (unless test (setq test '>))
408 (mapcar (function cdr)
409 (muse-sort-with-closure
411 (lambda (a b closure)
412 (let ((na (numberp (car a)))
413 (nb (numberp (car b))))
414 (cond ((and na nb) (funcall closure (car a) (car b)))
419 (defun muse-escape-specials-in-string (specials string &optional reverse)
420 "Apply the transformations in SPECIALS to STRING.
422 The transforms should form a fully reversible and non-ambiguous
423 syntax when STRING is parsed from left to right.
425 If REVERSE is specified, reverse an already-escaped string."
426 (let ((rules (mapcar (lambda (rule)
427 (cons (regexp-quote (if reverse
430 (if reverse (car rule) (cdr rule))))
435 (goto-char (point-min))
437 (unless (catch 'found
439 (when (looking-at (car rule))
440 (replace-match (cdr rule) t t)
445 (defun muse-trim-whitespace (string)
446 "Return a version of STRING with no initial nor trailing whitespace."
447 (muse-replace-regexp-in-string
448 (concat "\\`[" muse-regexp-blank "]+\\|[" muse-regexp-blank "]+\\'")
451 (defun muse-path-sans-extension (path)
452 "Return PATH sans final \"extension\".
454 The extension, in a file name, is the part that follows the last `.',
455 except that a leading `.', if any, doesn't count.
457 This differs from `file-name-sans-extension' in that it will
458 never modify the directory part of the path."
459 (concat (file-name-directory path)
460 (file-name-nondirectory (file-name-sans-extension path))))
462 ;; The following code was extracted from cl
464 (defun muse-const-expr-p (x)
466 (or (eq (car x) 'quote)
467 (and (memq (car x) '(function function*))
468 (or (symbolp (nth 1 x))
469 (and (eq (and (consp (nth 1 x))
470 (car (nth 1 x))) 'lambda) 'func)))))
471 ((symbolp x) (and (memq x '(nil t)) t))
474 (put 'muse-assertion-failed 'error-conditions '(error))
475 (put 'muse-assertion-failed 'error-message "Assertion failed")
477 (defun muse-list* (arg &rest rest)
478 "Return a new list with specified args as elements, cons'd to last arg.
479 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
480 `(cons A (cons B (cons C D)))'."
481 (cond ((not rest) arg)
482 ((not (cdr rest)) (cons arg (car rest)))
483 (t (let* ((n (length rest))
484 (copy (copy-sequence rest))
485 (last (nthcdr (- n 2) copy)))
486 (setcdr last (car (cdr last)))
489 (defmacro muse-assert (form &optional show-args string &rest args)
490 "Verify that FORM returns non-nil; signal an error if not.
491 Second arg SHOW-ARGS means to include arguments of FORM in message.
492 Other args STRING and ARGS... are arguments to be passed to `error'.
493 They are not evaluated unless the assertion fails. If STRING is
494 omitted, a default message listing FORM itself is used."
500 (and (not (muse-const-expr-p x)) x)))
505 (muse-list* 'error string (append sargs args))
506 (list 'signal '(quote muse-assertion-failed)
507 (muse-list* 'list (list 'quote form) sargs))))
510 ;; Compatibility functions
512 (if (fboundp 'looking-back)
513 (defalias 'muse-looking-back 'looking-back)
514 (defun muse-looking-back (regexp &optional limit &rest ignored)
516 (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
519 (if (fboundp 'line-end-position)
520 (defalias 'muse-line-end-position 'line-end-position)
521 (defun muse-line-end-position (&optional n)
522 (save-excursion (end-of-line n) (point))))
524 (if (fboundp 'line-beginning-position)
525 (defalias 'muse-line-beginning-position 'line-beginning-position)
526 (defun muse-line-beginning-position (&optional n)
527 (save-excursion (beginning-of-line n) (point))))
529 (if (fboundp 'match-string-no-properties)
530 (defalias 'muse-match-string-no-properties 'match-string-no-properties)
531 (defun muse-match-string-no-properties (num &optional string)
532 (match-string num string))))
534 (defun muse-replace-regexp-in-string (regexp replacement text &optional fixedcase literal)
535 "Replace REGEXP with REPLACEMENT in TEXT.
537 Return a new string containing the replacements.
539 If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
540 If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
542 ((and (featurep 'xemacs) (fboundp 'replace-in-string))
543 (and (fboundp 'replace-in-string) ; stupid byte-compiler warning
544 (replace-in-string text regexp replacement literal)))
545 ((fboundp 'replace-regexp-in-string)
546 (replace-regexp-in-string regexp replacement text fixedcase literal))
547 (t (error (concat "Neither `replace-in-string' nor "
548 "`replace-regexp-in-string' was found")))))
550 (if (fboundp 'add-to-invisibility-spec)
551 (defalias 'muse-add-to-invisibility-spec 'add-to-invisibility-spec)
552 (defun muse-add-to-invisibility-spec (element)
553 "Add ELEMENT to `buffer-invisibility-spec'.
554 See documentation for `buffer-invisibility-spec' for the kind of elements
556 (if (eq buffer-invisibility-spec t)
557 (setq buffer-invisibility-spec (list t)))
558 (setq buffer-invisibility-spec
559 (cons element buffer-invisibility-spec))))
561 (if (fboundp 'read-directory-name)
562 (defalias 'muse-read-directory-name 'read-directory-name)
563 (defun muse-read-directory-name (prompt &optional dir default-dirname mustmatch initial)
564 "Read directory name - see `read-file-name' for details."
566 (setq dir default-directory))
567 (read-file-name prompt dir (or default-dirname
568 (if initial (expand-file-name initial dir)
572 (defun muse-file-remote-p (file)
573 "Test whether FILE specifies a location on a remote system.
574 Return non-nil if the location is indeed remote.
576 For example, the filename \"/user@host:/foo\" specifies a location
577 on the system \"/user@host:\"."
578 (cond ((fboundp 'file-remote-p)
579 (file-remote-p file))
580 ((fboundp 'tramp-handle-file-remote-p)
581 (tramp-handle-file-remote-p file))
582 ((and (boundp 'ange-ftp-name-format)
583 (string-match (car ange-ftp-name-format) file))
587 (if (fboundp 'delete-and-extract-region)
588 (defalias 'muse-delete-and-extract-region 'delete-and-extract-region)
589 (defun muse-delete-and-extract-region (start end)
590 "Delete the text between START and END and return it."
591 (prog1 (buffer-substring start end)
592 (delete-region start end))))
594 (if (fboundp 'delete-dups)
595 (defalias 'muse-delete-dups 'delete-dups)
596 (defun muse-delete-dups (list)
597 "Destructively remove `equal' duplicates from LIST.
598 Store the result in LIST and return it. LIST must be a proper list.
599 Of several `equal' occurrences of an element in LIST, the first
603 (setcdr tail (delete (car tail) (cdr tail)))
604 (setq tail (cdr tail))))
607 ;; Set face globally in a predictable fashion
608 (defun muse-copy-face (old new)
609 "Copy face OLD to NEW."
610 (if (featurep 'xemacs)
611 (copy-face old new 'all)
612 (copy-face old new)))
614 ;; Widget compatibility functions
616 (defun muse-widget-type-value-create (widget)
617 "Convert and instantiate the value of the :type attribute of WIDGET.
618 Store the newly created widget in the :children attribute.
620 The value of the :type attribute should be an unconverted widget type."
621 (let ((value (widget-get widget :value))
622 (type (widget-get widget :type)))
623 (widget-put widget :children
624 (list (widget-create-child-value widget
625 (widget-convert type)
628 (defun muse-widget-child-value-get (widget)
629 "Get the value of the first member of :children in WIDGET."
630 (widget-value (car (widget-get widget :children))))
632 (defun muse-widget-type-match (widget value)
633 "Non-nil if the :type value of WIDGET matches VALUE.
635 The value of the :type attribute should be an unconverted widget type."
636 (widget-apply (widget-convert (widget-get widget :type)) :match value))
638 ;; Link-handling functions and variables
640 (defun muse-get-link (&optional target)
641 "Based on the match data, retrieve the link.
642 Use TARGET to get the string, if it is specified."
643 (muse-match-string-no-properties 1 target))
645 (defun muse-get-link-desc (&optional target)
646 "Based on the match data, retrieve the link description.
647 Use TARGET to get the string, if it is specified."
648 (muse-match-string-no-properties 2 target))
650 (defvar muse-link-specials
654 "Syntax used for escaping and unescaping links.
655 This allows brackets to occur in explicit links as long as you
656 use the standard Muse functions to create them.")
658 (defun muse-link-escape (text)
659 "Escape characters in TEXT that conflict with the explicit link
662 (muse-escape-specials-in-string muse-link-specials text)))
664 (defun muse-link-unescape (text)
665 "Un-escape characters in TEXT that conflict with the explicit
668 (muse-escape-specials-in-string muse-link-specials text t)))
670 (defun muse-handle-url (&optional string)
671 "If STRING or point has a URL, match and return it."
672 (if (if string (string-match muse-url-regexp string)
673 (looking-at muse-url-regexp))
674 (match-string 0 string)))
676 (defcustom muse-implicit-link-functions '(muse-handle-url)
677 "A list of functions to handle an implicit link.
678 An implicit link is one that is not surrounded by brackets.
680 By default, Muse handles URLs only.
681 If you want to handle WikiWords, load muse-wiki.el."
683 :options '(muse-handle-url)
686 (defun muse-handle-implicit-link (&optional link)
687 "Handle implicit links. If LINK is not specified, look at point.
688 An implicit link is one that is not surrounded by brackets.
689 By default, Muse handles URLs only.
690 If you want to handle WikiWords, load muse-wiki.el.
692 This function modifies the match data so that match 0 is the
695 The match data is restored after each unsuccessful handler
696 function call. If LINK is specified, only restore at very end.
698 This behavior is needed because the part of the buffer that
699 `muse-implicit-link-regexp' matches must be narrowed to the part
700 that is an accepted link."
701 (let ((funcs muse-implicit-link-functions)
703 (data (match-data t)))
705 (setq res (funcall (car funcs) link))
708 (unless link (set-match-data data))
709 (setq funcs (cdr funcs))))
710 (when link (set-match-data data))
713 (defcustom muse-explicit-link-functions nil
714 "A list of functions to handle an explicit link.
715 An explicit link is one [[like][this]] or [[this]]."
719 (defun muse-handle-explicit-link (&optional link)
720 "Handle explicit links. If LINK is not specified, look at point.
721 An explicit link is one that looks [[like][this]] or [[this]].
723 The match data is preserved. If no handlers are able to process
724 LINK, return LINK (if specified) or the 1st match string. If
725 LINK is not specified, it is assumed that Muse has matched
726 against `muse-explicit-link-regexp' before calling this
728 (let ((funcs muse-explicit-link-functions)
732 (setq res (funcall (car funcs) link))
735 (setq funcs (cdr funcs)))))
739 (or link (muse-get-link))))))
741 ;; Movement functions
743 (defun muse-list-item-type (str)
744 "Determine the type of list given STR.
745 Returns either 'ul, 'ol, 'dl-term, 'dl-entry, or nil."
747 (cond ((or (string= str "")
750 ((string-match muse-dl-entry-regexp str)
752 ((string-match muse-dl-term-regexp str)
754 ((string-match muse-ol-item-regexp str)
756 ((string-match muse-ul-item-regexp str)
760 (defun muse-list-item-critical-point (&optional offset)
761 "Figure out where the important markup character for the
762 currently-matched list item is.
764 If OFFSET is specified, it is the number of groupings outside of
765 the contents of `muse-list-item-regexp'."
766 (unless offset (setq offset 0))
767 (if (match-end (+ offset 2))
768 ;; at a definition list
769 (match-end (+ offset 2))
770 ;; at a different kind of list
771 (match-beginning (+ offset 1))))
773 (defun muse-forward-paragraph (&optional pattern)
774 "Move forward safely by one paragraph, or according to PATTERN."
775 (when (get-text-property (point) 'muse-end-list)
776 (goto-char (next-single-property-change (point) 'muse-end-list)))
777 (setq pattern (if pattern
778 (concat "^\\(?:" pattern "\\|\n\\|\\'\\)")
779 "^\\s-*\\(\n\\|\\'\\)"))
780 (let ((next-list-end (or (next-single-property-change (point) 'muse-end-list)
783 (if (re-search-forward pattern nil t)
784 (goto-char (match-beginning 0))
785 (goto-char (point-max)))
786 (when (> (point) next-list-end)
787 (goto-char next-list-end))))
789 (defun muse-forward-list-item-1 (type empty-line indented-line)
790 "Determine whether a nested list item is after point."
791 (if (match-beginning 1)
792 ;; if we are given a dl entry, skip past everything on the same
793 ;; level, except for other dl entries
794 (and (eq type 'dl-entry)
795 (not (eq (char-after (match-beginning 2)) ?\:)))
796 ;; blank line encountered with no list item on the same
801 (and (looking-at indented-line)
802 (not (looking-at empty-line))))
803 ;; found that this blank line is followed by some
804 ;; indentation, plus other text, so we'll keep
810 (defun muse-forward-list-item (type indent &optional no-skip-nested)
811 "Move forward to the next item of TYPE.
812 Return non-nil if successful, nil otherwise.
813 The beginning indentation is given by INDENT.
815 If NO-SKIP-NESTED is non-nil, do not skip past nested items.
816 Note that if you desire this behavior, you will also need to
817 provide a very liberal INDENT value, such as
818 \(concat \"[\" muse-regexp-blank \"]*\")."
819 (let* ((list-item (format muse-list-item-regexp indent))
820 (empty-line (concat "^[" muse-regexp-blank "]*\n"))
821 (indented-line (concat "^" indent "[" muse-regexp-blank "]"))
822 (list-pattern (concat "\\(?:" empty-line "\\)?"
823 "\\(" list-item "\\)")))
825 (muse-forward-paragraph list-pattern)
826 ;; make sure we don't go past boundary
827 (and (not (or (get-text-property (point) 'muse-end-list)
828 (>= (point) (point-max))))
829 ;; move past markup that is part of another construct
830 (or (and (match-beginning 1)
831 (or (get-text-property
832 (muse-list-item-critical-point 1) 'muse-link)
833 (and (derived-mode-p 'muse-mode)
835 (muse-list-item-critical-point 1)
838 (and (not no-skip-nested)
839 (muse-forward-list-item-1 type empty-line
841 (cond ((or (get-text-property (point) 'muse-end-list)
842 (>= (point) (point-max)))
843 ;; at a list boundary, so stop
845 ((let ((str (when (match-beginning 2)
846 ;; get the entire line
848 (goto-char (match-beginning 2))
849 (buffer-substring (muse-line-beginning-position)
850 (muse-line-end-position))))))
851 (and str (eq type (muse-list-item-type str))))
852 ;; same type, so indicate that there are more items to be
854 (goto-char (match-beginning 1)))
856 (when (match-beginning 1)
857 (goto-char (match-beginning 1)))
858 ;; move to just before foreign list item markup
861 (defun muse-goto-tag-end (tag nested)
862 "Move forward past the end of TAG.
864 If NESTED is non-nil, look for other instances of this tag that
865 may be nested inside of this tag, and skip past them."
867 (search-forward (concat "</" tag ">") nil t)
869 (tag-regexp (concat "\\(<\\(/?\\)" tag "\\([ >]\\)\\)"))
871 (while (and (> nesting 0)
872 (setq match-found (re-search-forward tag-regexp nil t)))
873 ;; for the sake of font-locking code, skip matches in comments
874 (unless (get-text-property (match-beginning 0) 'muse-comment)
875 (if (string-equal (match-string 2) "/")
876 (and (string-equal (match-string 3) ">")
877 (setq nesting (1- nesting)))
878 (setq nesting (1+ nesting)))))
881 ;;; muse.el ends here