diff options
Diffstat (limited to 'emacs.d/elisp/muse/muse.el')
| -rw-r--r-- | emacs.d/elisp/muse/muse.el | 881 |
1 files changed, 881 insertions, 0 deletions
diff --git a/emacs.d/elisp/muse/muse.el b/emacs.d/elisp/muse/muse.el new file mode 100644 index 0000000..4d4a0b9 --- /dev/null +++ b/emacs.d/elisp/muse/muse.el @@ -0,0 +1,881 @@ +;;; 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 |