/muse

Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
Raw Blame History
882 lines (760 sloc) 33.1 KB
;;; muse.el --- an authoring and publishing tool for Emacs
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Filename: muse.el
;; Version: 3.20
;; Date: Sun 31 Jan-2010
;; Keywords: hypermedia
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Michael Olson <mwolson@gnu.org>
;; Description: An authoring and publishing tool for Emacs
;; URL: http://mwolson.org/projects/EmacsMuse.html
;; Compatibility: Emacs21 XEmacs21 Emacs22
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
;; Emacs Muse is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 3, or (at your
;; option) any later version.
;; Emacs Muse is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with Emacs Muse; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Muse is a tool for easily authoring and publishing documents. It
;; allows for rapid prototyping of hyperlinked text, which may then be
;; exported to multiple output formats -- such as HTML, LaTeX,
;; Texinfo, etc.
;; The markup rules used by Muse are intended to be very friendly to
;; people familiar with Emacs. See the included manual for more
;; information.
;;; Contributors:
;;; Code:
;; Indicate that this version of Muse supports nested tags
(provide 'muse-nested-tags)
(defvar muse-version "3.20"
"The version of Muse currently loaded")
(defun muse-version (&optional insert)
"Display the version of Muse that is currently loaded.
If INSERT is non-nil, insert the text instead of displaying it."
(interactive "P")
(if insert
(insert muse-version)
(message muse-version)))
(defgroup muse nil
"Options controlling the behavior of Muse.
The markup used by Muse is intended to be very friendly to people
familiar with Emacs."
:group 'hypermedia)
(defvar muse-under-windows-p (memq system-type '(ms-dos windows-nt)))
(provide 'muse)
(condition-case nil
(require 'derived)
(error nil))
(require 'wid-edit)
(require 'muse-regexps)
(defvar muse-update-values-hook nil
"Hook for values that are automatically generated.
This is to be used by add-on modules for Muse.
It is run just before colorizing or publishing a buffer.")
(defun muse-update-values ()
"Update various values that are automatically generated.
Call this after changing `muse-project-alist'."
(interactive)
(run-hooks 'muse-update-values-hook)
(dolist (buffer (buffer-list))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (derived-mode-p 'muse-mode)
(and (boundp 'muse-current-project)
(fboundp 'muse-project-of-file)
(setq muse-current-project nil)
(setq muse-current-project (muse-project-of-file))))))))
;; Default file extension
;; By default, use the .muse file extension.
;;;###autoload (add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode))
;; We need to have this at top-level, as well, so that any Muse or
;; Planner documents opened during init will just work.
(add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode))
(eval-when-compile
(defvar muse-ignored-extensions))
(defvar muse-ignored-extensions-regexp nil
"A regexp of extensions to omit from the ending of a Muse page name.
This is autogenerated from `muse-ignored-extensions'.")
(defun muse-update-file-extension (sym val)
"Update the value of `muse-file-extension'."
(let ((old (and (boundp sym) (symbol-value sym))))
(set sym val)
(when (and (featurep 'muse-mode)
(or (not (stringp val))
(not (stringp old))
(not (string= old val))))
;; remove old auto-mode-alist association
(when (and (boundp sym) (stringp old))
(setq auto-mode-alist
(delete (cons (concat "\\." old "\\'")
'muse-mode-choose-mode)
auto-mode-alist)))
;; associate the new file extension with muse-mode
(when (stringp val)
(add-to-list 'auto-mode-alist
(cons (concat "\\." val "\\'")
'muse-mode-choose-mode)))
;; update the ignored extensions regexp
(when (fboundp 'muse-update-ignored-extensions-regexp)
(muse-update-ignored-extensions-regexp
'muse-ignored-extensions muse-ignored-extensions)))))
(defcustom muse-file-extension "muse"
"File extension of Muse files. Omit the period at the beginning.
If you don't want Muse files to have an extension, set this to nil."
:type '(choice
(const :tag "None" nil)
(string))
:set 'muse-update-file-extension
:group 'muse)
(defcustom muse-completing-read-function 'completing-read
"Function to call when prompting user to choose between a list of options.
This should take the same arguments as `completing-read'."
:type 'function
:group 'muse)
(defun muse-update-ignored-extensions-regexp (sym val)
"Update the value of `muse-ignored-extensions-regexp'."
(set sym val)
(if val
(setq muse-ignored-extensions-regexp
(concat "\\.\\("
(regexp-quote (or muse-file-extension "")) "\\|"
(mapconcat 'identity val "\\|")
"\\)\\'"))
(setq muse-ignored-extensions-regexp
(if muse-file-extension
(concat "\\.\\(" muse-file-extension "\\)\\'")
nil))))
(add-hook 'muse-update-values-hook
(lambda ()
(muse-update-ignored-extensions-regexp
'muse-ignored-extensions muse-ignored-extensions)))
(defcustom muse-ignored-extensions '("bz2" "gz" "[Zz]")
"A list of extensions to omit from the ending of a Muse page name.
These are regexps.
Don't put a period at the beginning of each extension unless you
understand that it is part of a regexp."
:type '(repeat (regexp :tag "Extension"))
:set 'muse-update-ignored-extensions-regexp
:group 'muse)
(defun muse-update-file-extension-after-init ()
;; This is short, but it has to be a function, otherwise Emacs21
;; does not load it properly when running after-init-hook
(unless (string= muse-file-extension "muse")
(let ((val muse-file-extension)
(muse-file-extension "muse"))
(muse-update-file-extension 'muse-file-extension val))))
;; Once the user's init file has been processed, determine whether
;; they want a file extension
(add-hook 'after-init-hook 'muse-update-file-extension-after-init)
;; URL protocols
(require 'muse-protocols)
;; Helper functions
(defsubst muse-delete-file-if-exists (file)
(when (file-exists-p file)
(delete-file file)
(message "Removed %s" file)))
(defsubst muse-time-less-p (t1 t2)
"Say whether time T1 is less than time T2."
(or (< (car t1) (car t2))
(and (= (car t1) (car t2))
(< (nth 1 t1) (nth 1 t2)))))
(eval-when-compile
(defvar muse-publishing-current-file nil))
(defun muse-current-file ()
"Return the name of the currently visited or published file."
(or (and (boundp 'muse-publishing-current-file)
muse-publishing-current-file)
(buffer-file-name)
(concat default-directory (buffer-name))))
(defun muse-page-name (&optional name)
"Return the canonical form of a Muse page name.
What this means is that the directory part of NAME is removed,
and the file extensions in `muse-ignored-extensions' are also
removed from NAME."
(save-match-data
(unless (and name (not (string= name "")))
(setq name (muse-current-file)))
(if name
(let ((page (file-name-nondirectory name)))
(if (and muse-ignored-extensions-regexp
(string-match muse-ignored-extensions-regexp page))
(replace-match "" t t page)
page)))))
(defun muse-display-warning (message)
"Display the given MESSAGE as a warning."
(if (fboundp 'display-warning)
(display-warning 'muse message
(if (featurep 'xemacs)
'warning
:warning))
(let ((buf (get-buffer-create "*Muse warnings*")))
(with-current-buffer buf
(goto-char (point-max))
(insert "Warning (muse): " message)
(unless (bolp)
(newline)))
(display-buffer buf)
(sit-for 0))))
(defun muse-eval-lisp (form)
"Evaluate the given form and return the result as a string."
(require 'pp)
(save-match-data
(condition-case err
(let ((object (eval (read form))))
(cond
((stringp object) object)
((and (listp object)
(not (eq object nil)))
(let ((string (pp-to-string object)))
(substring string 0 (1- (length string)))))
((numberp object)
(number-to-string object))
((eq object nil) "")
(t
(pp-to-string object))))
(error
(muse-display-warning (format "%s: Error evaluating %s: %s"
(muse-page-name) form err))
"; INVALID LISP CODE"))))
(defmacro muse-with-temp-buffer (&rest body)
"Create a temporary buffer, and evaluate BODY there like `progn'.
See also `with-temp-file' and `with-output-to-string'.
Unlike `with-temp-buffer', this will never attempt to save the
temp buffer. It is meant to be used along with
`insert-file-contents' or `muse-insert-file-contents'.
The undo feature will be disabled in the new buffer.
If `debug-on-error' is set to t, keep the buffer around for
debugging purposes rather than removing it."
(let ((temp-buffer (make-symbol "temp-buffer")))
`(let ((,temp-buffer (generate-new-buffer " *muse-temp*")))
(buffer-disable-undo ,temp-buffer)
(unwind-protect
(if debug-on-error
(with-current-buffer ,temp-buffer
,@body)
(condition-case err
(with-current-buffer ,temp-buffer
,@body)
(error
(if (and (boundp 'muse-batch-publishing-p)
muse-batch-publishing-p)
(progn
(message "%s: Error occured: %s"
(muse-page-name) err)
(backtrace))
(muse-display-warning
(format (concat "An error occurred while publishing"
" %s:\n %s\n\nSet debug-on-error to"
" `t' if you would like a backtrace.")
(muse-page-name) err))))))
(when (buffer-live-p ,temp-buffer)
(with-current-buffer ,temp-buffer
(set-buffer-modified-p nil))
(unless debug-on-error (kill-buffer ,temp-buffer)))))))
(put 'muse-with-temp-buffer 'lisp-indent-function 0)
(put 'muse-with-temp-buffer 'edebug-form-spec '(body))
(defun muse-insert-file-contents (filename &optional visit)
"Insert the contents of file FILENAME after point.
Do character code conversion and end-of-line conversion, but none
of the other unnecessary things like format decoding or
`find-file-hook'.
If VISIT is non-nil, the buffer's visited filename
and last save file modtime are set, and it is marked unmodified.
If visiting and the file does not exist, visiting is completed
before the error is signaled."
(let ((format-alist nil)
(after-insert-file-functions nil)
(inhibit-file-name-handlers
(append '(jka-compr-handler image-file-handler epa-file-handler)
inhibit-file-name-handlers))
(inhibit-file-name-operation 'insert-file-contents))
(insert-file-contents filename visit)))
(defun muse-write-file (filename &optional nomessage)
"Write current buffer into file FILENAME.
Unlike `write-file', this does not visit the file, try to back it
up, or interact with vc.el in any way.
If the file was not written successfully, return nil. Otherwise,
return non-nil.
If the NOMESSAGE argument is non-nil, suppress the \"Wrote file\"
message."
(when nomessage (setq nomessage 'nomessage))
(let ((backup-inhibited t)
(buffer-file-name filename)
(buffer-file-truename (file-truename filename)))
(save-current-buffer
(save-restriction
(widen)
(if (not (file-writable-p buffer-file-name))
(prog1 nil
(muse-display-warning
(format "Cannot write file %s:\n %s" buffer-file-name
(let ((dir (file-name-directory buffer-file-name)))
(if (not (file-directory-p dir))
(if (file-exists-p dir)
(format "%s is not a directory" dir)
(format "No directory named %s exists" dir))
(if (not (file-exists-p buffer-file-name))
(format "Directory %s write-protected" dir)
"File is write-protected"))))))
(let ((coding-system-for-write
(or (and (boundp 'save-buffer-coding-system)
save-buffer-coding-system)
coding-system-for-write)))
(write-region (point-min) (point-max) buffer-file-name
nil nomessage))
(when (boundp 'last-file-coding-system-used)
(when (boundp 'buffer-file-coding-system-explicit)
(setq buffer-file-coding-system-explicit
last-coding-system-used))
(if save-buffer-coding-system
(setq save-buffer-coding-system last-coding-system-used)
(setq buffer-file-coding-system last-coding-system-used)))
t)))))
(defun muse-collect-alist (list element &optional test)
"Collect items from LIST whose car is equal to ELEMENT.
If TEST is specified, use it to compare ELEMENT."
(unless test (setq test 'equal))
(let ((items nil))
(dolist (item list)
(when (funcall test element (car item))
(setq items (cons item items))))
items))
(defmacro muse-sort-with-closure (list predicate closure)
"Sort LIST, stably, comparing elements using PREDICATE.
Returns the sorted list. LIST is modified by side effects.
PREDICATE is called with two elements of list and CLOSURE.
PREDICATE should return non-nil if the first element should sort
before the second."
`(sort ,list (lambda (a b) (funcall ,predicate a b ,closure))))
(put 'muse-sort-with-closure 'lisp-indent-function 0)
(put 'muse-sort-with-closure 'edebug-form-spec '(form function-form form))
(defun muse-sort-by-rating (rated-list &optional test)
"Sort RATED-LIST according to the rating of each element.
The rating is stripped out in the returned list.
Default sorting is highest-first.
If TEST if specified, use it to sort the list. The default test is '>."
(unless test (setq test '>))
(mapcar (function cdr)
(muse-sort-with-closure
rated-list
(lambda (a b closure)
(let ((na (numberp (car a)))
(nb (numberp (car b))))
(cond ((and na nb) (funcall closure (car a) (car b)))
(na (not nb))
(t nil))))
test)))
(defun muse-escape-specials-in-string (specials string &optional reverse)
"Apply the transformations in SPECIALS to STRING.
The transforms should form a fully reversible and non-ambiguous
syntax when STRING is parsed from left to right.
If REVERSE is specified, reverse an already-escaped string."
(let ((rules (mapcar (lambda (rule)
(cons (regexp-quote (if reverse
(cdr rule)
(car rule)))
(if reverse (car rule) (cdr rule))))
specials)))
(save-match-data
(with-temp-buffer
(insert string)
(goto-char (point-min))
(while (not (eobp))
(unless (catch 'found
(dolist (rule rules)
(when (looking-at (car rule))
(replace-match (cdr rule) t t)
(throw 'found t))))
(forward-char)))
(buffer-string)))))
(defun muse-trim-whitespace (string)
"Return a version of STRING with no initial nor trailing whitespace."
(muse-replace-regexp-in-string
(concat "\\`[" muse-regexp-blank "]+\\|[" muse-regexp-blank "]+\\'")
"" string))
(defun muse-path-sans-extension (path)
"Return PATH sans final \"extension\".
The extension, in a file name, is the part that follows the last `.',
except that a leading `.', if any, doesn't count.
This differs from `file-name-sans-extension' in that it will
never modify the directory part of the path."
(concat (file-name-directory path)
(file-name-nondirectory (file-name-sans-extension path))))
;; The following code was extracted from cl
(defun muse-const-expr-p (x)
(cond ((consp x)
(or (eq (car x) 'quote)
(and (memq (car x) '(function function*))
(or (symbolp (nth 1 x))
(and (eq (and (consp (nth 1 x))
(car (nth 1 x))) 'lambda) 'func)))))
((symbolp x) (and (memq x '(nil t)) t))
(t t)))
(put 'muse-assertion-failed 'error-conditions '(error))
(put 'muse-assertion-failed 'error-message "Assertion failed")
(defun muse-list* (arg &rest rest)
"Return a new list with specified args as elements, cons'd to last arg.
Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
`(cons A (cons B (cons C D)))'."
(cond ((not rest) arg)
((not (cdr rest)) (cons arg (car rest)))
(t (let* ((n (length rest))
(copy (copy-sequence rest))
(last (nthcdr (- n 2) copy)))
(setcdr last (car (cdr last)))
(cons arg copy)))))
(defmacro muse-assert (form &optional show-args string &rest args)
"Verify that FORM returns non-nil; signal an error if not.
Second arg SHOW-ARGS means to include arguments of FORM in message.
Other args STRING and ARGS... are arguments to be passed to `error'.
They are not evaluated unless the assertion fails. If STRING is
omitted, a default message listing FORM itself is used."
(let ((sargs
(and show-args
(delq nil (mapcar
(function
(lambda (x)
(and (not (muse-const-expr-p x)) x)))
(cdr form))))))
(list 'progn
(list 'or form
(if string
(muse-list* 'error string (append sargs args))
(list 'signal '(quote muse-assertion-failed)
(muse-list* 'list (list 'quote form) sargs))))
nil)))
;; Compatibility functions
(if (fboundp 'looking-back)
(defalias 'muse-looking-back 'looking-back)
(defun muse-looking-back (regexp &optional limit &rest ignored)
(save-excursion
(re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
(eval-and-compile
(if (fboundp 'line-end-position)
(defalias 'muse-line-end-position 'line-end-position)
(defun muse-line-end-position (&optional n)
(save-excursion (end-of-line n) (point))))
(if (fboundp 'line-beginning-position)
(defalias 'muse-line-beginning-position 'line-beginning-position)
(defun muse-line-beginning-position (&optional n)
(save-excursion (beginning-of-line n) (point))))
(if (fboundp 'match-string-no-properties)
(defalias 'muse-match-string-no-properties 'match-string-no-properties)
(defun muse-match-string-no-properties (num &optional string)
(match-string num string))))
(defun muse-replace-regexp-in-string (regexp replacement text &optional fixedcase literal)
"Replace REGEXP with REPLACEMENT in TEXT.
Return a new string containing the replacements.
If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
(cond
((and (featurep 'xemacs) (fboundp 'replace-in-string))
(and (fboundp 'replace-in-string) ; stupid byte-compiler warning
(replace-in-string text regexp replacement literal)))
((fboundp 'replace-regexp-in-string)
(replace-regexp-in-string regexp replacement text fixedcase literal))
(t (error (concat "Neither `replace-in-string' nor "
"`replace-regexp-in-string' was found")))))
(if (fboundp 'add-to-invisibility-spec)
(defalias 'muse-add-to-invisibility-spec 'add-to-invisibility-spec)
(defun muse-add-to-invisibility-spec (element)
"Add ELEMENT to `buffer-invisibility-spec'.
See documentation for `buffer-invisibility-spec' for the kind of elements
that can be added."
(if (eq buffer-invisibility-spec t)
(setq buffer-invisibility-spec (list t)))
(setq buffer-invisibility-spec
(cons element buffer-invisibility-spec))))
(if (fboundp 'read-directory-name)
(defalias 'muse-read-directory-name 'read-directory-name)
(defun muse-read-directory-name (prompt &optional dir default-dirname mustmatch initial)
"Read directory name - see `read-file-name' for details."
(unless dir
(setq dir default-directory))
(read-file-name prompt dir (or default-dirname
(if initial (expand-file-name initial dir)
dir))
mustmatch initial)))
(defun muse-file-remote-p (file)
"Test whether FILE specifies a location on a remote system.
Return non-nil if the location is indeed remote.
For example, the filename \"/user@host:/foo\" specifies a location
on the system \"/user@host:\"."
(cond ((fboundp 'file-remote-p)
(file-remote-p file))
((fboundp 'tramp-handle-file-remote-p)
(tramp-handle-file-remote-p file))
((and (boundp 'ange-ftp-name-format)
(string-match (car ange-ftp-name-format) file))
t)
(t nil)))
(if (fboundp 'delete-and-extract-region)
(defalias 'muse-delete-and-extract-region 'delete-and-extract-region)
(defun muse-delete-and-extract-region (start end)
"Delete the text between START and END and return it."
(prog1 (buffer-substring start end)
(delete-region start end))))
(if (fboundp 'delete-dups)
(defalias 'muse-delete-dups 'delete-dups)
(defun muse-delete-dups (list)
"Destructively remove `equal' duplicates from LIST.
Store the result in LIST and return it. LIST must be a proper list.
Of several `equal' occurrences of an element in LIST, the first
one is kept."
(let ((tail list))
(while tail
(setcdr tail (delete (car tail) (cdr tail)))
(setq tail (cdr tail))))
list))
;; Set face globally in a predictable fashion
(defun muse-copy-face (old new)
"Copy face OLD to NEW."
(if (featurep 'xemacs)
(copy-face old new 'all)
(copy-face old new)))
;; Widget compatibility functions
(defun muse-widget-type-value-create (widget)
"Convert and instantiate the value of the :type attribute of WIDGET.
Store the newly created widget in the :children attribute.
The value of the :type attribute should be an unconverted widget type."
(let ((value (widget-get widget :value))
(type (widget-get widget :type)))
(widget-put widget :children
(list (widget-create-child-value widget
(widget-convert type)
value)))))
(defun muse-widget-child-value-get (widget)
"Get the value of the first member of :children in WIDGET."
(widget-value (car (widget-get widget :children))))
(defun muse-widget-type-match (widget value)
"Non-nil if the :type value of WIDGET matches VALUE.
The value of the :type attribute should be an unconverted widget type."
(widget-apply (widget-convert (widget-get widget :type)) :match value))
;; Link-handling functions and variables
(defun muse-get-link (&optional target)
"Based on the match data, retrieve the link.
Use TARGET to get the string, if it is specified."
(muse-match-string-no-properties 1 target))
(defun muse-get-link-desc (&optional target)
"Based on the match data, retrieve the link description.
Use TARGET to get the string, if it is specified."
(muse-match-string-no-properties 2 target))
(defvar muse-link-specials
'(("[" . "%5B")
("]" . "%5D")
("%" . "%%"))
"Syntax used for escaping and unescaping links.
This allows brackets to occur in explicit links as long as you
use the standard Muse functions to create them.")
(defun muse-link-escape (text)
"Escape characters in TEXT that conflict with the explicit link
regexp."
(when (stringp text)
(muse-escape-specials-in-string muse-link-specials text)))
(defun muse-link-unescape (text)
"Un-escape characters in TEXT that conflict with the explicit
link regexp."
(when (stringp text)
(muse-escape-specials-in-string muse-link-specials text t)))
(defun muse-handle-url (&optional string)
"If STRING or point has a URL, match and return it."
(if (if string (string-match muse-url-regexp string)
(looking-at muse-url-regexp))
(match-string 0 string)))
(defcustom muse-implicit-link-functions '(muse-handle-url)
"A list of functions to handle an implicit link.
An implicit link is one that is not surrounded by brackets.
By default, Muse handles URLs only.
If you want to handle WikiWords, load muse-wiki.el."
:type 'hook
:options '(muse-handle-url)
:group 'muse)
(defun muse-handle-implicit-link (&optional link)
"Handle implicit links. If LINK is not specified, look at point.
An implicit link is one that is not surrounded by brackets.
By default, Muse handles URLs only.
If you want to handle WikiWords, load muse-wiki.el.
This function modifies the match data so that match 0 is the
link.
The match data is restored after each unsuccessful handler
function call. If LINK is specified, only restore at very end.
This behavior is needed because the part of the buffer that
`muse-implicit-link-regexp' matches must be narrowed to the part
that is an accepted link."
(let ((funcs muse-implicit-link-functions)
(res nil)
(data (match-data t)))
(while funcs
(setq res (funcall (car funcs) link))
(if res
(setq funcs nil)
(unless link (set-match-data data))
(setq funcs (cdr funcs))))
(when link (set-match-data data))
res))
(defcustom muse-explicit-link-functions nil
"A list of functions to handle an explicit link.
An explicit link is one [[like][this]] or [[this]]."
:type 'hook
:group 'muse)
(defun muse-handle-explicit-link (&optional link)
"Handle explicit links. If LINK is not specified, look at point.
An explicit link is one that looks [[like][this]] or [[this]].
The match data is preserved. If no handlers are able to process
LINK, return LINK (if specified) or the 1st match string. If
LINK is not specified, it is assumed that Muse has matched
against `muse-explicit-link-regexp' before calling this
function."
(let ((funcs muse-explicit-link-functions)
(res nil))
(save-match-data
(while funcs
(setq res (funcall (car funcs) link))
(if res
(setq funcs nil)
(setq funcs (cdr funcs)))))
(muse-link-unescape
(if res
res
(or link (muse-get-link))))))
;; Movement functions
(defun muse-list-item-type (str)
"Determine the type of list given STR.
Returns either 'ul, 'ol, 'dl-term, 'dl-entry, or nil."
(save-match-data
(cond ((or (string= str "")
(< (length str) 2))
nil)
((string-match muse-dl-entry-regexp str)
'dl-entry)
((string-match muse-dl-term-regexp str)
'dl-term)
((string-match muse-ol-item-regexp str)
'ol)
((string-match muse-ul-item-regexp str)
'ul)
(t nil))))
(defun muse-list-item-critical-point (&optional offset)
"Figure out where the important markup character for the
currently-matched list item is.
If OFFSET is specified, it is the number of groupings outside of
the contents of `muse-list-item-regexp'."
(unless offset (setq offset 0))
(if (match-end (+ offset 2))
;; at a definition list
(match-end (+ offset 2))
;; at a different kind of list
(match-beginning (+ offset 1))))
(defun muse-forward-paragraph (&optional pattern)
"Move forward safely by one paragraph, or according to PATTERN."
(when (get-text-property (point) 'muse-end-list)
(goto-char (next-single-property-change (point) 'muse-end-list)))
(setq pattern (if pattern
(concat "^\\(?:" pattern "\\|\n\\|\\'\\)")
"^\\s-*\\(\n\\|\\'\\)"))
(let ((next-list-end (or (next-single-property-change (point) 'muse-end-list)
(point-max))))
(forward-line 1)
(if (re-search-forward pattern nil t)
(goto-char (match-beginning 0))
(goto-char (point-max)))
(when (> (point) next-list-end)
(goto-char next-list-end))))
(defun muse-forward-list-item-1 (type empty-line indented-line)
"Determine whether a nested list item is after point."
(if (match-beginning 1)
;; if we are given a dl entry, skip past everything on the same
;; level, except for other dl entries
(and (eq type 'dl-entry)
(not (eq (char-after (match-beginning 2)) ?\:)))
;; blank line encountered with no list item on the same
;; level after it
(let ((beg (point)))
(forward-line 1)
(if (save-match-data
(and (looking-at indented-line)
(not (looking-at empty-line))))
;; found that this blank line is followed by some
;; indentation, plus other text, so we'll keep
;; going
t
(goto-char beg)
nil))))
(defun muse-forward-list-item (type indent &optional no-skip-nested)
"Move forward to the next item of TYPE.
Return non-nil if successful, nil otherwise.
The beginning indentation is given by INDENT.
If NO-SKIP-NESTED is non-nil, do not skip past nested items.
Note that if you desire this behavior, you will also need to
provide a very liberal INDENT value, such as
\(concat \"[\" muse-regexp-blank \"]*\")."
(let* ((list-item (format muse-list-item-regexp indent))
(empty-line (concat "^[" muse-regexp-blank "]*\n"))
(indented-line (concat "^" indent "[" muse-regexp-blank "]"))
(list-pattern (concat "\\(?:" empty-line "\\)?"
"\\(" list-item "\\)")))
(while (progn
(muse-forward-paragraph list-pattern)
;; make sure we don't go past boundary
(and (not (or (get-text-property (point) 'muse-end-list)
(>= (point) (point-max))))
;; move past markup that is part of another construct
(or (and (match-beginning 1)
(or (get-text-property
(muse-list-item-critical-point 1) 'muse-link)
(and (derived-mode-p 'muse-mode)
(get-text-property
(muse-list-item-critical-point 1)
'face))))
;; skip nested items
(and (not no-skip-nested)
(muse-forward-list-item-1 type empty-line
indented-line))))))
(cond ((or (get-text-property (point) 'muse-end-list)
(>= (point) (point-max)))
;; at a list boundary, so stop
nil)
((let ((str (when (match-beginning 2)
;; get the entire line
(save-excursion
(goto-char (match-beginning 2))
(buffer-substring (muse-line-beginning-position)
(muse-line-end-position))))))
(and str (eq type (muse-list-item-type str))))
;; same type, so indicate that there are more items to be
;; parsed
(goto-char (match-beginning 1)))
(t
(when (match-beginning 1)
(goto-char (match-beginning 1)))
;; move to just before foreign list item markup
nil))))
(defun muse-goto-tag-end (tag nested)
"Move forward past the end of TAG.
If NESTED is non-nil, look for other instances of this tag that
may be nested inside of this tag, and skip past them."
(if (not nested)
(search-forward (concat "</" tag ">") nil t)
(let ((nesting 1)
(tag-regexp (concat "\\(<\\(/?\\)" tag "\\([ >]\\)\\)"))
(match-found nil))
(while (and (> nesting 0)
(setq match-found (re-search-forward tag-regexp nil t)))
;; for the sake of font-locking code, skip matches in comments
(unless (get-text-property (match-beginning 0) 'muse-comment)
(if (string-equal (match-string 2) "/")
(and (string-equal (match-string 3) ">")
(setq nesting (1- nesting)))
(setq nesting (1+ nesting)))))
match-found)))
;;; muse.el ends here