+++ /dev/null
-;;; 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