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