Really fix termless definition list bug
[muse-el.git] / lisp / muse.el
blob1115b3d09e49ae39a914bb4d92559b1729747d5d
1 ;;; muse.el --- an authoring and publishing tool for Emacs
3 ;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
5 ;; Emacs Lisp Archive Entry
6 ;; Filename: muse.el
7 ;; Version: 3.03
8 ;; Date: Sun 17-Jun-2007
9 ;; Keywords: hypermedia
10 ;; Author: John Wiegley (johnw AT gnu DOT org)
11 ;; Maintainer: Michael Olson <mwolson@gnu.org>
12 ;; Description: An authoring and publishing tool for Emacs
13 ;; URL: http://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 ;; Indicate that this version of Muse supports nested tags
49 (provide 'muse-nested-tags)
51 (defvar muse-version "3.03"
52 "The version of Muse currently loaded")
54 (defun muse-version (&optional insert)
55 "Display the version of Muse that is currently loaded.
56 If INSERT is non-nil, insert the text instead of displaying it."
57 (interactive "P")
58 (if insert
59 (insert muse-version)
60 (message muse-version)))
62 (defgroup muse nil
63 "Options controlling the behavior of Muse.
64 The markup used by Muse is intended to be very friendly to people
65 familiar with Emacs."
66 :group 'hypermedia)
68 (defvar muse-under-windows-p (memq system-type '(ms-dos windows-nt)))
70 (provide 'muse)
72 (require 'wid-edit)
73 (require 'muse-regexps)
75 (defvar muse-update-values-hook nil
76 "Hook for values that are automatically generated.
77 This is to be used by add-on modules for Muse.
78 It is run just before colorizing or publishing a buffer.")
80 ;; Default file extension
82 ;; By default, use the .muse file extension.
83 ;;;###autoload (add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode))
85 ;; We need to have this at top-level, as well, so that any Muse or
86 ;; Planner documents opened during init will just work.
87 (add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode))
89 (eval-when-compile
90 (defvar muse-ignored-extensions))
92 (defvar muse-ignored-extensions-regexp nil
93 "A regexp of extensions to omit from the ending of a Muse page name.
94 This is autogenerated from `muse-ignored-extensions'.")
96 (defun muse-update-file-extension (sym val)
97 "Update the value of `muse-file-extension'."
98 (when (and (featurep 'muse-mode)
99 (boundp sym) (stringp (symbol-value sym))
100 (or (not (stringp val))
101 (not (string= (symbol-value sym) val))))
102 ;; remove old auto-mode-alist association
103 (setq auto-mode-alist
104 (delete (cons (concat "\\." (symbol-value sym) "\\'")
105 'muse-mode-choose-mode)
106 auto-mode-alist)))
107 (set sym val)
108 ;; associate the new file extension with muse-mode
109 (when (and (featurep 'muse-mode)
110 (stringp val)
111 (or (not (stringp (symbol-value sym)))
112 (not (string= (symbol-value sym) val))))
113 (add-to-list 'auto-mode-alist
114 (cons (concat "\\." val "\\'")
115 'muse-mode-choose-mode)))
116 ;; update the ignored extensions regexp
117 (when (and (fboundp 'muse-update-ignored-extensions-regexp)
118 (or (not (stringp (symbol-value sym)))
119 (not (stringp val))
120 (not (string= (symbol-value sym) val))))
121 (muse-update-ignored-extensions-regexp
122 'muse-ignored-extensions muse-ignored-extensions)))
124 (defcustom muse-file-extension "muse"
125 "File extension of Muse files. Omit the period at the beginning.
126 If you don't want Muse files to have an extension, set this to nil."
127 :type '(choice
128 (const :tag "None" nil)
129 (string))
130 :set 'muse-update-file-extension
131 :group 'muse)
133 (defcustom muse-completing-read-function 'completing-read
134 "Function to call when prompting user to choose between a list of options.
135 This should take the same arguments as `completing-read'."
136 :type 'function
137 :group 'muse)
139 (defun muse-update-ignored-extensions-regexp (sym val)
140 "Update the value of `muse-ignored-extensions-regexp'."
141 (set sym val)
142 (if val
143 (setq muse-ignored-extensions-regexp
144 (concat "\\.\\("
145 (regexp-quote (or muse-file-extension "")) "\\|"
146 (mapconcat 'identity val "\\|")
147 "\\)\\'"))
148 (setq muse-ignored-extensions-regexp
149 (if muse-file-extension
150 (concat "\\.\\(" muse-file-extension "\\)\\'")
151 nil))))
153 (add-hook 'muse-update-values-hook
154 (lambda ()
155 (muse-update-ignored-extensions-regexp
156 'muse-ignored-extensions muse-ignored-extensions)))
158 (defcustom muse-ignored-extensions '("bz2" "gz" "[Zz]")
159 "A list of extensions to omit from the ending of a Muse page name.
160 These are regexps.
162 Don't put a period at the beginning of each extension unless you
163 understand that it is part of a regexp."
164 :type '(repeat (regexp :tag "Extension"))
165 :set 'muse-update-ignored-extensions-regexp
166 :group 'muse)
168 (defun muse-update-file-extension-after-init ()
169 ;; This is short, but it has to be a function, otherwise Emacs21
170 ;; does not load it properly when running after-init-hook
171 (muse-update-file-extension 'muse-file-extension muse-file-extension))
173 ;; Once the user's init file has been processed, determine whether
174 ;; they want a file extension
175 (add-hook 'after-init-hook 'muse-update-file-extension-after-init)
177 ;; URL protocols
179 (require 'muse-protocols)
181 ;; Helper functions
183 (defsubst muse-delete-file-if-exists (file)
184 (when (file-exists-p file)
185 (delete-file file)
186 (message "Removed %s" file)))
188 (defsubst muse-time-less-p (t1 t2)
189 "Say whether time T1 is less than time T2."
190 (or (< (car t1) (car t2))
191 (and (= (car t1) (car t2))
192 (< (nth 1 t1) (nth 1 t2)))))
194 (eval-when-compile
195 (defvar muse-publishing-current-file nil))
197 (defun muse-current-file ()
198 "Return the name of the currently visited or published file."
199 (or (and (boundp 'muse-publishing-current-file)
200 muse-publishing-current-file)
201 (buffer-file-name)
202 (concat default-directory (buffer-name))))
204 (defun muse-page-name (&optional name)
205 "Return the canonical form of a Muse page name.
206 All this means is that certain extensions, like .gz, are removed."
207 (save-match-data
208 (unless (and name (not (string= name "")))
209 (setq name (muse-current-file)))
210 (if name
211 (let ((page (file-name-nondirectory name)))
212 (if (and muse-ignored-extensions-regexp
213 (string-match muse-ignored-extensions-regexp page))
214 (replace-match "" t t page)
215 page)))))
217 (defun muse-display-warning (message)
218 "Display the given MESSAGE as a warning."
219 (if (fboundp 'display-warning)
220 (display-warning 'muse message
221 (if (featurep 'xemacs)
222 'warning
223 :warning))
224 (let ((buf (get-buffer-create "*Muse warnings*")))
225 (with-current-buffer buf
226 (goto-char (point-max))
227 (insert "Warning (muse): " message)
228 (unless (bolp)
229 (newline)))
230 (display-buffer buf)
231 (sit-for 0))))
233 (defun muse-eval-lisp (form)
234 "Evaluate the given form and return the result as a string."
235 (require 'pp)
236 (save-match-data
237 (condition-case err
238 (let ((object (eval (read form))))
239 (cond
240 ((stringp object) object)
241 ((and (listp object)
242 (not (eq object nil)))
243 (let ((string (pp-to-string object)))
244 (substring string 0 (1- (length string)))))
245 ((numberp object)
246 (number-to-string object))
247 ((eq object nil) "")
249 (pp-to-string object))))
250 (error
251 (muse-display-warning (format "%s: Error evaluating %s: %s"
252 (muse-page-name) form err))
253 "; INVALID LISP CODE"))))
255 (defmacro muse-with-temp-buffer (&rest body)
256 "Create a temporary buffer, and evaluate BODY there like `progn'.
257 See also `with-temp-file' and `with-output-to-string'.
259 Unlike `with-temp-buffer', this will never attempt to save the
260 temp buffer. It is meant to be used along with
261 `insert-file-contents' or `insert-file-contents-literally'.
263 Additionally, if `debug-on-error' is set to t, keep the buffer
264 around for debugging purposes rather than removing it."
265 (let ((temp-buffer (make-symbol "temp-buffer")))
266 `(let ((,temp-buffer (generate-new-buffer " *muse-temp*")))
267 (unwind-protect
268 (if debug-on-error
269 (with-current-buffer ,temp-buffer
270 ,@body)
271 (condition-case err
272 (with-current-buffer ,temp-buffer
273 ,@body)
274 (error
275 (if (and (boundp 'muse-batch-publishing-p)
276 muse-batch-publishing-p)
277 (progn
278 (message "%s: Error occured: %s"
279 (muse-page-name) err)
280 (backtrace))
281 (muse-display-warning
282 (format (concat "An error occurred while publishing"
283 " %s: %s\n\nSet debug-on-error to"
284 " `t' if you would like a backtrace.")
285 (muse-page-name) err))))))
286 (when (buffer-live-p ,temp-buffer)
287 (with-current-buffer ,temp-buffer
288 (set-buffer-modified-p nil))
289 (unless debug-on-error (kill-buffer ,temp-buffer)))))))
291 (put 'muse-with-temp-buffer 'lisp-indent-function 0)
292 (put 'muse-with-temp-buffer 'edebug-form-spec '(body))
294 (defun muse-collect-alist (list element &optional test)
295 "Collect items from LIST whose car is equal to ELEMENT.
296 If TEST is specified, use it to compare ELEMENT."
297 (unless test (setq test 'equal))
298 (let ((items nil))
299 (dolist (item list)
300 (when (funcall test element (car item))
301 (setq items (cons item items))))
302 items))
304 (defmacro muse-sort-with-closure (list predicate closure)
305 "Sort LIST, stably, comparing elements using PREDICATE.
306 Returns the sorted list. LIST is modified by side effects.
307 PREDICATE is called with two elements of list and CLOSURE.
308 PREDICATE should return non-nil if the first element should sort
309 before the second."
310 `(sort ,list (lambda (a b) (funcall ,predicate a b ,closure))))
312 (put 'muse-sort-with-closure 'lisp-indent-function 0)
313 (put 'muse-sort-with-closure 'edebug-form-spec '(form function-form form))
315 (defun muse-sort-by-rating (rated-list &optional test)
316 "Sort RATED-LIST according to the rating of each element.
317 The rating is stripped out in the returned list.
318 Default sorting is highest-first.
320 If TEST if specified, use it to sort the list."
321 (unless test (setq test '>))
322 (mapcar (function cdr)
323 (muse-sort-with-closure
324 rated-list
325 (lambda (a b closure)
326 (let ((na (numberp (car a)))
327 (nb (numberp (car b))))
328 (cond ((and na nb) (funcall closure (car a) (car b)))
329 (na (not nb))
330 (t nil))))
331 test)))
333 (defun muse-escape-specials-in-string (specials string &optional reverse)
334 "Apply the transformations in SPECIALS to STRING.
336 The transforms should form a fully reversible and non-ambiguous
337 syntax when STRING is parsed from left to right.
339 If REVERSE is specified, reverse an already-escaped string."
340 (let ((rules (mapcar (lambda (rule)
341 (cons (regexp-quote (if reverse
342 (cdr rule)
343 (car rule)))
344 (if reverse (car rule) (cdr rule))))
345 specials)))
346 (with-temp-buffer
347 (insert string)
348 (goto-char (point-min))
349 (save-match-data
350 (while (not (eobp))
351 (unless (catch 'found
352 (dolist (rule rules)
353 (when (looking-at (car rule))
354 (replace-match (cdr rule) t t)
355 (throw 'found t))))
356 (forward-char))))
357 (buffer-string))))
359 (defun muse-trim-whitespace (string)
360 "Return a version of STRING with no initial nor trailing whitespace."
361 (muse-replace-regexp-in-string
362 (concat "\\`[" muse-regexp-blank "]+\\|[" muse-regexp-blank "]+\\'")
363 "" string))
365 (defun muse-path-sans-extension (path)
366 "Return PATH sans final \"extension\".
368 The extension, in a file name, is the part that follows the last `.',
369 except that a leading `.', if any, doesn't count.
371 This differs from `file-name-sans-extension' in that it will
372 never modify the directory part of the path."
373 (concat (file-name-directory path)
374 (file-name-nondirectory (file-name-sans-extension path))))
376 ;; The following code was extracted from cl
378 (defun muse-const-expr-p (x)
379 (cond ((consp x)
380 (or (eq (car x) 'quote)
381 (and (memq (car x) '(function function*))
382 (or (symbolp (nth 1 x))
383 (and (eq (and (consp (nth 1 x))
384 (car (nth 1 x))) 'lambda) 'func)))))
385 ((symbolp x) (and (memq x '(nil t)) t))
386 (t t)))
388 (put 'muse-assertion-failed 'error-conditions '(error))
389 (put 'muse-assertion-failed 'error-message "Assertion failed")
391 (defun muse-list* (arg &rest rest)
392 "Return a new list with specified args as elements, cons'd to last arg.
393 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
394 `(cons A (cons B (cons C D)))'."
395 (cond ((not rest) arg)
396 ((not (cdr rest)) (cons arg (car rest)))
397 (t (let* ((n (length rest))
398 (copy (copy-sequence rest))
399 (last (nthcdr (- n 2) copy)))
400 (setcdr last (car (cdr last)))
401 (cons arg copy)))))
403 (defmacro muse-assert (form &optional show-args string &rest args)
404 "Verify that FORM returns non-nil; signal an error if not.
405 Second arg SHOW-ARGS means to include arguments of FORM in message.
406 Other args STRING and ARGS... are arguments to be passed to `error'.
407 They are not evaluated unless the assertion fails. If STRING is
408 omitted, a default message listing FORM itself is used."
409 (let ((sargs
410 (and show-args
411 (delq nil (mapcar
412 (function
413 (lambda (x)
414 (and (not (muse-const-expr-p x)) x)))
415 (cdr form))))))
416 (list 'progn
417 (list 'or form
418 (if string
419 (muse-list* 'error string (append sargs args))
420 (list 'signal '(quote muse-assertion-failed)
421 (muse-list* 'list (list 'quote form) sargs))))
422 nil)))
424 ;; Compatibility functions
426 (if (fboundp 'looking-back)
427 (defalias 'muse-looking-back 'looking-back)
428 (defun muse-looking-back (regexp &optional limit &rest ignored)
429 (save-excursion
430 (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
432 (eval-and-compile
433 (if (fboundp 'line-end-position)
434 (defalias 'muse-line-end-position 'line-end-position)
435 (defun muse-line-end-position (&optional n)
436 (save-excursion (end-of-line n) (point))))
438 (if (fboundp 'line-beginning-position)
439 (defalias 'muse-line-beginning-position 'line-beginning-position)
440 (defun muse-line-beginning-position (&optional n)
441 (save-excursion (beginning-of-line n) (point))))
443 (if (fboundp 'match-string-no-properties)
444 (defalias 'muse-match-string-no-properties 'match-string-no-properties)
445 (defun muse-match-string-no-properties (num &optional string)
446 (match-string num string))))
448 (defun muse-replace-regexp-in-string (regexp replacement text &optional fixedcase literal)
449 "Replace REGEXP with REPLACEMENT in TEXT.
451 Return a new string containing the replacements.
453 If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
454 If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
455 (cond
456 ((and (featurep 'xemacs) (fboundp 'replace-in-string))
457 (replace-in-string text regexp replacement literal))
458 ((fboundp 'replace-regexp-in-string)
459 (replace-regexp-in-string regexp replacement text fixedcase literal))
460 (t (let ((repl-len (length replacement))
461 start)
462 (unless (string= regexp "")
463 (save-match-data
464 (while (setq start (string-match regexp text start))
465 (setq start (+ start repl-len)
466 text (replace-match replacement fixedcase literal
467 text))))))
468 text)))
470 (if (fboundp 'add-to-invisibility-spec)
471 (defalias 'muse-add-to-invisibility-spec 'add-to-invisibility-spec)
472 (defun muse-add-to-invisibility-spec (element)
473 "Add ELEMENT to `buffer-invisibility-spec'.
474 See documentation for `buffer-invisibility-spec' for the kind of elements
475 that can be added."
476 (if (eq buffer-invisibility-spec t)
477 (setq buffer-invisibility-spec (list t)))
478 (setq buffer-invisibility-spec
479 (cons element buffer-invisibility-spec))))
481 (if (fboundp 'read-directory-name)
482 (defalias 'muse-read-directory-name 'read-directory-name)
483 (defun muse-read-directory-name (prompt &optional dir default-dirname mustmatch initial)
484 "Read directory name - see `read-file-name' for details."
485 (unless dir
486 (setq dir default-directory))
487 (read-file-name prompt dir (or default-dirname
488 (if initial (expand-file-name initial dir)
489 dir))
490 mustmatch initial)))
492 (defun muse-file-remote-p (file)
493 "Test whether FILE specifies a location on a remote system.
494 Return non-nil if the location is indeed remote.
496 For example, the filename \"/user@host:/foo\" specifies a location
497 on the system \"/user@host:\"."
498 (cond ((fboundp 'file-remote-p)
499 (file-remote-p file))
500 ((fboundp 'tramp-handle-file-remote-p)
501 (tramp-handle-file-remote-p file))
502 ((and (boundp 'ange-ftp-name-format)
503 (string-match (car ange-ftp-name-format) file))
505 (t nil)))
507 ;; Set face globally in a predictable fashion
508 (defun muse-copy-face (old new)
509 "Copy face OLD to NEW."
510 (if (featurep 'xemacs)
511 (copy-face old new 'all)
512 (copy-face old new)))
514 ;; Widget compatibility functions
516 (defun muse-widget-type-value-create (widget)
517 "Convert and instantiate the value of the :type attribute of WIDGET.
518 Store the newly created widget in the :children attribute.
520 The value of the :type attribute should be an unconverted widget type."
521 (let ((value (widget-get widget :value))
522 (type (widget-get widget :type)))
523 (widget-put widget :children
524 (list (widget-create-child-value widget
525 (widget-convert type)
526 value)))))
528 (defun muse-widget-child-value-get (widget)
529 "Get the value of the first member of :children in WIDGET."
530 (widget-value (car (widget-get widget :children))))
532 (defun muse-widget-type-match (widget value)
533 "Non-nil if the :type value of WIDGET matches VALUE.
535 The value of the :type attribute should be an unconverted widget type."
536 (widget-apply (widget-convert (widget-get widget :type)) :match value))
538 ;; Link-handling functions and variables
540 (defun muse-get-link (&optional target)
541 "Based on the match data, retrieve the link.
542 Use TARGET to get the string, if it is specified."
543 (muse-match-string-no-properties 1 target))
545 (defun muse-get-link-desc (&optional target)
546 "Based on the match data, retrieve the link description.
547 Use TARGET to get the string, if it is specified."
548 (muse-match-string-no-properties 2 target))
550 (defvar muse-link-specials
551 '(("[" . "%5B")
552 ("]" . "%5D")
553 ("%" . "%%"))
554 "Syntax used for escaping and unescaping links.
555 This allows brackets to occur in explicit links as long as you
556 use the standard Muse functions to create them.")
558 (defun muse-link-escape (text)
559 "Escape characters in TEXT that conflict with the explicit link
560 regexp."
561 (when (stringp text)
562 (muse-escape-specials-in-string muse-link-specials text)))
564 (defun muse-link-unescape (text)
565 "Un-escape characters in TEXT that conflict with the explicit
566 link regexp."
567 (when (stringp text)
568 (muse-escape-specials-in-string muse-link-specials text t)))
570 (defun muse-handle-url (&optional string)
571 "If STRING or point has a URL, match and return it."
572 (if (if string (string-match muse-url-regexp string)
573 (looking-at muse-url-regexp))
574 (match-string 0 string)))
576 (defcustom muse-implicit-link-functions '(muse-handle-url)
577 "A list of functions to handle an implicit link.
578 An implicit link is one that is not surrounded by brackets.
580 By default, Muse handles URLs only.
581 If you want to handle WikiWords, load muse-wiki.el."
582 :type 'hook
583 :options '(muse-handle-url)
584 :group 'muse)
586 (defun muse-handle-implicit-link (&optional link)
587 "Handle implicit links. If LINK is not specified, look at point.
588 An implicit link is one that is not surrounded by brackets.
589 By default, Muse handles URLs only.
590 If you want to handle WikiWords, load muse-wiki.el.
592 This function modifies the match data so that match 0 is the
593 link.
595 The match data is restored after each unsuccessful handler
596 function call. If LINK is specified, only restore at very end.
598 This behavior is needed because the part of the buffer that
599 `muse-implicit-link-regexp' matches must be narrowed to the part
600 that is an accepted link."
601 (let ((funcs muse-implicit-link-functions)
602 (res nil)
603 (data (match-data t)))
604 (while funcs
605 (setq res (funcall (car funcs) link))
606 (if res
607 (setq funcs nil)
608 (unless link (set-match-data data))
609 (setq funcs (cdr funcs))))
610 (when link (set-match-data data))
611 res))
613 (defcustom muse-explicit-link-functions nil
614 "A list of functions to handle an explicit link.
615 An explicit link is one [[like][this]] or [[this]]."
616 :type 'hook
617 :group 'muse)
619 (defun muse-handle-explicit-link (&optional link)
620 "Handle explicit links. If LINK is not specified, look at point.
621 An explicit link is one that looks [[like][this]] or [[this]].
623 The match data is preserved. If no handlers are able to process
624 LINK, return LINK (if specified) or the 1st match string. If
625 LINK is not specified, it is assumed that Muse has matched
626 against `muse-explicit-link-regexp' before calling this
627 function."
628 (let ((funcs muse-explicit-link-functions)
629 (res nil))
630 (save-match-data
631 (while funcs
632 (setq res (funcall (car funcs) link))
633 (if res
634 (setq funcs nil)
635 (setq funcs (cdr funcs)))))
636 (muse-link-unescape
637 (if res
639 (or link (muse-get-link))))))
641 ;; Movement functions
643 (defun muse-list-item-type (str)
644 "Determine the type of list given STR.
645 Returns either 'ul, 'ol, 'dl-term, 'dl-entry, or nil."
646 (save-match-data
647 (cond ((or (string= str "")
648 (< (length str) 2))
649 nil)
650 ((string-match muse-dl-entry-regexp str)
651 'dl-entry)
652 ((string-match muse-dl-term-regexp str)
653 'dl-term)
654 ((string-match muse-ol-item-regexp str)
655 'ol)
656 ((string-match muse-ul-item-regexp str)
657 'ul)
658 (t nil))))
660 (defun muse-list-item-critical-point (&optional offset)
661 "Figure out where the important markup character for the
662 currently-matched list item is.
664 If OFFSET is specified, it is the number of groupings outside of
665 the contents of `muse-list-item-regexp'."
666 (unless offset (setq offset 0))
667 (if (match-end (+ offset 2))
668 ;; at a definition list
669 (match-end (+ offset 2))
670 ;; at a different kind of list
671 (match-beginning (+ offset 1))))
673 (defun muse-forward-paragraph (&optional pattern)
674 "Move forward safely by one paragraph, or according to PATTERN."
675 (when (get-text-property (point) 'end-list)
676 (goto-char (next-single-property-change (point) 'end-list)))
677 (setq pattern (if pattern
678 (concat "^\\(?:" pattern "\\|\n\\|\\'\\)")
679 "^\\s-*\\(\n\\|\\'\\)"))
680 (let ((next-list-end (or (next-single-property-change (point) 'end-list)
681 (point-max))))
682 (forward-line 1)
683 (if (re-search-forward pattern nil t)
684 (goto-char (match-beginning 0))
685 (goto-char (point-max)))
686 (when (> (point) next-list-end)
687 (goto-char next-list-end))))
689 (defun muse-forward-list-item-1 (type empty-line indented-line)
690 "Determine whether a nested list item is after point."
691 (if (match-beginning 1)
692 ;; if we are given a dl entry, skip past everything on the same
693 ;; level, except for other dl entries
694 (and (eq type 'dl-entry)
695 (not (eq (char-after (match-beginning 2)) ?\:)))
696 ;; blank line encountered with no list item on the same
697 ;; level after it
698 (let ((beg (point)))
699 (forward-line 1)
700 (if (save-match-data
701 (and (looking-at indented-line)
702 (not (looking-at empty-line))))
703 ;; found that this blank line is followed by some
704 ;; indentation, plus other text, so we'll keep
705 ;; going
707 (goto-char beg)
708 nil))))
710 (defun muse-forward-list-item (type indent &optional no-skip-nested)
711 "Move forward to the next item of TYPE.
712 Return non-nil if successful, nil otherwise.
713 The beginning indentation is given by INDENT.
715 If NO-SKIP-NESTED is non-nil, do not skip past nested items.
716 Note that if you desire this behavior, you will also need to
717 provide a very liberal INDENT value, such as
718 \(concat \"[\" muse-regexp-blank \"]*\")."
719 (let* ((list-item (format muse-list-item-regexp indent))
720 (empty-line (concat "^[" muse-regexp-blank "]*\n"))
721 (indented-line (concat "^" indent "[" muse-regexp-blank "]"))
722 (list-pattern (concat "\\(?:" empty-line "\\)?"
723 "\\(" list-item "\\)")))
724 (while (progn
725 (muse-forward-paragraph list-pattern)
726 ;; make sure we don't go past boundary
727 (and (not (or (get-text-property (point) 'end-list)
728 (>= (point) (point-max))))
729 ;; move past markup that is part of another construct
730 (or (and (match-beginning 1)
731 (or (get-text-property
732 (muse-list-item-critical-point 1) 'muse-link)
733 (and (derived-mode-p 'muse-mode)
734 (get-text-property
735 (muse-list-item-critical-point 1)
736 'face))))
737 ;; skip nested items
738 (and (not no-skip-nested)
739 (muse-forward-list-item-1 type empty-line
740 indented-line))))))
741 (cond ((or (get-text-property (point) 'end-list)
742 (>= (point) (point-max)))
743 ;; at a list boundary, so stop
744 nil)
745 ((let ((str (when (match-beginning 2)
746 ;; get the entire line
747 (save-excursion
748 (goto-char (match-beginning 2))
749 (buffer-substring (muse-line-beginning-position)
750 (muse-line-end-position))))))
751 (and str (eq type (muse-list-item-type str))))
752 ;; same type, so indicate that there are more items to be
753 ;; parsed
754 (goto-char (match-beginning 1)))
756 (when (match-beginning 1)
757 (goto-char (match-beginning 1)))
758 ;; move to just before foreign list item markup
759 nil))))
761 (defun muse-goto-tag-end (tag nested)
762 "Move forward past the end of TAG.
764 If NESTED is non-nil, look for other instances of this tag that
765 may be nested inside of this tag, and skip past them."
766 (if (not nested)
767 (search-forward (concat "</" tag ">") nil t)
768 (let ((nesting 1)
769 (tag-regexp (concat "\\(<\\(/?\\)" tag ">\\)"))
770 (match-found nil))
771 (while (and (> nesting 0)
772 (setq match-found (re-search-forward tag-regexp nil t)))
773 (if (string-equal (match-string 2) "/")
774 (setq nesting (1- nesting))
775 (setq nesting (1+ nesting))))
776 match-found)))
778 ;;; muse.el ends here