From: Stefan Bund Date: Fri, 9 Dec 2011 09:40:50 +0000 (+0100) Subject: added textile-mode and mmm-mode. xpath stuff X-Git-Url: http://g0dil.de/git?p=emacs-init.git;a=commitdiff_plain;h=c79022f0450cd093c456a42b8473686e3b523db7 added textile-mode and mmm-mode. xpath stuff --- diff --git a/.emacs b/.emacs new file mode 100644 index 0000000..4b30749 --- /dev/null +++ b/.emacs @@ -0,0 +1,64 @@ +(add-to-list 'load-path "~/.emacs.d") +(add-to-list 'load-path "~/.emacs.d/auto-install") + +(require 'load-dir) +(load-dir "~/.emacs.d/setup") + +(custom-set-variables + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(auto-install-install-confirm nil) + '(auto-install-replace-confirm nil) + '(auto-install-save-confirm nil) + '(auto-save-file-name-transforms (quote (("\\`.*\\([^/]*\\)\\'" "~/.emacs.d/autosave/\\1" t)))) + '(backup-directory-alist (quote (("." . "~/.emacs.d/backups")))) + '(c-backslash-column 99) + '(c-basic-offset 4) + '(column-number-mode t) + '(comment-column 60) + '(comment-fill-column 160) + '(csv-align-padding 0) + '(csv-comment-start-default "#") + '(csv-field-quotes nil) + '(csv-header-lines 0) + '(csv-separators (quote ("|"))) + '(debug-on-error nil) + '(default-input-method "latin-1-prefix") + '(fill-column 98) + '(flyspell-delay 10) + '(global-auto-revert-mode nil) + '(global-subword-mode t) + '(global-visual-line-mode t) + '(global-whitespace-mode nil) + '(ido-mode (quote both) nil (ido)) + '(ispell-extra-args (quote ("--sug-mode=ultra"))) + '(ispell-program-name "c:/cygwin/bin/aspell.exe") + '(ls-lisp-dirs-first t) + '(nxml-where-global-mode t) + '(nxml-where-header nil) + '(pop-up-windows nil) + '(save-place t nil (saveplace)) + '(server-done-hook (quote (delete-frame))) + '(server-mode t) + '(server-temp-file-regexp "^/tmp/Re\\|/draft\\|.*/itsalltext/.*$") + '(server-window (quote switch-to-buffer-other-frame)) + '(show-paren-mode t) + '(tab-width 4) + '(tags-case-fold-search nil) + '(tool-bar-mode nil) + '(uniquify-buffer-name-style (quote forward) nil (uniquify)) + '(visual-line-fringe-indicators (quote (left-curly-arrow right-curly-arrow))) + '(which-function-mode t)) +(custom-set-faces + ;; custom-set-faces was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(default ((t (:inherit nil :stipple nil :background "SystemWindow" :foreground "SystemWindowText" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 90 :width normal :foundry "outline" :family "Courier New")))) + '(textile-acronym-face ((t (:foreground "medium blue")))) + '(textile-blockquote-face ((t (:foreground "midnight blue")))) + '(textile-code-face ((t (:foreground "firebrick4")))) + '(textile-pre-face ((t (:foreground "dark green"))))) +(put 'narrow-to-region 'disabled nil) diff --git a/.gitignore b/.gitignore index a5a290b..83cadb3 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,5 @@ backups/ auto-save-list/ eshell/ *.elc +server + diff --git a/auto-install/dom.el b/auto-install/dom.el new file mode 100644 index 0000000..d7106ba --- /dev/null +++ b/auto-install/dom.el @@ -0,0 +1,1113 @@ +;;; dom.el --- DOM implementation + +;; Copyright (C) 2001 Alex Schroeder + +;; Author: Alex Schroeder +;; Henrik.Motakef +;; Maintainer: Henrik.Motakef +;; Version: 1.0.1 +;; Keywords: xml +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?XmlParser +;; Version: $Id: dom.el,v 1.1 2002/08/14 20:22:21 henrik Exp henrik $ + +;; This file is not part of GNU Emacs. + +;; This 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 2, or (at your option) any later +;; version. + +;; This 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; If you are working with XML documents, the parsed data structure +;; returned by the XML parser (xml.el) may be enough for you: Lists of +;; lists, symbols, strings, plus a number of accessor functions. +;; +;; If you want a more elaborate data structure to work with your XML +;; document, you can create a document object model (DOM) from the XML +;; data structure using dom.el. +;; +;; You can create a DOM from XML using `dom-make-document-from-xml'. +;; Note that `xml-parse-file' will return a list of top level elements +;; found in the file, so you must choose one element in that list. +;; Here's an example: +;; +;; (setq doc (dom-make-document-from-xml (car (xml-parse-file "sample.xml")))) +;; +;; Note that this DOM implementation uses the attributes and tag names +;; used by the XML parser. If the XML parser uses symbols instead of +;; string (like xml.el does), then dom.el will also use symbols. If the +;; XML parsers uses strings (like xml-parse.el does), then dom.el will +;; use strings. +;; +;; It should be trivial to write functions analogous to the +;; dom-*-from-xml functions in order to use an another XML parsers (from +;; psgml.el, for example). + +;;; On Interfaces and Classes + +;; The elisp DOM implementation uses the dom-node structure to store all +;; attributes. The various interfaces consist of sets of functions to +;; manipulate these dom-nodes. The functions of a certain interface +;; share the same prefix. + +;;; Test: + +;; The test code assumes a file named sample.xml with the following +;; content: + +;; +;; +;; +;; My own book! +;; First +;; +;; +;; John +;; Wiegley +;; +;; +;; +;; +;; +;; A very small chapter +;; Wonder where the content is... +;; +;; + +;;; Code: + +(require 'cl) +(require 'xml) + +;;; Exception DOMException + +;; DOM operations only raise exceptions in "exceptional" circumstances, +;; i.e., when an operation is impossible to perform (either for logical +;; reasons, because data is lost, or because the implementation has +;; become unstable). In general, DOM methods return specific error +;; values in ordinary processing situations, such as out-of-bound errors +;; when using NodeList. + +;; Implementations should raise other exceptions under other +;; circumstances. For example, implementations should raise an +;; implementation-dependent exception if a null argument is passed. + +;; Some languages and object systems do not support the concept of +;; exceptions. For such systems, error conditions may be indicated using +;; native error reporting mechanisms. For some bindings, for example, +;; methods may return error codes similar to those listed in the +;; corresponding method descriptions. + +(let ((errors + ;; Note that the numeric code is not used at the moment. + '((dom-hierarchy-request-err 3 + "Node doesn't belong here") + (dom-wrong-document-err 4 + "Node is used in a different document than the one that created it") + (dom-not-found-err 8 + "A reference to a node was made in a context where it does not exist")))) + (dolist (err errors) + (put (nth 0 err) + 'error-conditions + (list 'error 'dom-exception (nth 0 err))) + (put (nth 0 err) + 'error-message + (nth 2 err)))) + +(defun dom-exception (exception &rest data) + "Signal error EXCEPTION, possibly providing DATA. +The error signaled has the condition 'dom-exception in addition +to the catch-all 'error and EXCEPTION itself." + ;; FIXME: Redefine this to do something else? + (signal exception data)) + +;;; Interface Document + +;; The Document interface represents the entire HTML or XML document. +;; Conceptually, it is the root of the document tree, and provides the +;; primary access to the document's data. + +;; Since elements, text nodes, comments, processing instructions, etc. +;; cannot exist outside the context of a Document, the Document interface +;; also contains the factory methods needed to create these objects. The +;; Node objects created have a ownerDocument attribute which associates +;; them with the Document within whose context they were created. + +;; createAttribute + +;; Creates an Attr of the given name. Note that the Attr instance can +;; then be set on an Element using the setAttributeNode method. + +(defun dom-document-create-attribute (doc name) + "Create an attribute of the given NAME. +DOC is the owner-document." + (when (stringp name) + (setq name (intern name))) + (make-dom-attr + :name name + :type dom-attribute-node + :owner-document doc)) + +;; createElement + +;; Creates an element of the type specified. Note that the instance +;; returned implements the Element interface, so attributes can be +;; specified directly on the returned object. + +;; FIXME: In addition, if there are known attributes with default +;; values, Attr nodes representing them are automatically created and +;; attached to the element. (not implemented) + +(defun dom-document-create-element (doc type) + "Create an element of the given TYPE. +TYPE will be interned, if it is a string. +DOC is the owner-document." + (when (stringp type) + (setq type (intern type))) + (make-dom-element + :name type + :type dom-element-node + :owner-document doc)) + +;; createTextNode + +;; Creates a Text node given the specified string. + +(defun dom-document-create-text-node (doc data) + "Create an element of the type specified by the tag NAME. +DOC is the owner-document." + (make-dom-text + :name dom-text-node-name + :value data + :type dom-text-node + :owner-document doc)) + +;; getElementsByTagName + +;; Returns a NodeList of all the Elements with a given tag name in the +;; order in which they are encountered in a preorder traversal of the +;; Document tree. + +(defun dom-document-get-elements-by-tag-name (doc tagname) + "Return a list of all the elements with the given tagname. +The elements are returned in the order in which they are encountered in +a preorder traversal of the document tree. The special value \"*\" +matches all tags." + (dom-element-get-elements-by-tag-name-1 + (dom-document-element doc) + tagname)) + +;;; Interface Node + +;; The Node interface is the primary datatype for the entire Document +;; Object Model. It represents a single node in the document tree. While +;; all objects implementing the Node interface expose methods for dealing +;; with children, not all objects implementing the Node interface may have +;; children. For example, Text nodes may not have children, and adding +;; children to such nodes results in a DOMException being raised. + +;; The attributes name, value and attributes are included as a mechanism +;; to get at node information without casting down to the specific +;; derived interface. In cases where there is no obvious mapping of +;; these attributes for a specific type (e.g., value for an Element or +;; attributes for a Comment), this returns null. Note that the +;; specialized interfaces may contain additional and more convenient +;; mechanisms to get and set the relevant information. + +;; FIXME: Use symbols instead of numbers? +(defconst dom-element-node 1) +(defconst dom-attribute-node 2) +(defconst dom-text-node 3) +; (defconst dom-cdata-section-node 4) +; (defconst dom-entity-reference-node 5) +; (defconst dom-entity-node 6) +; (defconst dom-processing-instruction-node 7) +; (defconst dom-comment-node 8) +(defconst dom-document-node 9) +; (defconst dom-document-type-node 10) +; (defconst dom-document-fragment-node 11) +; (defconst dom-notation-node 12) + +;; Default names used for Text and Document nodes. + +(defconst dom-text-node-name '\#text) +(defconst dom-document-node-name '\#document) + +;; readonly attribute DOMString nodeName; +;; attribute DOMString nodeValue; +;; readonly attribute unsigned short nodeType; +;; readonly attribute Node parentNode; +;; readonly attribute NodeList childNodes; +;; readonly attribute Node firstChild; +;; readonly attribute Node lastChild; +;; readonly attribute Node previousSibling; +;; readonly attribute Node nextSibling; +;; readonly attribute NamedNodeMap attributes; +;; readonly attribute Document ownerDocument; + +(defstruct dom-node + (name nil :read-only t) + value + (type nil :read-only t) + parent-node + child-nodes + attributes + owner-document) + +(defstruct (dom-document (:include dom-node)) + element) + +(defstruct (dom-element (:include dom-node))) + +(defstruct (dom-attr (:include dom-node)) + owner-element + specified) + +(defstruct (dom-character-data (:include dom-node))) + +(defstruct (dom-text (:include dom-character-data))) + +;; All functions defined for nodes are defined for documents and +;; elements as well. Use `dom-node-defun' to define aliases. + +(defun dom-node-defun (func) + "Define aliases for symbol FUNC. +FUNC must have the form dom-node-foo. The aliases created will be named +dom-document-foo, dom-element-foo, and dom-attr-foo." + (if (and (fboundp func) + (string-match "^dom-node-" (symbol-name func))) + (let ((method (substring (symbol-name func) 9))) + (mapc (lambda (prefix) + (defalias + (intern (concat prefix method)) func)) + '("dom-document-" "dom-element-" "dom-attr-"))) + (error "%S is not a dom function" func))) + +;; The followin functions implement the virtual attributes firstChild, +;; lastChild, previousSibling and nextSibling. + +(defun dom-node-first-child (node) + (car (dom-node-child-nodes node))) +(dom-node-defun 'dom-node-first-child) + +(defun dom-node-last-child (node) + (car (last (dom-node-child-nodes node)))) +(dom-node-defun 'dom-node-last-child) + +(defun dom-node-previous-sibling (node) + (let ((parent (dom-node-parent-node node))) + (when parent + (let ((list (dom-node-child-nodes parent)) + prev + done) + (while (and (not done) list) + (if (eq (car list) node) + (setq done t) + (setq prev (car list) + list (cdr list)))) + prev)))) +(dom-node-defun 'dom-node-previous-sibling) + +(defun dom-node-next-sibling (node) + (let ((parent (dom-node-parent-node node))) + (when parent + (nth 1 (memq node (dom-node-child-nodes parent)))))) +(dom-node-defun 'dom-node-next-sibling) + +;; appendChild + +;; Adds the node newChild to the end of the list of children of +;; this node. If the newChild is already in the tree, it is +;; first removed. + +;; FIXME: newChild of type Node: The node to add. If it is a DocumentFragment +;; object, the entire contents of the document fragment are moved into +;; the child list of this node + +(defun dom-node-append-child (node new-child) + "Adds NEW-CHILD to the end of the list of children of NODE. +If NEW-CHILD is already in the document tree, it is first removed. +NEW-CHILD will be removed from anywhere in the document! +Return the node added." + (dom-node-test-new-child node new-child) + (dom-node-unlink-child-from-parent new-child) + ;; add new-child at the end of the list + (let ((children (dom-node-child-nodes node))) + (setf (dom-node-child-nodes node) (nconc children (list new-child)))) + (setf (dom-node-parent-node new-child) node) + new-child) +(dom-node-defun 'dom-node-append-child) + +;; cloneNode + +;; Returns a duplicate of this node, i.e., serves as a generic copy +;; constructor for nodes. The duplicate node has no parent; (parentNode +;; is null.). + +;; FIXME: Cloning an Element copies all attributes and their values, +;; including those generated by the XML processor to represent defaulted +;; attributes, but this method does not copy any text it contains unless +;; it is a deep clone, since the text is contained in a child Text +;; node. Cloning an Attribute directly, as opposed to be cloned as part +;; of an Element cloning operation, returns a specified attribute +;; (specified is true). Cloning any other type of node simply returns a +;; copy of this node. (the attribute specified is not implemented) + +;; FIXME: Note that cloning an immutable subtree results in a mutable +;; copy, but the children of an EntityReference clone are readonly. In +;; addition, clones of unspecified Attr nodes are specified. And, +;; cloning Document, DocumentType, Entity, and Notation nodes is +;; implementation dependent. (immutable subtrees not implemented) + +;; FIXME: The specification says nothing about nextSibling and +;; previousSibling. We set these to nil as well, matching parentNode. + +(defun dom-node-clone-node (node &optional deep) + "Return a duplicate of NODE. +The duplicate node has no parent. Cloning will copy all attributes and +their values, but this method does not copy any text it contains unless +it is a DEEP clone, since the text is contained in a child text node. + +When the optional argument DEEP is non-nil, this recursively clones the +subtree under the specified node; if false, clone only the node itself +\(and its attributes, if it has any)." + ;; We don't want to call this recursively because of performance. + (let* ((first-copy (copy-dom-node node)) + (copy first-copy) + stack) + ;; unlink neighbours of the first copy + (setf (dom-node-parent-node first-copy) nil) + (while copy + ;; prevent sharing of text in text nodes + (let ((value (dom-node-value copy))) + (when (and value (sequencep value)) + (setf (dom-node-value copy) (copy-sequence value)))) + ;; copy attributes, and prevent sharing of text in attribute nodes + (let ((attributes (mapcar 'copy-dom-node (dom-node-attributes copy)))) + (mapc (lambda (attr) + (let ((value (dom-node-value attr))) + (when (and value (sequencep value)) + (setf (dom-node-value attr) (copy-sequence value))))) + attributes) + (setf (dom-node-attributes copy) attributes)) + (if (not deep) + ;; if this is not a deep copy, we are done + (setq copy nil) + ;; first clone all children + (let ((children (mapcar 'copy-dom-node (dom-node-child-nodes copy))) + (parent copy)) + (when children + ;; set the children info for the parent + (setf (dom-node-child-nodes parent) children) + ;; set parent for all children + (mapc (lambda (child) + (setf (dom-node-parent-node child) parent)) + children))) + ;; move to the next copy, depth first, storing missed branches + ;; on the stack -- note that "node" continues to refer to the + ;; original node, it should not be used within the while copy + ;; loop! + (setq copy + (cond ((dom-element-first-child copy) + (when (dom-element-next-sibling copy) + (push (dom-element-next-sibling copy) stack)) + (dom-element-first-child copy)) + ((dom-element-next-sibling copy)) + (t (pop stack)))))) + first-copy)) +(dom-node-defun 'dom-node-clone-node) + +;; hasAttributes introduced in DOM Level 2 + +;; Returns whether this node (if it is an element) has any +;; attributes. + +(defun dom-node-has-attributes (node) + "Return t when NODE has any attributes." + (not (null (dom-node-attributes node)))) +(dom-node-defun 'dom-node-has-attributes) + +;; hasChildNodes + +;; Returns whether this node has any children. + +(defun dom-node-has-child-nodes (node) + "Return t when NODE has any child nodes." + (not (null (dom-node-child-nodes node)))) +(dom-node-defun 'dom-node-has-child-nodes) + +;; insertBefore + +;; Inserts the node newChild before the existing child node refChild. If +;; refChild is null, insert newChild at the end of the list of children. + +;; FIXME: If newChild is a DocumentFragment object, all of its children +;; are inserted, in the same order, before refChild. If the newChild is +;; already in the tree, it is first removed. + +(defun dom-node-insert-before (node new-child &optional ref-child) + "Insert NEW-CHILD before NODE's existing child REF-CHILD. +If optional argument REF-CHILD is nil or not given, insert NEW-CHILD at +the end of the list of NODE's children. +If NEW-CHILD is already in the document tree, it is first removed. +NEW-CHILD will be removed from anywhere in the document! +Return the node added." + ;; without ref-child, append it at the end of the list + (if (not ref-child) + (dom-node-append-child node new-child) + (dom-node-test-new-child node new-child) + (dom-node-unlink-child-from-parent new-child) + ;; find the correct position and insert new-child + (let ((children (dom-node-child-nodes node)) + child-cell done) + (while (and (not done) children) + (if (eq ref-child (car children)) + (progn + ;; if the first child is ref-child, set the list anew + (if (not child-cell) + (setf (dom-node-child-nodes node) + (cons new-child children)) + ;; else splice new-child into the list + (setcdr child-cell (cons new-child children))) + (setq done t)) + ;; if we didn't find it, advance + (setq child-cell children + children (cdr children)))) + (unless done + (dom-exception 'dom-not-found-err))) + new-child)) +(dom-node-defun 'dom-node-insert-before) + +;; removeChild + +;; Removes the child node indicated by oldChild from the list of +;; children, and returns it. + +(defun dom-node-remove-child (node old-child) + "Remove OLD-CHILD from the list of NODE's children and return it. +This is very similar to `dom-node-unlink-child-from-parent' but it will +raise an exception if OLD-CHILD is NODE's child." + (let ((children (dom-node-child-nodes node))) + (if (memq old-child children) + (setf (dom-node-child-nodes node) (delq old-child children) + (dom-node-parent-node old-child) nil) + (dom-exception 'dom-not-found-err)) + old-child)) +(dom-node-defun 'dom-node-remove-child) + +;; replaceChild + +;; Replaces the child node oldChild with newChild in the list of +;; children, and returns the oldChild node. + +;; FIXME: If newChild is a DocumentFragment object, oldChild is replaced +;; by all of the DocumentFragment children, which are inserted in the +;; same order. + +;; If the newChild is already in the tree, it is first removed. + +(defun dom-node-replace-child (node new-child old-child) + "Replace OLD-CHILD with NEW-CHILD in the list NODE's children. +Return OLD-CHILD." + (dom-node-test-new-child node new-child) + (dom-node-unlink-child-from-parent new-child) + (let ((children (dom-node-child-nodes node))) + (unless (memq old-child children) + (dom-exception 'dom-not-found-err)) + (setf (dom-node-child-nodes node) + (nsubstitute new-child old-child children))) + ;; set parent of new-child and old-child + (setf (dom-node-parent-node old-child) nil + (dom-node-parent-node new-child) node)) +(dom-node-defun 'dom-node-replace-child) + +;; textContent of type DOMString, introduced in DOM Level 3 + +;; This attribute returns the text content of this node and its +;; descendants. + +;; FIXME: When set, any possible children this node may have are +;; removed and replaced by a single Text node containing the string this +;; attribute is set to. (not implemented yet) + +;; On getting, no serialization is performed, the returned string does +;; not contain any markup. Similarly, on setting, no parsing is +;; performed either, the input string is taken as pure textual content. + +(defun dom-node-text-content (node) + "Return the text content of NODE and its children. +If NODE is an attribute or a text node, its value is returned." + (if (or (dom-attr-p node) + (dom-text-p node)) + (dom-node-value node) + (apply 'concat + (mapcar 'dom-node-value + (dom-element-get-elements-by-tag-name + node dom-text-node-name))))) +(dom-node-defun 'dom-node-text-content) + +(defun dom-node-set-text-content (node data) + "Set the text content of NODE, replacing all its children. +If NODE is an attribute or a text node, its value is set." + (if (or (dom-attr-p node) + (dom-text-p node)) + (setf (dom-node-value node) data) + (setf (dom-node-child-nodes node) + (list (dom-document-create-text-node + (dom-node-owner-document node) + data))))) +(dom-node-defun 'dom-node-set-text-content) + +(defsetf dom-node-text-content dom-node-set-text-content) + +;;; Utility functions + +;; These utility functions are defined for nodes only. + +(defun dom-node-ancestor-p (node ancestor) + "Return t if ANCESTOR is an ancestor of NODE in the tree." + (let ((parent (dom-node-parent-node node)) + result) + (while (and (not result) parent) + (setq result (eq parent ancestor) + parent (dom-node-parent-node parent))) + result)) + +(defun dom-node-valid-child (node child) + "Return t if CHILD is a valid child for NODE. +This depends on the node-type of NODE and CHILD." + ;; FIXME: Add stuff as we go along. + t) + +(defun dom-node-test-new-child (node new-child) + "Check wether NEW-CHILD is acceptable addition to NODE's children." + (when (or (dom-node-ancestor-p node new-child) + (eq new-child node) + (not (dom-node-valid-child node new-child))) + (dom-exception 'dom-hierarchy-request-err)) + (when (not (eq (dom-node-owner-document node) + (dom-node-owner-document new-child))) + (dom-exception 'dom-wrong-document-err)) + new-child) + +(defun dom-node-unlink-child-from-parent (node) + "Unlink NODE from is previous location. +This is very similar to `dom-node-remove-child' but it will check wether +this node is the child of a particular other node." + ;; remove node from it's old position + (let ((parent (dom-node-parent-node node))) + (when parent + ;; remove from parent's child-nodes and set own parent to nil + (setf (dom-node-child-nodes parent) + (delq node (dom-node-child-nodes parent)) + (dom-node-parent-node node) + nil))) + node) + +;;; Interface NodeList + +;; The NodeList interface provides the abstraction of an ordered +;; collection of nodes, without defining or constraining how this +;; collection is implemented. NodeList objects in the DOM are live. + +;; The items in the NodeList are accessible via an integral index, +;; starting from 0. + +;; This provides alternate names for plain lisp list accessor functions. + +(defalias 'dom-node-list-length 'length) + +(defun dom-node-list-item (list index); for the sake of argument order + "Return element at INDEX in LIST. +Equivalent to (nth INDEX NODE)." + (nth index list)) + +;; Interface Attr + +;; The Attr interface represents an attribute in an Element object. +;; Typically the allowable values for the attribute are defined in a +;; document type definition. + +;; Attr objects inherit the Node interface, but since they are not +;; actually child nodes of the element they describe, the DOM does not +;; consider them part of the document tree. Thus, the Node attributes +;; parentNode, previousSibling, and nextSibling have a null value for Attr +;; objects. The DOM takes the view that attributes are properties of +;; elements rather than having a separate identity from the elements they +;; are associated with; this should make it more efficient to implement +;; such features as default attributes associated with all elements of a +;; given type. Furthermore, Attr nodes may not be immediate children of a +;; DocumentFragment. However, they can be associated with Element nodes +;; contained within a DocumentFragment. In short, users and implementors +;; of the DOM need to be aware that Attr nodes have some things in common +;; with other objects inheriting the Node interface, but they also are +;; quite distinct. + +;; The attribute's effective value is determined as follows: if this +;; attribute has been explicitly assigned any value, that value is the +;; attribute's effective value; otherwise, if there is a declaration for +;; this attribute, and that declaration includes a default value, then +;; that default value is the attribute's effective value; otherwise, the +;; attribute does not exist on this element in the structure model until +;; it has been explicitly added. Note that the nodeValue attribute on the +;; Attr instance can also be used to retrieve the string version of the +;; attribute's value(s). + +;; In XML, where the value of an attribute can contain entity references, +;; the child nodes of the Attr node may be either Text or EntityReference +;; nodes (when these are in use; see the description of EntityReference +;; for discussion). Because the DOM Core is not aware of attribute types, +;; it treats all attribute values as simple strings, even if the DTD or +;; schema declares them as having tokenized types. + +;; ownerElement of type Element, readonly, introduced in DOM Level 2 + +;; The Element node this attribute is attached to or null if +;; this attribute is not in use. + +;; Interface Element + +;; The Element interface represents an element in an HTML or XML +;; document. Elements may have attributes associated with them; since +;; the Element interface inherits from Node, the generic Node interface +;; attribute attributes may be used to retrieve the set of all +;; attributes for an element. There are methods on the Element interface +;; to retrieve either an Attr object by name or an attribute value by +;; name. In XML, where an attribute value may contain entity references, +;; an Attr object should be retrieved to examine the possibly fairly +;; complex sub-tree representing the attribute value. On the other hand, +;; in HTML, where all attributes have simple string values, methods to +;; directly access an attribute value can safely be used as a +;; convenience. + +(defun dom-element-get-elements-by-tag-name-1 (element name) + "Return a list of elements with tag NAME. +The elements are ELEMENT, its siblings, and their descendants. +This is used by `dom-element-get-elements-by-tag-name' and +`dom-document-get-elements-by-tag-name'." + ;; We don't want to call this recursively because of performance. + (let (stack result) + (while element + (when (or (string= name "*") + (string= name (dom-node-name element))) + (setq result (cons element result))) + (setq element + (cond ((dom-node-first-child element) + (when (dom-node-next-sibling element) + (push (dom-node-next-sibling element) stack)) + (dom-node-first-child element)) + ((dom-node-next-sibling element)) + (t (pop stack))))) + (nreverse result))) + +(defun dom-element-get-elements-by-tag-name (element name) + "Return a list of all descendant of ELEMENT with tag NAME. +The elements are returned in the order in which they are encountered in +a preorder traversal of this element tree." + (dom-element-get-elements-by-tag-name-1 + (dom-element-first-child element) + name)) + +;; Interface Text + +;; The Text interface inherits from CharacterData and represents the +;; textual content (termed character data in XML) of an Element or Attr. +;; If there is no markup inside an element's content, the text is +;; contained in a single object implementing the Text interface that is +;; the only child of the element. If there is markup, it is parsed into +;; the information items (elements, comments, etc.) and Text nodes that +;; form the list of children of the element. + +;; When a document is first made available via the DOM, there is only one +;; Text node for each block of text. Users may create adjacent Text nodes +;; that represent the contents of a given element without any intervening +;; markup, but should be aware that there is no way to represent the +;; separations between these nodes in XML or HTML, so they will not (in +;; general) persist between DOM editing sessions. The normalize() method +;; on Node merges any such adjacent Text objects into a single node for +;; each block of text. + +;; Character data is represented as a plain string. + + + +;;; Converting XML to DOM + +;; Converting XML (hierarchy of nodes, simple lists, symbols and +;; strings) to DOM (hierarchy of dom-nodes, defstructs from CL) + +(defun dom-make-attribute-from-xml (attribute element doc) + "Make a DOM node of attributes based on ATTRIBUTE. +Called from `dom-make-element-from-xml'. +ELEMENT is the owner-element. +DOC is the owner-document." + (let* ((name (car attribute)) + (value (cdr attribute)) + (attr (dom-document-create-attribute doc name))) + (setf (dom-attr-value attr) value + (dom-attr-owner-element attr) element) + attr)) + +(defun dom-add-children (parent children) + "Add CHILDREN to PARENT. +CHILDREN is a list of XML NODE elements. Each must +be converted to a dom-node first." + (when children + (setf (dom-node-child-nodes parent) + (mapcar (lambda (child) + (dom-make-node-from-xml + child + (dom-node-owner-document parent))) + children)) + (mapc (lambda (child) + (setf (dom-node-parent-node child) + parent)) + (dom-node-child-nodes parent)))) + +(defun dom-make-element-from-xml (node owner) + "Make a DOM element based on NODE. +Called from `dom-make-node-from-xml'. +The atttributes are created by `dom-make-attribute-from-xml'. +OWNER is stored as the owner-document." + (let* ((children (xml-node-children node)) + (attributes (xml-node-attributes node)) + (type (xml-node-name node)) + (element (dom-document-create-element owner type))) + (when attributes + (setf (dom-node-attributes element) + (mapcar (lambda (attribute) + (dom-make-attribute-from-xml attribute element owner)) + attributes))) + (when children + (dom-add-children element children)) + element)) + +(defun dom-make-node-from-xml (node owner) + "Make a DOM node based on NODE. +If NODE is a list, the node is created by `dom-make-element-from-xml'. +OWNER is stored as the owner-document." + (cond ((stringp node) + (dom-document-create-text-node owner node)) + ((listp node) + (dom-make-element-from-xml node owner)) + (t + (error "Illegal node: %S" node)))) + +(defun dom-make-document-from-xml (node) + "Return a DOM document based on NODE. +NODE is a node as returned by `xml-parse-file', either +a string or a list. The DOM nodes are created using +`dom-make-node-from-xml'. + +Note that `xml-parse-file' returns a list of elements. +You can only pass one of these nodes as NODE." + (let* ((doc (make-dom-document + :name dom-document-node-name + :type dom-document-node)) + (node (dom-make-node-from-xml node doc))) + (setf (dom-document-owner-document doc) doc; required in dom-add-children + (dom-document-element doc) node) + doc)) + +;;; Test stuff + +(eval-when-compile + (when (file-readable-p "sample.xml") + (let ((data (car (xml-parse-file "sample.xml")))) + ;; (setq data (car (xml-parse-file "sample.xml"))) + (assert (fboundp 'dom-node-name)) + (assert (fboundp 'dom-document-name)) + (assert (fboundp 'dom-element-name)) + (assert (fboundp 'dom-attr-name)) + + (let ((attr (dom-make-attribute-from-xml + (car (xml-node-attributes data)) 'none 'none))) + (assert (string= "id" (dom-node-name attr))) + (assert (string= "compiler" (dom-node-value attr))) + (assert (eq dom-attribute-node (dom-node-type attr)))) + + (let ((element (dom-make-node-from-xml data 'no-owner))) + (assert (string= "book" (dom-node-name element))) + (assert (string= "id" (dom-node-name + (car (dom-node-attributes element))))) + (assert (string= "compiler" + (dom-node-value + (car (dom-node-attributes element))))) + (assert (string= "bookinfo" + (dom-node-name + (first (dom-node-child-nodes element))))) + (assert (string= "chapter" + (dom-node-name + (second (dom-node-child-nodes element))))) + (let ((title (first + (dom-node-child-nodes + (first + (dom-node-child-nodes + (first + (dom-node-child-nodes element)))))))) + (assert (eq 'title (dom-node-name title))) + (assert (string= "My own book!" + (dom-node-value + (first (dom-node-child-nodes title))))))) + + (let ((doc (dom-make-document-from-xml data))) + (assert (eq dom-document-node-name (dom-document-name doc))) + (assert (string= "book" (dom-node-name (dom-document-element doc)))) + (assert (eq (dom-node-parent-node + (first (dom-node-child-nodes (dom-document-element doc)))) + (dom-document-element doc))) + (assert (eq (first (dom-node-child-nodes (dom-document-element doc))) + (dom-node-first-child (dom-document-element doc)))) + (assert (eq (dom-node-next-sibling + (first (dom-node-child-nodes (dom-document-element doc)))) + (second (dom-node-child-nodes (dom-document-element doc))))) + (assert (eq doc + (dom-node-owner-document + (dom-node-first-child (dom-document-element doc))))) + (assert (string= "chapter" + (dom-node-name + (dom-element-last-child + (dom-document-element doc))))) + (assert (eq nil (dom-node-previous-sibling (dom-document-element doc))))) + + (assert (eq 3 (dom-node-list-length '(1 2 3)))) + + (assert (eq 2 (dom-node-list-item '(1 2 3) 1))) + + (let ((doc (dom-make-document-from-xml data))) + (assert (equal (mapcar 'dom-node-name + (dom-document-get-elements-by-tag-name + doc '*)) + '(book bookinfo bookbiblio title \#text edition + \#text authorgroup author firstname \#text + surname \#text chapter title \#text para + \#text))) + (assert (equal (mapcar 'dom-node-name + (dom-document-get-elements-by-tag-name + doc 'title)) + '(title title))) + (assert (equal (mapcar 'dom-node-name + (dom-element-get-elements-by-tag-name + (dom-document-element doc) 'title)) + '(title title))) + (assert (equal (mapcar (lambda (element) + (dom-node-value + (dom-element-first-child element))) + (dom-document-get-elements-by-tag-name + doc 'title)) + '("My own book!" "A very small chapter")))) + + (let* ((doc (dom-make-document-from-xml data)) + (ancestor (dom-document-element doc)) + (child (car (dom-document-get-elements-by-tag-name doc 'title)))) + (assert (dom-node-ancestor-p child ancestor))) + + (let* ((doc (dom-make-document-from-xml data)) + (book (dom-document-element doc)) + (old-chapter (dom-element-last-child book)) + (new-chapter (dom-document-create-element doc 'chapter))) + (assert (string= (dom-node-name + (dom-element-append-child book new-chapter)) + "chapter")) + (assert (equal (mapcar 'dom-element-name + (dom-element-child-nodes book)) + '(bookinfo chapter chapter))) + (assert (eq (dom-element-last-child book) new-chapter)) + (assert (not (eq (dom-element-last-child book) old-chapter))) + (assert (eq (dom-element-next-sibling old-chapter) new-chapter)) + (assert (eq (dom-element-previous-sibling new-chapter) old-chapter)) + (assert (eq (dom-element-parent-node new-chapter) book)) + (assert (dom-node-ancestor-p new-chapter book)) + (assert (not (eq t (condition-case var + (dom-element-append-child book new-chapter) + ('dom-hierarchy-request-err + t))))) + (assert (eq t (condition-case var + (dom-element-append-child new-chapter book) + ('dom-hierarchy-request-err + t))))) + + (let* ((doc (dom-make-document-from-xml data)) + (book (dom-document-element doc)) + (old-chapter (dom-element-last-child book)) + (new-chapter (dom-document-create-element doc 'chapter)) + (new-title (dom-document-create-element doc 'title)) + (text (dom-document-create-text-node doc "Test Chapter"))) + (assert (eq text (dom-element-append-child + (dom-element-append-child + (dom-element-append-child book new-chapter) + new-title) + text))) + (assert (= 2 (length (dom-node-child-nodes old-chapter)))) + (assert (= 1 (length (dom-node-child-nodes new-chapter)))) + (assert (string= "title" (dom-node-name + (car (dom-node-child-nodes new-chapter))))) + (assert (eq (car (dom-node-child-nodes new-chapter)) + (dom-node-first-child new-chapter))) + (assert (eq new-title + (dom-node-first-child new-chapter))) + (assert (eq text + (dom-node-first-child new-title))) + (assert (equal + (mapcar (lambda (node) + (dom-node-value + (dom-node-first-child node))) + (dom-document-get-elements-by-tag-name doc 'title)) + '("My own book!" "A very small chapter" "Test Chapter")))) + + (let* ((doc (dom-make-document-from-xml data)) + (book (dom-document-element doc)) + (copy (dom-node-clone-node book))) + (assert (not (eq book copy))) + (assert (eq (dom-node-child-nodes book) + (dom-node-child-nodes copy))) + (assert (eq (car (dom-node-child-nodes book)) + (car (dom-node-child-nodes copy)))) + (assert (eq (dom-node-first-child book) + (dom-node-first-child copy))) + (assert (eq (dom-node-last-child book) + (dom-node-last-child copy))) + (assert (not (eq (dom-node-attributes book) + (dom-node-attributes copy)))) + (assert (eq (dom-node-name (car (dom-node-attributes book))) + (dom-node-name (car (dom-node-attributes copy))))) + (assert (not (eq (dom-node-value (car (dom-node-attributes book))) + (dom-node-value (car (dom-node-attributes copy)))))) + (assert (equal (dom-node-value (car (dom-node-attributes book))) + (dom-node-value (car (dom-node-attributes copy)))))) + + (let* ((doc (dom-make-document-from-xml data)) + (book (dom-document-element doc)) + (deepcopy (dom-node-clone-node book t))) + (assert (not (eq book deepcopy))) + (assert (equal (dom-node-attributes book) + (dom-node-attributes deepcopy))) + (assert (not (eq (dom-node-attributes book) + (dom-node-attributes deepcopy)))) + (assert (equal + (mapcar 'dom-node-name + (dom-element-get-elements-by-tag-name book '*)) + (mapcar 'dom-node-name + (dom-element-get-elements-by-tag-name deepcopy '*)))) + (assert (equal + (mapcar 'dom-node-value + (dom-element-get-elements-by-tag-name book '*)) + (mapcar 'dom-node-value + (dom-element-get-elements-by-tag-name deepcopy '*)))) + (assert (not (eq (car (dom-element-get-elements-by-tag-name + book 'firstname)) + (car (dom-element-get-elements-by-tag-name + deepcopy 'firstname))))) + (assert (not (eq (dom-text-value + (third (dom-element-get-elements-by-tag-name + book '\#text))) + (dom-text-value + (third (dom-element-get-elements-by-tag-name + deepcopy '\#text)))))) + (assert (string= (dom-text-value + (third (dom-element-get-elements-by-tag-name + book '\#text))) + (dom-text-value + (third (dom-element-get-elements-by-tag-name + deepcopy '\#text))))) + (assert (not (eq (dom-text-value + (third (dom-element-get-elements-by-tag-name + book '\#text))) + (dom-text-value + (third (dom-element-get-elements-by-tag-name + deepcopy '\#text))))))) + + (let* ((doc (dom-make-document-from-xml data)) + (book (dom-document-element doc)) + (old-chapter (dom-element-last-child book)) + (new-chapter (dom-document-create-element doc 'chapter))) + (assert (eq (dom-node-name (dom-element-insert-before book new-chapter)) + 'chapter)) + (assert (equal (mapcar 'dom-element-name + (dom-element-child-nodes book)) + '(bookinfo chapter chapter))) + (assert (eq new-chapter (dom-element-insert-before + book new-chapter + (dom-element-first-child book)))) + (assert (equal (mapcar 'dom-element-name + (dom-element-child-nodes book)) + '(chapter bookinfo chapter))) + (let ((new-bookinfo (dom-document-create-element doc 'bookinfo))) + (dom-element-insert-before book new-bookinfo old-chapter)) + (assert (equal (mapcar 'dom-element-name + (dom-element-child-nodes book)) + '(chapter bookinfo bookinfo chapter)))) + + ;; FIXME: some more tests for `dom-node-remove-child' and + ;; `dom-node-replace-child' would be nice... :) + (let* ((doc (dom-make-document-from-xml data)) + (book (dom-document-element doc)) + (old-chapter (dom-element-last-child book)) + (new-chapter (dom-document-create-element doc 'chapter))) + (dom-node-remove-child book old-chapter) + (assert (equal (mapcar 'dom-node-name (dom-node-child-nodes book)) + '(bookinfo))) + (dom-node-replace-child book new-chapter + (dom-node-first-child book)) + (assert (equal (mapcar 'dom-node-name (dom-node-child-nodes book)) + '(chapter)))) + + (let* ((doc (make-dom-document)) + (par (dom-document-create-element doc 'p)) + (part1 (dom-document-create-text-node doc "This is ")) + (part2 (dom-document-create-element doc 'b)) + (part3 (dom-document-create-text-node doc "."))) + (dom-element-append-child + part2 (dom-document-create-text-node doc "bold")) + (dom-element-append-child par part1) + (dom-element-append-child par part2) + (dom-element-append-child par part3) + (setf (dom-document-owner-document doc) doc + (dom-document-element doc) par) + (assert (eq (dom-document-element doc) par)) + (assert (string= (dom-node-text-content par) + "This is bold.")) + (dom-node-set-text-content par "This is plain.") + (assert (string= (dom-node-text-content par) + "This is plain.")) + (assert (equal (mapcar 'dom-node-name (dom-node-child-nodes par)) + '(\#text))) + (setf (dom-node-text-content par) "New text.") + (assert (string= (dom-node-text-content par) + "New text.")) + (setf (dom-element-text-content par) "Different text.") + (assert (string= (dom-element-text-content par) + "Different text.")) + (let ((at (dom-document-create-attribute doc 'foo))) + (setf (dom-attr-value at) "domino" + (dom-element-attributes par) (list at)) + (assert (string= "domino" + (dom-node-value + (dom-node-list-item + (dom-element-attributes par) + 0)))) + (assert (string= "domino" + (dom-node-text-content + (dom-node-list-item + (dom-element-attributes par) + 0)))))) + + (let* ((doc (dom-make-document-from-xml data)) + (title (car (dom-document-get-elements-by-tag-name doc "title")))) + (assert (equal (dom-element-text-content title) + "My own book!")))))) + +(provide 'dom) + +;;; dom.el ends here. diff --git a/auto-install/fame.el b/auto-install/fame.el new file mode 100644 index 0000000..4f9bf43 --- /dev/null +++ b/auto-install/fame.el @@ -0,0 +1,421 @@ +;;; fame.el --- Framework for Applications' MEssages +;; +;; Copyright (C) 2004 David Ponce +;; +;; Author: David Ponce +;; Maintainer: David Ponce +;; Created: 28 Oct 2004 +;; Keywords: status +;; X-RCS: $Id: fame.el,v 1.3 2005-09-30 20:07:29 zappo Exp $ +;; +;; This file is not part of GNU Emacs. +;; +;; This program 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 2, or (at +;; your option) any later version. +;; +;; This software 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; This library provides a convenient framework for applications to +;; send messages distinguished by their level of importance, allowing +;; to customize how they will be actually rendered. +;; +;; The principle is to define a `channel' where to send messages at +;; particular levels, depending on their importance. A channel is +;; identified by a non-nil symbol. For example this library could +;; send its messages to the `fame' channel. Four levels of importance +;; are recognized, for debug, informational, warning and error +;; messages. +;; +;; Messages at any particular level can be either discarded, +;; temporarily displayed, recorded in the message log buffer without +;; showing them in the echo area, or shown the usual way like through +;; the `message' function. Messages shown in the echo area can be +;; recorded or not in the message log buffer. +;; +;; The `define-fame-channel' macro permits to easily define a new +;; channel, that is an option to customize how to display the message +;; levels for this channel, and the level specific functions to use to +;; send messages to this channel. +;; +;; Here is a small example: +;; +;; (require 'fame) +;; ... +;; (define-fame-channel feature) +;; ... +;; (feature-send-debug "Some useful debug message") +;; ... +;; (condition-case err +;; ... +;; (error +;; (feature-send-error "%s" (error-message-string err)))) +;; ... +;; (feature-send-info "Some useful informational message") +;; ... +;; (provide 'feature) + +;;; History: +;; + +;;; Code: + +;;; Constants and options +;; +(defconst fame-valid-levels + '(:error :warning :info :debug) + "Valid message levels.") + +(defconst fame-valid-level-values + '(t nolog temp temp-nolog log none) + "Valid message level values.") + +(defconst fame-default-level-values + '(:debug log :info temp :warning t :error t) + "Default display value of message levels.") + +(define-widget 'fame-display-choice 'radio-button-choice + "Widget to choose the display value of a level." + :format "%v\n" + :entry-format " %v%b" + :args '((const :format "%v" :value t) + (const :format "%v" :value nolog) + (const :format "%v" :value temp) + (const :format "%v" :value temp-nolog) + (const :format "%v" :value log) + (const :format "%v" :value none))) + +(define-widget 'fame-level-widget 'const + "Widget to display a level symbol." + :format " %t") + +(define-widget 'fame-channel-widget 'list + "Widget to customize the messages levels of a channel." + :tag "Display value of message levels" + :format "%{%t%}:\n%v\n" + :args '((fame-level-widget :tag ":debug " :value :debug) + (fame-display-choice) + (fame-level-widget :tag ":info " :value :info) + (fame-display-choice) + (fame-level-widget :tag ":warning" :value :warning) + (fame-display-choice) + (fame-level-widget :tag ":error " :value :error) + (fame-display-choice))) + +(defgroup fame nil + "Framework for Applications' MEssages." + :prefix "fame" + :group 'lisp) + +(defcustom fame-temp-message-delay 1 + "*Lifetime of a temporary message, in seconds." + :group 'fame + :type 'number) + +;;; Core message functions +;; +(eval-and-compile + +;;;; Read the message currently displayed in the echo area. + (defalias 'fame-current-message + (if (fboundp 'current-message) + 'current-message + 'ignore)) + +;;;; Show a message in the echo area without logging it. + (if (fboundp 'lmessage) + ;; XEmacs + (defun fame-message-nolog (&rest args) + "Display but don't log a message on the echo area. +ARGS are like those of the function `message'." + (and args (apply 'lmessage 'no-log args))) + ;; Emacs + (defun fame-message-nolog (&rest args) + "Display but don't log a message on the echo area. +ARGS will be passed to the function `message'." + (and args + (let ((message-log-max nil)) ;; No logging + (apply 'message args)))) + ) + +;;;; Log a message without showing it in the echo area. + (if (fboundp 'log-message) + ;; XEmacs + (defun fame-log-message (&rest args) + "Log but don't display a message. +ARGS are like those of the function `message'." + (and args (log-message 'message (apply 'format args)))) + ;; Emacs + (defun fame-log-message (&rest args) + "Log but don't display a message. +ARGS will be passed to the function `message'." + (and args + (let ((executing-kbd-macro t)) ;; Inhibit display! + (apply 'message args)))) + ) + ;; If the above definition fails, here is a portable implementation + ;; of a `log-message' function. + '(defun fame-log-message (&rest args) + "Log but don't display a message. +ARGS are like those of the function `message'." + (when args + (let ((text (apply 'format args))) + (with-current-buffer + (get-buffer-create (if (featurep 'xemacs) + " *Message-Log*" + "*Messages*")) + (goto-char (point-max)) + (or (bobp) (bolp) (insert "\n")) + (forward-line -1) + (if (search-forward text nil t) + (if (looking-at " \\[\\([0-9]+\\) times\\]") + (replace-match + (number-to-string + (1+ (string-to-number (match-string 1)))) + nil nil nil 1) + (end-of-line) + (insert " [2 times]")) + (forward-line 1) + (insert text)))))) + +;;;; Log and temporarily show a message in the echo area. + (condition-case nil + (require 'timer) + (error nil)) + ;; We need timers to display messages temporarily. + (if (not (fboundp 'run-with-timer)) + + (defun fame-temp-message-internal (fun &rest args) + "Display a message temporarily through the function FUN. +ARGS are like those of the function `message'." + ;; Without timers just call FUN. + (and args (apply fun args))) + + (defvar fame-temp-message-timer nil) + (defvar fame-temp-message-saved nil) + + (defun fame-temp-restore-message () + "Restore a message previously displayed in the echo area." + (when (timerp fame-temp-message-timer) + (cancel-timer fame-temp-message-timer) + (setq fame-temp-message-timer nil)) + (when fame-temp-message-saved + (prog1 (fame-message-nolog "%s" fame-temp-message-saved) + (setq fame-temp-message-saved nil)))) + + (defun fame-temp-message-internal (fun &rest args) + "Display a message temporarily through the function FUN. +ARGS are like those of the function `message'." + (when args + (condition-case nil + (progn + (fame-temp-restore-message) + (setq fame-temp-message-saved (fame-current-message)) + (prog1 (apply fun args) + (setq fame-temp-message-timer + (run-with-timer fame-temp-message-delay nil + 'fame-temp-restore-message)))) + (error + (fame-temp-restore-message))))) + ) + ) + +(defsubst fame-temp-message (&rest args) + "Display a message temporarily and log it. +ARGS are like those of the function `message'. +The original message is restored to the echo area after +`fame-temp-message-delay' seconds." + (apply 'fame-temp-message-internal 'message args)) + +(defsubst fame-temp-message-nolog (&rest args) + "Display a message temporarily without logging it. +ARGS are like those of the function `message'. +The original message is restored to the echo area after +`fame-temp-message-delay' seconds." + (apply 'fame-temp-message-internal 'fame-message-nolog args)) + +;;; Handling of message levels +;; +(defun fame-check-level (level) + "Check that LEVEL is a valid message level. +If valid, return LEVEL. Signal an error otherwise." + (if (memq level fame-valid-levels) + level + (signal 'wrong-type-argument + (list fame-valid-levels level)))) + +(defun fame-check-level-value (value) + "Check that VALUE is a valid message level value. +If valid, return VALUE. Signal an error otherwise." + (if (memq value fame-valid-level-values) + value + (signal 'wrong-type-argument + (list fame-valid-level-values value)))) + +(defun fame-check-channel (channel) + "Check that CHANNEL is a non-nil symbol. +If valid, return CHANNEL. Signal an error otherwise." + (if (and channel (symbolp channel)) + channel + (signal 'wrong-type-argument + (list 'symbolp channel)))) + +(defun fame-check-channel-levels (levels) + "Check that LEVELS is a valid specification of channel levels. +If valid, return a normalized form of the specification. +Signal an error otherwise." + (let (spec) + (dolist (level fame-valid-levels) + (push (fame-check-level-value + ;; A nil level value means to use the default value. + (or (plist-get levels level) + (plist-get fame-default-level-values level))) spec) + (push level spec)) + spec)) + +(defsubst fame-channel-symbol (channel) + "Return the symbol whose value is CHANNEL's levels." + (intern (format "%s-fame-levels" (fame-check-channel channel)))) + +(defun fame-channel-levels (channel) + "Return the message levels display values of CHANNEL. +If CHANNEL doesn't exist return the default value in constant +`fame-default-level-values'." + (let ((symbol (fame-channel-symbol channel))) + (if (boundp symbol) + (symbol-value symbol) + fame-default-level-values))) + +(defsubst fame-level-display (channel level) + "For CHANNEL, return the display value of LEVEL. +See also the option `fame-channels'." + (plist-get (fame-channel-levels channel) + (fame-check-level level))) + +;;; Sending messages to channels +;; +(defconst fame-send-functions-alist + '((none . nil) + (log . fame-log-message) + (temp . fame-temp-message) + (temp-nolog . fame-temp-message-nolog) + (nolog . fame-message-nolog) + (t . message) + )) + +(defun fame-send (channel level &rest args) + "Send a message to CHANNEL at level LEVEL. +ARGS are like those of the function `message'. +The message will be displayed according to what is specified for +CHANNEL in the `fame-channels' option." + (let ((sender (cdr (assq (fame-level-display channel level) + fame-send-functions-alist)))) + (and sender (apply sender args)))) + +(defsubst fame-send-debug (channel &rest args) + "Send a debug message to CHANNEL. +CHANNEL must be a non-nil symbol. +ARGS will be passed to the function `fame-send'." + (apply 'fame-send channel :debug args)) + +(defsubst fame-send-info (channel &rest args) + "Send an informational message to CHANNEL. +CHANNEL must be a non-nil symbol. +ARGS will be passed to the function `fame-send'." + (apply 'fame-send channel :info args)) + +(defsubst fame-send-warning (channel &rest args) + "Send a warning message to CHANNEL. +CHANNEL must be a non-nil symbol. +ARGS will be passed to the function `fame-send'." + (apply 'fame-send channel :warning args)) + +(defsubst fame-send-error (channel &rest args) + "Send an error message to CHANNEL. +CHANNEL must be a non-nil symbol. +ARGS will be passed to the function `fame-send'." + (apply 'fame-send channel :error args)) + +;;; Defining new channels +;; +;;;###autoload +(defmacro define-fame-channel (channel &optional default docstring) + "Define the new message channel CHANNEL. +CHANNEL must be a non-nil symbol. +The optional argument DEFAULT specifies the default value of message +levels for this channel. By default it is the value of +`fame-default-level-values'. +DOCSTRING is an optional channel documentation. + +This defines the option `CHANNEL-fame-levels' to customize the current +value of message levels. And the functions `CHANNEL-send-debug', +`CHANNEL-send-info', `CHANNEL-send-warning', and `CHANNEL-send-error', +that respectively send debug, informational, warning, and error +messages to CHANNEL." + (let ((c-opt (fame-channel-symbol channel))) + `(eval-when-compile + (defcustom ,c-opt ',(fame-check-channel-levels default) + ,(format "*Display value of message levels in the %s channel. +%s +This is a plist where a message level is a property whose value +defines how messages at this level will be displayed. + +The possible levels are :debug, :info, :warning, and :error. +Level values can be: + - t to show and log messages the standard way. + - nolog to show messages without logging them. + - temp to show messages temporarily and log them. + - temp-nolog to show messages temporarily without logging them. + - log to log but not show messages. + - none to discard messages. + +The default behavior is specified in `fame-default-level-values'." + channel + (if docstring (format "%s\n" docstring) "")) + :group 'fame + :type 'fame-channel-widget) + (defsubst ,(intern (format "%s-send-debug" channel)) + (&rest args) + ,(format "Send a debug message to the `%s' channel. +ARGS will be passed to the function `fame-send'. +To customize how such messages will be displayed, see the option +`%s'." channel c-opt) + (apply 'fame-send ',channel :debug args)) + (defsubst ,(intern (format "%s-send-info" channel)) + (&rest args) + ,(format "Send an informational message to the `%s' channel. +ARGS will be passed to the function `fame-send'. +To customize how such messages will be displayed, see the option +`%s'." channel c-opt) + (apply 'fame-send ',channel :info args)) + (defsubst ,(intern (format "%s-send-warn" channel)) + (&rest args) + ,(format "Send a warning message to the `%s' channel. +ARGS will be passed to the function `fame-send'. +To customize how such messages will be displayed, see the option +`%s'." channel c-opt) + (apply 'fame-send ',channel :warning args)) + (defsubst ,(intern (format "%s-send-error" channel)) + (&rest args) + ,(format "Send an error message to the `%s' channel. +ARGS will be passed to the function `fame-send'. +To customize how such messages will be displayed, see the option +`%s'." channel c-opt) + (apply 'fame-send ',channel :error args)) + ;; Return the CHANNEL symbol + ',c-opt))) + +(provide 'fame) + +;;; fame.el ends here diff --git a/auto-install/wisent-comp.el b/auto-install/wisent-comp.el new file mode 100644 index 0000000..6b9f15a --- /dev/null +++ b/auto-install/wisent-comp.el @@ -0,0 +1,3558 @@ +;;; wisent-comp.el --- GNU Bison for Emacs - Grammar compiler + +;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2009, 2010 David Ponce +;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000, 2001 +;; Free Software Foundation, Inc. (Bison) + +;; Author: David Ponce +;; Maintainer: David Ponce +;; Created: 30 January 2002 +;; Keywords: syntax +;; X-RCS: $Id: wisent-comp.el,v 1.30 2010-04-09 02:08:59 zappo Exp $ + +;; This file is not part of GNU Emacs. + +;; This program 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 2, or (at +;; your option) any later version. + +;; This program 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 this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; Grammar compiler that produces Wisent's LALR automatons. +;; +;; Wisent (the European Bison ;-) is an Elisp implementation of the +;; GNU Compiler Compiler Bison. The Elisp code is a port of the C +;; code of GNU Bison 1.28 & 1.31. +;; +;; For more details on the basic concepts for understanding Wisent, +;; read the Bison manual ;) +;; +;; For more details on Wisent itself read the Wisent manual. + +;;; History: +;; + +;;; Code: +(require 'wisent) +(require 'working) + +;;;; ------------------- +;;;; Misc. useful things +;;;; ------------------- + +;; As much as possible I would like to keep the name of global +;; variables used in Bison without polluting too much the Elisp global +;; name space. Elisp dynamic binding allows that ;-) + +;; Here are simple macros to easily define and use set of variables +;; binded locally, without all these "reference to free variable" +;; compiler warnings! + +(defmacro wisent-context-name (name) + "Return the context name from NAME." + `(if (and ,name (symbolp ,name)) + (intern (format "wisent-context-%s" ,name)) + (error "Invalid context name: %S" ,name))) + +(defmacro wisent-context-bindings (name) + "Return the variables in context NAME." + `(symbol-value (wisent-context-name ,name))) + +(defmacro wisent-defcontext (name &rest vars) + "Define a context NAME that will bind variables VARS." + (let* ((context (wisent-context-name name)) + (bindings (mapcar #'(lambda (v) (list 'defvar v)) vars))) + `(eval-when-compile + ,@bindings + (defvar ,context ',vars)))) +(put 'wisent-defcontext 'lisp-indent-function 1) + +(defmacro wisent-with-context (name &rest body) + "Bind variables in context NAME then eval BODY." + `(let* ,(wisent-context-bindings name) + ,@body)) +(put 'wisent-with-context 'lisp-indent-function 1) + +;; A naive implementation of data structures! But it suffice here ;-) + +(defmacro wisent-struct (name &rest fields) + "Define a simple data structure called NAME. +Which contains data stored in FIELDS. FIELDS is a list of symbols +which are field names or pairs (FIELD INITIAL-VALUE) where +INITIAL-VALUE is a constant used as the initial value of FIELD when +the data structure is created. INITIAL-VALUE defaults to nil. + +This defines a `make-NAME' constructor, get-able `NAME-FIELD' and +set-able `set-NAME-FIELD' accessors." + (let ((size (length fields)) + (i 0) + accors field sufx fun ivals) + (while (< i size) + (setq field (car fields) + fields (cdr fields)) + (if (consp field) + (setq ivals (cons (cadr field) ivals) + field (car field)) + (setq ivals (cons nil ivals))) + (setq sufx (format "%s-%s" name field) + fun (intern (format "%s" sufx)) + accors (cons `(defmacro ,fun (s) + (list 'aref s ,i)) + accors) + fun (intern (format "set-%s" sufx)) + accors (cons `(defmacro ,fun (s v) + (list 'aset s ,i v)) + accors) + i (1+ i))) + `(progn + (defmacro ,(intern (format "make-%s" name)) () + (cons 'vector ',(nreverse ivals))) + ,@accors))) +(put 'wisent-struct 'lisp-indent-function 1) + +;; Other utilities + +(defsubst wisent-pad-string (s n &optional left) + "Fill string S with spaces. +Return a new string of at least N characters. Insert spaces on right. +If optional LEFT is non-nil insert spaces on left." + (let ((i (length s))) + (if (< i n) + (if left + (concat (make-string (- n i) ?\ ) s) + (concat s (make-string (- n i) ?\ ))) + s))) + +;;;; ------------------------ +;;;; Environment dependencies +;;;; ------------------------ + +(defconst wisent-BITS-PER-WORD + (let ((i 1)) + (while (not (zerop (lsh 1 i))) + (setq i (1+ i))) + i)) + +(defsubst wisent-WORDSIZE (n) + "(N + BITS-PER-WORD - 1) / BITS-PER-WORD." + (/ (1- (+ n wisent-BITS-PER-WORD)) wisent-BITS-PER-WORD)) + +(defsubst wisent-SETBIT (x i) + "X[I/BITS-PER-WORD] |= 1 << (I % BITS-PER-WORD)." + (let ((k (/ i wisent-BITS-PER-WORD))) + (aset x k (logior (aref x k) + (lsh 1 (% i wisent-BITS-PER-WORD)))))) + +(defsubst wisent-RESETBIT (x i) + "X[I/BITS-PER-WORD] &= ~(1 << (I % BITS-PER-WORD))." + (let ((k (/ i wisent-BITS-PER-WORD))) + (aset x k (logand (aref x k) + (lognot (lsh 1 (% i wisent-BITS-PER-WORD))))))) + +(defsubst wisent-BITISSET (x i) + "(X[I/BITS-PER-WORD] & (1 << (I % BITS-PER-WORD))) != 0." + (not (zerop (logand (aref x (/ i wisent-BITS-PER-WORD)) + (lsh 1 (% i wisent-BITS-PER-WORD)))))) + +(eval-when-compile + (or (fboundp 'noninteractive) + ;; Silence the Emacs byte compiler + (defun noninteractive nil)) + ) + +(defsubst wisent-noninteractive () + "Return non-nil if running without interactive terminal." + (if (featurep 'xemacs) + (noninteractive) + noninteractive)) + +(defvar wisent-debug-flag nil + "Non-nil means enable some debug stuff.") + +;;;; -------------- +;;;; Logging/Output +;;;; -------------- +(defconst wisent-log-buffer-name "*wisent-log*" + "Name of the log buffer.") + +(defvar wisent-new-log-flag nil + "Non-nil means to start a new report.") + +;;;###autoload +(defvar wisent-verbose-flag nil + "*Non-nil means to report verbose information on generated parser.") + +;;;###autoload +(defun wisent-toggle-verbose-flag () + "Toggle whether to report verbose information on generated parser." + (interactive) + (setq wisent-verbose-flag (not wisent-verbose-flag)) + (when (cedet-called-interactively-p 'interactive) + (message "Verbose report %sabled" + (if wisent-verbose-flag "en" "dis")))) + +(defmacro wisent-log-buffer () + "Return the log buffer. +Its name is defined in constant `wisent-log-buffer-name'." + `(get-buffer-create wisent-log-buffer-name)) + +(defmacro wisent-clear-log () + "Delete the entire contents of the log buffer." + `(with-current-buffer (wisent-log-buffer) + (erase-buffer))) + +(eval-when-compile (defvar byte-compile-current-file)) + +(defun wisent-source () + "Return the current source file name or nil." + (let ((source (or (and (boundp 'byte-compile-current-file) + byte-compile-current-file) + load-file-name (buffer-file-name)))) + (if source + (file-relative-name source)))) + +(defun wisent-new-log () + "Start a new entry into the log buffer." + (setq wisent-new-log-flag nil) + (let ((text (format "\n\n*** Wisent %s - %s\n\n" + (or (wisent-source) (buffer-name)) + (format-time-string "%Y-%m-%d %R")))) + (with-current-buffer (wisent-log-buffer) + (goto-char (point-max)) + (insert text)))) + +(defsubst wisent-log (&rest args) + "Insert text into the log buffer. +`format' is applied to ARGS and the result string is inserted into the +log buffer returned by the function `wisent-log-buffer'." + (and wisent-new-log-flag (wisent-new-log)) + (with-current-buffer (wisent-log-buffer) + (insert (apply 'format args)))) + +(defconst wisent-log-file "wisent.output" + "The log file. +Used when running without interactive terminal.") + +(defun wisent-append-to-log-file () + "Append contents of logging buffer to `wisent-log-file'." + (if (get-buffer wisent-log-buffer-name) + (condition-case err + (with-current-buffer (wisent-log-buffer) + (widen) + (if (> (point-max) (point-min)) + (write-region (point-min) (point-max) + wisent-log-file t))) + (error + (message "*** %s" (error-message-string err)))))) + +;;;; ----------------------------------- +;;;; Representation of the grammar rules +;;;; ----------------------------------- + +;; ntokens is the number of tokens, and nvars is the number of +;; variables (nonterminals). nsyms is the total number, ntokens + +;; nvars. + +;; Each symbol (either token or variable) receives a symbol number. +;; Numbers 0 to ntokens-1 are for tokens, and ntokens to nsyms-1 are +;; for variables. Symbol number zero is the end-of-input token. This +;; token is counted in ntokens. + +;; The rules receive rule numbers 1 to nrules in the order they are +;; written. Actions and guards are accessed via the rule number. + +;; The rules themselves are described by three arrays: rrhs, rlhs and +;; ritem. rlhs[R] is the symbol number of the left hand side of rule +;; R. The right hand side is stored as symbol numbers in a portion of +;; ritem. rrhs[R] contains the index in ritem of the beginning of the +;; portion for rule R. + +;; The length of the portion is one greater than the number of symbols +;; in the rule's right hand side. The last element in the portion +;; contains minus R, which identifies it as the end of a portion and +;; says which rule it is for. + +;; The portions of ritem come in order of increasing rule number and +;; are followed by an element which is nil to mark the end. nitems is +;; the total length of ritem, not counting the final nil. Each +;; element of ritem is called an "item" and its index in ritem is an +;; item number. + +;; Item numbers are used in the finite state machine to represent +;; places that parsing can get to. + +;; The vector rprec contains for each rule, the item number of the +;; symbol giving its precedence level to this rule. The precedence +;; level and associativity of each symbol is recorded in respectively +;; the properties 'wisent--prec and 'wisent--assoc. + +;; Precedence levels are assigned in increasing order starting with 1 +;; so that numerically higher precedence values mean tighter binding +;; as they ought to. nil as a symbol or rule's precedence means none +;; is assigned. + +(defcustom wisent-state-table-size 1009 + "The size of the state table." + :type 'integer + :group 'wisent) + +;; These variables only exist locally in the function +;; `wisent-compile-grammar' and are shared by all other nested +;; callees. +(wisent-defcontext compile-grammar + F LA LAruleno accessing-symbol conflicts consistent default-prec + derives err-table fderives final-state first-reduction first-shift + first-state firsts from-state goto-map includes itemset nitemset + kernel-base kernel-end kernel-items last-reduction last-shift + last-state lookaheads lookaheadset lookback maxrhs ngotos nitems + nrules nshifts nstates nsyms ntokens nullable nvars rassoc redset + reduction-table ritem rlhs rprec rrc-count rrc-total rrhs ruseful + rcode ruleset rulesetsize shift-symbol shift-table shiftset + src-count src-total start-table state-table tags this-state to-state + tokensetsize ;; nb of words req. to hold a bit for each rule + varsetsize ;; nb of words req. to hold a bit for each variable + error-token-number start-symbol token-list var-list + N P V V1 nuseless-nonterminals nuseless-productions + ptable ;; symbols & characters properties + ) + +(defmacro wisent-ISTOKEN (s) + "Return non-nil if item number S defines a token (terminal). +That is if S < `ntokens'." + `(< ,s ntokens)) + +(defmacro wisent-ISVAR(s) + "Return non-nil if item number S defines a nonterminal. +That is if S >= `ntokens'." + `(>= ,s ntokens)) + +(defsubst wisent-tag (s) + "Return printable form of item number S." + (wisent-item-to-string (aref tags s))) + +;; Symbol and character properties + +(defsubst wisent-put (object propname value) + "Store OBJECT's PROPNAME property with value VALUE. +Use `eq' to locate OBJECT." + (let ((entry (assq object ptable))) + (or entry (setq entry (list object) ptable (cons entry ptable))) + (setcdr entry (plist-put (cdr entry) propname value)))) + +(defsubst wisent-get (object propname) + "Return the value of OBJECT's PROPNAME property. +Use `eq' to locate OBJECT." + (plist-get (cdr (assq object ptable)) propname)) + +(defsubst wisent-item-number (x) + "Return the item number of symbol X." + (wisent-get x 'wisent--item-no)) + +(defsubst wisent-set-item-number (x n) + "Set the item number of symbol X to N." + (wisent-put x 'wisent--item-no n)) + +(defsubst wisent-assoc (x) + "Return the associativity of symbol X." + (wisent-get x 'wisent--assoc)) + +(defsubst wisent-set-assoc (x a) + "Set the associativity of symbol X to A." + (wisent-put x 'wisent--assoc a)) + +(defsubst wisent-prec (x) + "Return the precedence level of symbol X." + (wisent-get x 'wisent--prec)) + +(defsubst wisent-set-prec (x p) + "Set the precedence level of symbol X to P." + (wisent-put x 'wisent--prec p)) + +;;;; ---------------------------------------------------------- +;;;; Type definitions for nondeterministic finite state machine +;;;; ---------------------------------------------------------- + +;; These type definitions are used to represent a nondeterministic +;; finite state machine that parses the specified grammar. This +;; information is generated by the function `wisent-generate-states'. + +;; Each state of the machine is described by a set of items -- +;; particular positions in particular rules -- that are the possible +;; places where parsing could continue when the machine is in this +;; state. These symbols at these items are the allowable inputs that +;; can follow now. + +;; A core represents one state. States are numbered in the number +;; field. When `wisent-generate-states' is finished, the starting +;; state is state 0 and `nstates' is the number of states. (A +;; transition to a state whose state number is `nstates' indicates +;; termination.) All the cores are chained together and `first-state' +;; points to the first one (state 0). + +;; For each state there is a particular symbol which must have been +;; the last thing accepted to reach that state. It is the +;; accessing-symbol of the core. + +;; Each core contains a vector of `nitems' items which are the indices +;; in the `ritems' vector of the items that are selected in this +;; state. + +;; The link field is used for chaining buckets that hash states by +;; their itemsets. This is for recognizing equivalent states and +;; combining them when the states are generated. + +;; The two types of transitions are shifts (push the lookahead token +;; and read another) and reductions (combine the last n things on the +;; stack via a rule, replace them with the symbol that the rule +;; derives, and leave the lookahead token alone). When the states are +;; generated, these transitions are represented in two other lists. + +;; Each shifts structure describes the possible shift transitions out +;; of one state, the state whose number is in the number field. The +;; shifts structures are linked through next and first-shift points to +;; them. Each contains a vector of numbers of the states that shift +;; transitions can go to. The accessing-symbol fields of those +;; states' cores say what kind of input leads to them. + +;; A shift to state zero should be ignored. Conflict resolution +;; deletes shifts by changing them to zero. + +;; Each reductions structure describes the possible reductions at the +;; state whose number is in the number field. The data is a list of +;; nreds rules, represented by their rule numbers. `first-reduction' +;; points to the list of these structures. + +;; Conflict resolution can decide that certain tokens in certain +;; states should explicitly be errors (for implementing %nonassoc). +;; For each state, the tokens that are errors for this reason are +;; recorded in an errs structure, which has the state number in its +;; number field. The rest of the errs structure is full of token +;; numbers. + +;; There is at least one shift transition present in state zero. It +;; leads to a next-to-final state whose accessing-symbol is the +;; grammar's start symbol. The next-to-final state has one shift to +;; the final state, whose accessing-symbol is zero (end of input). +;; The final state has one shift, which goes to the termination state +;; (whose number is `nstates'-1). +;; The reason for the extra state at the end is to placate the +;; parser's strategy of making all decisions one token ahead of its +;; actions. + +(wisent-struct core + next ; -> core + link ; -> core + (number 0) + (accessing-symbol 0) + (nitems 0) + (items [0])) + +(wisent-struct shifts + next ; -> shifts + (number 0) + (nshifts 0) + (shifts [0])) + +(wisent-struct reductions + next ; -> reductions + (number 0) + (nreds 0) + (rules [0])) + +(wisent-struct errs + (nerrs 0) + (errs [0])) + +;;;; -------------------------------------------------------- +;;;; Find unreachable terminals, nonterminals and productions +;;;; -------------------------------------------------------- + +(defun wisent-bits-equal (L R n) + "Visit L and R and return non-nil if their first N elements are `='. +L and R must be vectors of integers." + (let* ((i (1- n)) + (iseq t)) + (while (and iseq (natnump i)) + (setq iseq (= (aref L i) (aref R i)) + i (1- i))) + iseq)) + +(defun wisent-nbits (i) + "Return number of bits set in integer I." + (let ((count 0)) + (while (not (zerop i)) + ;; i ^= (i & ((unsigned) (-(int) i))) + (setq i (logxor i (logand i (- i))) + count (1+ count))) + count)) + +(defun wisent-bits-size (S n) + "In vector S count the total of bits set in first N elements. +S must be a vector of integers." + (let* ((i (1- n)) + (count 0)) + (while (natnump i) + (setq count (+ count (wisent-nbits (aref S i))) + i (1- i))) + count)) + +(defun wisent-useful-production (i N0) + "Return non-nil if production I is in useful set N0." + (let* ((useful t) + (r (aref rrhs i)) + n) + (while (and useful (> (setq n (aref ritem r)) 0)) + (if (wisent-ISVAR n) + (setq useful (wisent-BITISSET N0 (- n ntokens)))) + (setq r (1+ r))) + useful)) + +(defun wisent-useless-nonterminals () + "Find out which nonterminals are used." + (let (Np Ns i n break) + ;; N is set as built. Np is set being built this iteration. P is + ;; set of all productions which have a RHS all in N. + (setq n (wisent-WORDSIZE nvars) + Np (make-vector n 0)) + + ;; The set being computed is a set of nonterminals which can + ;; derive the empty string or strings consisting of all + ;; terminals. At each iteration a nonterminal is added to the set + ;; if there is a production with that nonterminal as its LHS for + ;; which all the nonterminals in its RHS are already in the set. + ;; Iterate until the set being computed remains unchanged. Any + ;; nonterminals not in the set at that point are useless in that + ;; they will never be used in deriving a sentence of the language. + + ;; This iteration doesn't use any special traversal over the + ;; productions. A set is kept of all productions for which all + ;; the nonterminals in the RHS are in useful. Only productions + ;; not in this set are scanned on each iteration. At the end, + ;; this set is saved to be used when finding useful productions: + ;; only productions in this set will appear in the final grammar. + + (while (not break) + (setq i (1- n)) + (while (natnump i) + ;; Np[i] = N[i] + (aset Np i (aref N i)) + (setq i (1- i))) + + (setq i 1) + (while (<= i nrules) + (if (not (wisent-BITISSET P i)) + (when (wisent-useful-production i N) + (wisent-SETBIT Np (- (aref rlhs i) ntokens)) + (wisent-SETBIT P i))) + (setq i (1+ i))) + (if (wisent-bits-equal N Np n) + (setq break t) + (setq Ns Np + Np N + N Ns))) + (setq N Np))) + +(defun wisent-inaccessable-symbols () + "Find out which productions are reachable and which symbols are used." + ;; Starting with an empty set of productions and a set of symbols + ;; which only has the start symbol in it, iterate over all + ;; productions until the set of productions remains unchanged for an + ;; iteration. For each production which has a LHS in the set of + ;; reachable symbols, add the production to the set of reachable + ;; productions, and add all of the nonterminals in the RHS of the + ;; production to the set of reachable symbols. + + ;; Consider only the (partially) reduced grammar which has only + ;; nonterminals in N and productions in P. + + ;; The result is the set P of productions in the reduced grammar, + ;; and the set V of symbols in the reduced grammar. + + ;; Although this algorithm also computes the set of terminals which + ;; are reachable, no terminal will be deleted from the grammar. Some + ;; terminals might not be in the grammar but might be generated by + ;; semantic routines, and so the user might want them available with + ;; specified numbers. (Is this true?) However, the non reachable + ;; terminals are printed (if running in verbose mode) so that the + ;; user can know. + (let (Vp Vs Pp i tt r n m break) + (setq n (wisent-WORDSIZE nsyms) + m (wisent-WORDSIZE (1+ nrules)) + Vp (make-vector n 0) + Pp (make-vector m 0)) + + ;; If the start symbol isn't useful, then nothing will be useful. + (when (wisent-BITISSET N (- start-symbol ntokens)) + (wisent-SETBIT V start-symbol) + (while (not break) + (setq i (1- n)) + (while (natnump i) + (aset Vp i (aref V i)) + (setq i (1- i))) + (setq i 1) + (while (<= i nrules) + (when (and (not (wisent-BITISSET Pp i)) + (wisent-BITISSET P i) + (wisent-BITISSET V (aref rlhs i))) + (setq r (aref rrhs i)) + (while (natnump (setq tt (aref ritem r))) + (if (or (wisent-ISTOKEN tt) + (wisent-BITISSET N (- tt ntokens))) + (wisent-SETBIT Vp tt)) + (setq r (1+ r))) + (wisent-SETBIT Pp i)) + (setq i (1+ i))) + (if (wisent-bits-equal V Vp n) + (setq break t) + (setq Vs Vp + Vp V + V Vs)))) + (setq V Vp) + + ;; Tokens 0, 1 are internal to Wisent. Consider them useful. + (wisent-SETBIT V 0) ;; end-of-input token + (wisent-SETBIT V 1) ;; error token + (setq P Pp) + + (setq nuseless-productions (- nrules (wisent-bits-size P m)) + nuseless-nonterminals nvars + i ntokens) + (while (< i nsyms) + (if (wisent-BITISSET V i) + (setq nuseless-nonterminals (1- nuseless-nonterminals))) + (setq i (1+ i))) + + ;; A token that was used in %prec should not be warned about. + (setq i 1) + (while (<= i nrules) + (if (aref rprec i) + (wisent-SETBIT V1 (aref rprec i))) + (setq i (1+ i))) + )) + +(defun wisent-reduce-grammar-tables () + "Disable useless productions." + (if (> nuseless-productions 0) + (let ((pn 1)) + (while (<= pn nrules) + (aset ruseful pn (wisent-BITISSET P pn)) + (setq pn (1+ pn)))))) + +(defun wisent-nonterminals-reduce () + "Remove useless nonterminals." + (let (i n r item nontermmap tags-sorted) + ;; Map the nonterminals to their new index: useful first, useless + ;; afterwards. Kept for later report. + (setq nontermmap (make-vector nvars 0) + n ntokens + i ntokens) + (while (< i nsyms) + (when (wisent-BITISSET V i) + (aset nontermmap (- i ntokens) n) + (setq n (1+ n))) + (setq i (1+ i))) + (setq i ntokens) + (while (< i nsyms) + (unless (wisent-BITISSET V i) + (aset nontermmap (- i ntokens) n) + (setq n (1+ n))) + (setq i (1+ i))) + ;; Shuffle elements of tables indexed by symbol number + (setq tags-sorted (make-vector nvars nil) + i ntokens) + (while (< i nsyms) + (setq n (aref nontermmap (- i ntokens))) + (aset tags-sorted (- n ntokens) (aref tags i)) + (setq i (1+ i))) + (setq i ntokens) + (while (< i nsyms) + (aset tags i (aref tags-sorted (- i ntokens))) + (setq i (1+ i))) + ;; Replace all symbol numbers in valid data structures. + (setq i 1) + (while (<= i nrules) + (aset rlhs i (aref nontermmap (- (aref rlhs i) ntokens))) + (setq i (1+ i))) + (setq r 0) + (while (setq item (aref ritem r)) + (if (wisent-ISVAR item) + (aset ritem r (aref nontermmap (- item ntokens)))) + (setq r (1+ r))) + (setq start-symbol (aref nontermmap (- start-symbol ntokens)) + nsyms (- nsyms nuseless-nonterminals) + nvars (- nvars nuseless-nonterminals)) + )) + +(defun wisent-total-useless () + "Report number of useless nonterminals and productions." + (let* ((src (wisent-source)) + (src (if src (concat " in " src) "")) + (msg (format "Grammar%s contains" src))) + (if (> nuseless-nonterminals 0) + (setq msg (format "%s %d useless nonterminal%s" + msg nuseless-nonterminals + (if (> nuseless-nonterminals 0) "s" "")))) + (if (and (> nuseless-nonterminals 0) (> nuseless-productions 0)) + (setq msg (format "%s and" msg))) + (if (> nuseless-productions 0) + (setq msg (format "%s %d useless rule%s" + msg nuseless-productions + (if (> nuseless-productions 0) "s" "")))) + (message msg))) + +(defun wisent-reduce-grammar () + "Find unreachable terminals, nonterminals and productions." + ;; Allocate the global sets used to compute the reduced grammar + (setq N (make-vector (wisent-WORDSIZE nvars) 0) + P (make-vector (wisent-WORDSIZE (1+ nrules)) 0) + V (make-vector (wisent-WORDSIZE nsyms) 0) + V1 (make-vector (wisent-WORDSIZE nsyms) 0) + nuseless-nonterminals 0 + nuseless-productions 0) + + (wisent-useless-nonterminals) + (wisent-inaccessable-symbols) + + (when (> (+ nuseless-nonterminals nuseless-productions) 0) + (wisent-total-useless) + (or (wisent-BITISSET N (- start-symbol ntokens)) + (error "Start symbol `%s' does not derive any sentence" + (wisent-tag start-symbol))) + (wisent-reduce-grammar-tables) + (if (> nuseless-nonterminals 0) + (wisent-nonterminals-reduce)))) + +(defun wisent-print-useless () + "Output the detailed results of the reductions." + (let (i b r) + (when (> nuseless-nonterminals 0) + ;; Useless nonterminals have been moved after useful ones. + (wisent-log "\n\nUseless nonterminals:\n\n") + (setq i 0) + (while (< i nuseless-nonterminals) + (wisent-log " %s\n" (wisent-tag (+ nsyms i))) + (setq i (1+ i)))) + (setq b nil + i 0) + (while (< i ntokens) + (unless (or (wisent-BITISSET V i) (wisent-BITISSET V1 i)) + (or b + (wisent-log "\n\nTerminals which are not used:\n\n")) + (setq b t) + (wisent-log " %s\n" (wisent-tag i))) + (setq i (1+ i))) + (when (> nuseless-productions 0) + (wisent-log "\n\nUseless rules:\n\n") + (setq i 1) + (while (<= i nrules) + (unless (aref ruseful i) + (wisent-log "#%s " (wisent-pad-string (format "%d" i) 4)) + (wisent-log "%s:" (wisent-tag (aref rlhs i))) + (setq r (aref rrhs i)) + (while (natnump (aref ritem r)) + (wisent-log " %s" (wisent-tag (aref ritem r))) + (setq r (1+ r))) + (wisent-log ";\n")) + (setq i (1+ i)))) + (if (or b (> nuseless-nonterminals 0) (> nuseless-productions 0)) + (wisent-log "\n\n")) + )) + +;;;; ----------------------------- +;;;; Match rules with nonterminals +;;;; ----------------------------- + +(defun wisent-set-derives () + "Find, for each variable (nonterminal), which rules can derive it. +It sets up the value of DERIVES so that DERIVES[i - NTOKENS] points to +a list of rule numbers, terminated with -1." + (let (i lhs p q dset delts) + (setq dset (make-vector nvars nil) + delts (make-vector (1+ nrules) 0)) + (setq p 0 ;; p = delts + i nrules) + (while (> i 0) + (when (aref ruseful i) + (setq lhs (aref rlhs i)) + ;; p->next = dset[lhs]; + ;; p->value = i; + (aset delts p (cons i (aref dset (- lhs ntokens)))) ;; (value . next) + (aset dset (- lhs ntokens) p) ;; dset[lhs] = p + (setq p (1+ p)) ;; p++ + ) + (setq i (1- i))) + + (setq derives (make-vector nvars nil) + i ntokens) + + (while (< i nsyms) + (setq q nil + p (aref dset (- i ntokens))) ;; p = dset[i] + + (while p + (setq p (aref delts p) + q (cons (car p) q) ;;q++ = p->value + p (cdr p))) ;; p = p->next + (setq q (nreverse (cons -1 q))) ;; *q++ = -1 + (aset derives (- i ntokens) q) ;; derives[i] = q + (setq i (1+ i))) + )) + +;;;; -------------------------------------------------------- +;;;; Find which nonterminals can expand into the null string. +;;;; -------------------------------------------------------- + +(defun wisent-print-nullable () + "Print NULLABLE." + (let (i) + (wisent-log "NULLABLE\n") + (setq i ntokens) + (while (< i nsyms) + (wisent-log "\t%s: %s\n" (wisent-tag i) + (if (aref nullable (- i ntokens)) + "yes" : "no")) + (setq i (1+ i))) + (wisent-log "\n\n"))) + +(defun wisent-set-nullable () + "Set up NULLABLE. +A vector saying which nonterminals can expand into the null string. +NULLABLE[i - NTOKENS] is nil if symbol I can do so." + (let (ruleno s1 s2 p r squeue rcount rsets relts item any-tokens) + (setq squeue (make-vector nvars 0) + rcount (make-vector (1+ nrules) 0) + rsets (make-vector nvars nil) ;; - ntokens + relts (make-vector (+ nitems nvars 1) nil) + nullable (make-vector nvars nil)) ;; - ntokens + (setq s1 0 s2 0 ;; s1 = s2 = squeue + p 0 ;; p = relts + ruleno 1) + (while (<= ruleno nrules) + (when (aref ruseful ruleno) + (if (> (aref ritem (aref rrhs ruleno)) 0) + (progn + ;; This rule has a non empty RHS. + (setq any-tokens nil + r (aref rrhs ruleno)) + (while (> (aref ritem r) 0) + (if (wisent-ISTOKEN (aref ritem r)) + (setq any-tokens t)) + (setq r (1+ r))) + + ;; This rule has only nonterminals: schedule it for the + ;; second pass. + (unless any-tokens + (setq r (aref rrhs ruleno)) + (while (> (setq item (aref ritem r)) 0) + (aset rcount ruleno (1+ (aref rcount ruleno))) + ;; p->next = rsets[item]; + ;; p->value = ruleno; + (aset relts p (cons ruleno (aref rsets (- item ntokens)))) + ;; rsets[item] = p; + (aset rsets (- item ntokens) p) + (setq p (1+ p) + r (1+ r))))) + ;; This rule has an empty RHS. + ;; assert (ritem[rrhs[ruleno]] == -ruleno) + (when (and (aref ruseful ruleno) + (setq item (aref rlhs ruleno)) + (not (aref nullable (- item ntokens)))) + (aset nullable (- item ntokens) t) + (aset squeue s2 item) + (setq s2 (1+ s2))) + ) + ) + (setq ruleno (1+ ruleno))) + + (while (< s1 s2) + ;; p = rsets[*s1++] + (setq p (aref rsets (- (aref squeue s1) ntokens)) + s1 (1+ s1)) + (while p + (setq p (aref relts p) + ruleno (car p) + p (cdr p)) ;; p = p->next + ;; if (--rcount[ruleno] == 0) + (when (zerop (aset rcount ruleno (1- (aref rcount ruleno)))) + (setq item (aref rlhs ruleno)) + (aset nullable (- item ntokens) t) + (aset squeue s2 item) + (setq s2 (1+ s2))))) + + (if wisent-debug-flag + (wisent-print-nullable)) + )) + +;;;; ----------- +;;;; Subroutines +;;;; ----------- + +(defun wisent-print-fderives () + "Print FDERIVES." + (let (i j rp) + (wisent-log "\n\n\nFDERIVES\n") + (setq i ntokens) + (while (< i nsyms) + (wisent-log "\n\n%s derives\n\n" (wisent-tag i)) + (setq rp (aref fderives (- i ntokens)) + j 0) + (while (<= j nrules) + (if (wisent-BITISSET rp j) + (wisent-log " %d\n" j)) + (setq j (1+ j))) + (setq i (1+ i))))) + +(defun wisent-set-fderives () + "Set up FDERIVES. +An NVARS by NRULES matrix of bits indicating which rules can help +derive the beginning of the data for each nonterminal. For example, +if symbol 5 can be derived as the sequence of symbols 8 3 20, and one +of the rules for deriving symbol 8 is rule 4, then the +\[5 - NTOKENS, 4] bit in FDERIVES is set." + (let (i j k) + (setq fderives (make-vector nvars nil)) + (setq i 0) + (while (< i nvars) + (aset fderives i (make-vector rulesetsize 0)) + (setq i (1+ i))) + + (wisent-set-firsts) + + (setq i ntokens) + (while (< i nsyms) + (setq j ntokens) + (while (< j nsyms) + ;; if (BITISSET (FIRSTS (i), j - ntokens)) + (when (wisent-BITISSET (aref firsts (- i ntokens)) (- j ntokens)) + (setq k (aref derives (- j ntokens))) + (while (> (car k) 0) ;; derives[j][k] > 0 + ;; SETBIT (FDERIVES (i), derives[j][k]); + (wisent-SETBIT (aref fderives (- i ntokens)) (car k)) + (setq k (cdr k)))) + (setq j (1+ j))) + (setq i (1+ i))) + + (if wisent-debug-flag + (wisent-print-fderives)) + )) + +(defun wisent-print-firsts () + "Print FIRSTS." + (let (i j v) + (wisent-log "\n\n\nFIRSTS\n\n") + (setq i ntokens) + (while (< i nsyms) + (wisent-log "\n\n%s firsts\n\n" (wisent-tag i)) + (setq v (aref firsts (- i ntokens)) + j 0) + (while (< j nvars) + (if (wisent-BITISSET v j) + (wisent-log "\t\t%d (%s)\n" + (+ j ntokens) (wisent-tag (+ j ntokens)))) + (setq j (1+ j))) + (setq i (1+ i))))) + +(defun wisent-TC (R n) + "Transitive closure. +Given R an N by N matrix of bits, modify its contents to be the +transitive closure of what was given." + (let (i j k) + ;; R (J, I) && R (I, K) => R (J, K). + ;; I *must* be the outer loop. + (setq i 0) + (while (< i n) + (setq j 0) + (while (< j n) + (when (wisent-BITISSET (aref R j) i) + (setq k 0) + (while (< k n) + (if (wisent-BITISSET (aref R i) k) + (wisent-SETBIT (aref R j) k)) + (setq k (1+ k)))) + (setq j (1+ j))) + (setq i (1+ i))))) + +(defun wisent-RTC (R n) + "Reflexive Transitive Closure. +Same as `wisent-TC' and then set all the bits on the diagonal of R, an +N by N matrix of bits." + (let (i) + (wisent-TC R n) + (setq i 0) + (while (< i n) + (wisent-SETBIT (aref R i) i) + (setq i (1+ i))))) + +(defun wisent-set-firsts () + "Set up FIRSTS. +An NVARS by NVARS bit matrix indicating which items can represent the +beginning of the input corresponding to which other items. For +example, if some rule expands symbol 5 into the sequence of symbols 8 +3 20, the symbol 8 can be the beginning of the data for symbol 5, so +the bit [8 - NTOKENS, 5 - NTOKENS] in FIRSTS is set." + (let (row symbol sp rowsize i) + (setq rowsize (wisent-WORDSIZE nvars) + varsetsize rowsize + firsts (make-vector nvars nil) + i 0) + (while (< i nvars) + (aset firsts i (make-vector rowsize 0)) + (setq i (1+ i))) + + (setq row 0 ;; row = firsts + i ntokens) + (while (< i nsyms) + (setq sp (aref derives (- i ntokens))) + (while (>= (car sp) 0) + (setq symbol (aref ritem (aref rrhs (car sp))) + sp (cdr sp)) + (when (wisent-ISVAR symbol) + (setq symbol (- symbol ntokens)) + (wisent-SETBIT (aref firsts row) symbol) + )) + (setq row (1+ row) + i (1+ i))) + + (wisent-RTC firsts nvars) + + (if wisent-debug-flag + (wisent-print-firsts)) + )) + +(defun wisent-initialize-closure (n) + "Allocate the ITEMSET and RULESET vectors. +And precompute useful data so that `wisent-closure' can be called. +N is the number of elements to allocate for ITEMSET." + (setq itemset (make-vector n 0) + rulesetsize (wisent-WORDSIZE (1+ nrules)) + ruleset (make-vector rulesetsize 0)) + + (wisent-set-fderives)) + +(defun wisent-print-closure () + "Print ITEMSET." + (let (i) + (wisent-log "\n\nclosure n = %d\n\n" nitemset) + (setq i 0) ;; isp = itemset + (while (< i nitemset) + (wisent-log " %d\n" (aref itemset i)) + (setq i (1+ i))))) + +(defun wisent-closure (core n) + "Set up RULESET and ITEMSET for the transitions out of CORE state. +Given a vector of item numbers items, of length N, set up RULESET and +ITEMSET to indicate what rules could be run and which items could be +accepted when those items are the active ones. + +RULESET contains a bit for each rule. `wisent-closure' sets the bits +for all rules which could potentially describe the next input to be +read. + +ITEMSET is a vector of item numbers; NITEMSET is the number of items +in ITEMSET. `wisent-closure' places there the indices of all items +which represent units of input that could arrive next." + (let (c r v symbol ruleno itemno) + (if (zerop n) + (progn + (setq r 0 + v (aref fderives (- start-symbol ntokens))) + (while (< r rulesetsize) + ;; ruleset[r] = FDERIVES (start-symbol)[r]; + (aset ruleset r (aref v r)) + (setq r (1+ r))) + ) + (fillarray ruleset 0) + (setq c 0) + (while (< c n) + (setq symbol (aref ritem (aref core c))) + (when (wisent-ISVAR symbol) + (setq r 0 + v (aref fderives (- symbol ntokens))) + (while (< r rulesetsize) + ;; ruleset[r] |= FDERIVES (ritem[core[c]])[r]; + (aset ruleset r (logior (aref ruleset r) (aref v r))) + (setq r (1+ r)))) + (setq c (1+ c))) + ) + (setq nitemset 0 + c 0 + ruleno 0 + r (* rulesetsize wisent-BITS-PER-WORD)) + (while (< ruleno r) + (when (wisent-BITISSET ruleset ruleno) + (setq itemno (aref rrhs ruleno)) + (while (and (< c n) (< (aref core c) itemno)) + (aset itemset nitemset (aref core c)) + (setq nitemset (1+ nitemset) + c (1+ c))) + (aset itemset nitemset itemno) + (setq nitemset (1+ nitemset))) + (setq ruleno (1+ ruleno))) + + (while (< c n) + (aset itemset nitemset (aref core c)) + (setq nitemset (1+ nitemset) + c (1+ c))) + + (if wisent-debug-flag + (wisent-print-closure)) + )) + +;;;; -------------------------------------------------- +;;;; Generate the nondeterministic finite state machine +;;;; -------------------------------------------------- + +(defun wisent-allocate-itemsets () + "Allocate storage for itemsets." + (let (symbol i count symbol-count) + ;; Count the number of occurrences of all the symbols in RITEMS. + ;; Note that useless productions (hence useless nonterminals) are + ;; browsed too, hence we need to allocate room for _all_ the + ;; symbols. + (setq count 0 + symbol-count (make-vector (+ nsyms nuseless-nonterminals) 0) + i 0) + (while (setq symbol (aref ritem i)) + (when (> symbol 0) + (setq count (1+ count)) + (aset symbol-count symbol (1+ (aref symbol-count symbol)))) + (setq i (1+ i))) + ;; See comments before `wisent-new-itemsets'. All the vectors of + ;; items live inside kernel-items. The number of active items + ;; after some symbol cannot be more than the number of times that + ;; symbol appears as an item, which is symbol-count[symbol]. We + ;; allocate that much space for each symbol. + (setq kernel-base (make-vector nsyms nil) + kernel-items (make-vector count 0) + count 0 + i 0) + (while (< i nsyms) + (aset kernel-base i count) + (setq count (+ count (aref symbol-count i)) + i (1+ i))) + (setq shift-symbol symbol-count + kernel-end (make-vector nsyms nil)) + )) + +(defun wisent-allocate-storage () + "Allocate storage for the state machine." + (wisent-allocate-itemsets) + (setq shiftset (make-vector nsyms 0) + redset (make-vector (1+ nrules) 0) + state-table (make-vector wisent-state-table-size nil))) + +(defun wisent-new-itemsets () + "Find which symbols can be shifted in the current state. +And for each one record which items would be active after that shift. +Uses the contents of ITEMSET. SHIFT-SYMBOL is set to a vector of the +symbols that can be shifted. For each symbol in the grammar, +KERNEL-BASE[symbol] points to a vector of item numbers activated if +that symbol is shifted, and KERNEL-END[symbol] points after the end of +that vector." + (let (i shiftcount isp ksp symbol) + (fillarray kernel-end nil) + (setq shiftcount 0 + isp 0) + (while (< isp nitemset) + (setq i (aref itemset isp) + isp (1+ isp) + symbol (aref ritem i)) + (when (> symbol 0) + (setq ksp (aref kernel-end symbol)) + (when (not ksp) + ;; shift-symbol[shiftcount++] = symbol; + (aset shift-symbol shiftcount symbol) + (setq shiftcount (1+ shiftcount) + ksp (aref kernel-base symbol))) + ;; *ksp++ = i + 1; + (aset kernel-items ksp (1+ i)) + (setq ksp (1+ ksp)) + (aset kernel-end symbol ksp))) + (setq nshifts shiftcount))) + +(defun wisent-new-state (symbol) + "Create a new state for those items, if necessary. +SYMBOL is the core accessing-symbol. +Subroutine of `wisent-get-state'." + (let (n p isp1 isp2 iend items) + (setq isp1 (aref kernel-base symbol) + iend (aref kernel-end symbol) + n (- iend isp1) + p (make-core) + items (make-vector n 0)) + (set-core-accessing-symbol p symbol) + (set-core-number p nstates) + (set-core-nitems p n) + (set-core-items p items) + (setq isp2 0) ;; isp2 = p->items + (while (< isp1 iend) + ;; *isp2++ = *isp1++; + (aset items isp2 (aref kernel-items isp1)) + (setq isp1 (1+ isp1) + isp2 (1+ isp2))) + (set-core-next last-state p) + (setq last-state p + nstates (1+ nstates)) + p)) + +(defun wisent-get-state (symbol) + "Find the state we would get to by shifting SYMBOL. +Return the state number for the state we would get to (from the +current state) by shifting SYMBOL. Create a new state if no +equivalent one exists already. Used by `wisent-append-states'." + (let (key isp1 isp2 iend sp sp2 found n) + (setq isp1 (aref kernel-base symbol) + iend (aref kernel-end symbol) + n (- iend isp1) + key 0) + ;; Add up the target state's active item numbers to get a hash key + (while (< isp1 iend) + (setq key (+ key (aref kernel-items isp1)) + isp1 (1+ isp1))) + (setq key (% key wisent-state-table-size) + sp (aref state-table key)) + (if sp + (progn + (setq found nil) + (while (not found) + (when (= (core-nitems sp) n) + (setq found t + isp1 (aref kernel-base symbol) + ;; isp2 = sp->items; + sp2 (core-items sp) + isp2 0) + + (while (and found (< isp1 iend)) + ;; if (*isp1++ != *isp2++) + (if (not (= (aref kernel-items isp1) + (aref sp2 isp2))) + (setq found nil)) + (setq isp1 (1+ isp1) + isp2 (1+ isp2)))) + (if (not found) + (if (core-link sp) + (setq sp (core-link sp)) + ;; sp = sp->link = new-state(symbol) + (setq sp (set-core-link sp (wisent-new-state symbol)) + found t))))) + ;; bucket is empty + ;; state-table[key] = sp = new-state(symbol) + (setq sp (wisent-new-state symbol)) + (aset state-table key sp)) + ;; return (sp->number); + (core-number sp))) + +(defun wisent-append-states () + "Find or create the core structures for states. +Use the information computed by `wisent-new-itemsets' to find the +state numbers reached by each shift transition from the current state. +SHIFTSET is set up as a vector of state numbers of those states." + (let (i j symbol) + ;; First sort shift-symbol into increasing order + (setq i 1) + (while (< i nshifts) + (setq symbol (aref shift-symbol i) + j i) + (while (and (> j 0) (> (aref shift-symbol (1- j)) symbol)) + (aset shift-symbol j (aref shift-symbol (1- j))) + (setq j (1- j))) + (aset shift-symbol j symbol) + (setq i (1+ i))) + (setq i 0) + (while (< i nshifts) + (setq symbol (aref shift-symbol i)) + (aset shiftset i (wisent-get-state symbol)) + (setq i (1+ i))) + )) + +(defun wisent-initialize-states () + "Initialize states." + (let ((p (make-core))) + (setq first-state p + last-state p + this-state p + nstates 1))) + +(defun wisent-save-shifts () + "Save the NSHIFTS of SHIFTSET into the current linked list." + (let (p i shifts) + (setq p (make-shifts) + shifts (make-vector nshifts 0) + i 0) + (set-shifts-number p (core-number this-state)) + (set-shifts-nshifts p nshifts) + (set-shifts-shifts p shifts) + (while (< i nshifts) + ;; (p->shifts)[i] = shiftset[i]; + (aset shifts i (aref shiftset i)) + (setq i (1+ i))) + + (if last-shift + (set-shifts-next last-shift p) + (setq first-shift p)) + (setq last-shift p))) + +(defun wisent-insert-start-shift () + "Create the next-to-final state. +That is the state to which a shift has already been made in the +initial state. Subroutine of `wisent-augment-automaton'." + (let (statep sp) + (setq statep (make-core)) + (set-core-number statep nstates) + (set-core-accessing-symbol statep start-symbol) + (set-core-next last-state statep) + (setq last-state statep) + ;; Make a shift from this state to (what will be) the final state. + (setq sp (make-shifts)) + (set-shifts-number sp nstates) + (setq nstates (1+ nstates)) + (set-shifts-nshifts sp 1) + (set-shifts-shifts sp (vector nstates)) + (set-shifts-next last-shift sp) + (setq last-shift sp))) + +(defun wisent-augment-automaton () + "Set up initial and final states as parser wants them. +Make sure that the initial state has a shift that accepts the +grammar's start symbol and goes to the next-to-final state, which has +a shift going to the final state, which has a shift to the termination +state. Create such states and shifts if they don't happen to exist +already." + (let (i k statep sp sp2 sp1 shifts) + (setq sp first-shift) + (if sp + (progn + (if (zerop (shifts-number sp)) + (progn + (setq k (shifts-nshifts sp) + statep (core-next first-state)) + ;; The states reached by shifts from first-state are + ;; numbered 1...K. Look for one reached by + ;; START-SYMBOL. + (while (and (< (core-accessing-symbol statep) start-symbol) + (< (core-number statep) k)) + (setq statep (core-next statep))) + (if (= (core-accessing-symbol statep) start-symbol) + (progn + ;; We already have a next-to-final state. Make + ;; sure it has a shift to what will be the final + ;; state. + (setq k (core-number statep)) + (while (and sp (< (shifts-number sp) k)) + (setq sp1 sp + sp (shifts-next sp))) + (if (and sp (= (shifts-number sp) k)) + (progn + (setq i (shifts-nshifts sp) + sp2 (make-shifts) + shifts (make-vector (1+ i) 0)) + (set-shifts-number sp2 k) + (set-shifts-nshifts sp2 (1+ i)) + (set-shifts-shifts sp2 shifts) + (aset shifts 0 nstates) + (while (> i 0) + ;; sp2->shifts[i] = sp->shifts[i - 1]; + (aset shifts i (aref (shifts-shifts sp) (1- i))) + (setq i (1- i))) + ;; Patch sp2 into the chain of shifts in + ;; place of sp, following sp1. + (set-shifts-next sp2 (shifts-next sp)) + (set-shifts-next sp1 sp2) + (if (eq sp last-shift) + (setq last-shift sp2)) + ) + (setq sp2 (make-shifts)) + (set-shifts-number sp2 k) + (set-shifts-nshifts sp2 1) + (set-shifts-shifts sp2 (vector nstates)) + ;; Patch sp2 into the chain of shifts between + ;; sp1 and sp. + (set-shifts-next sp2 sp) + (set-shifts-next sp1 sp2) + (if (not sp) + (setq last-shift sp2)) + ) + ) + ;; There is no next-to-final state as yet. + ;; Add one more shift in FIRST-SHIFT, going to the + ;; next-to-final state (yet to be made). + (setq sp first-shift + sp2 (make-shifts) + i (shifts-nshifts sp) + shifts (make-vector (1+ i) 0)) + (set-shifts-nshifts sp2 (1+ i)) + (set-shifts-shifts sp2 shifts) + ;; Stick this shift into the vector at the proper place. + (setq statep (core-next first-state) + k 0 + i 0) + (while (< i (shifts-nshifts sp)) + (when (and (> (core-accessing-symbol statep) start-symbol) + (= i k)) + (aset shifts k nstates) + (setq k (1+ k))) + (aset shifts k (aref (shifts-shifts sp) i)) + (setq statep (core-next statep)) + (setq i (1+ i) + k (1+ k))) + (when (= i k) + (aset shifts k nstates) + (setq k (1+ k))) + ;; Patch sp2 into the chain of shifts in place of + ;; sp, at the beginning. + (set-shifts-next sp2 (shifts-next sp)) + (setq first-shift sp2) + (if (eq last-shift sp) + (setq last-shift sp2)) + ;; Create the next-to-final state, with shift to + ;; what will be the final state. + (wisent-insert-start-shift))) + ;; The initial state didn't even have any shifts. Give it + ;; one shift, to the next-to-final state. + (setq sp (make-shifts)) + (set-shifts-nshifts sp 1) + (set-shifts-shifts sp (vector nstates)) + ;; Patch sp into the chain of shifts at the beginning. + (set-shifts-next sp first-shift) + (setq first-shift sp) + ;; Create the next-to-final state, with shift to what will + ;; be the final state. + (wisent-insert-start-shift))) + ;; There are no shifts for any state. Make one shift, from the + ;; initial state to the next-to-final state. + (setq sp (make-shifts)) + (set-shifts-nshifts sp 1) + (set-shifts-shifts sp (vector nstates)) + ;; Initialize the chain of shifts with sp. + (setq first-shift sp + last-shift sp) + ;; Create the next-to-final state, with shift to what will be + ;; the final state. + (wisent-insert-start-shift)) + ;; Make the final state--the one that follows a shift from the + ;; next-to-final state. The symbol for that shift is 0 + ;; (end-of-file). + (setq statep (make-core)) + (set-core-number statep nstates) + (set-core-next last-state statep) + (setq last-state statep) + ;; Make the shift from the final state to the termination state. + (setq sp (make-shifts)) + (set-shifts-number sp nstates) + (setq nstates (1+ nstates)) + (set-shifts-nshifts sp 1) + (set-shifts-shifts sp (vector nstates)) + (set-shifts-next last-shift sp) + (setq last-shift sp) + ;; Note that the variable FINAL-STATE refers to what we sometimes + ;; call the termination state. + (setq final-state nstates) + ;; Make the termination state. + (setq statep (make-core)) + (set-core-number statep nstates) + (setq nstates (1+ nstates)) + (set-core-next last-state statep) + (setq last-state statep))) + +(defun wisent-save-reductions () + "Make a reductions structure. +Find which rules can be used for reduction transitions from the +current state and make a reductions structure for the state to record +their rule numbers." + (let (i item count p rules) + ;; Find and count the active items that represent ends of rules. + (setq count 0 + i 0) + (while (< i nitemset) + (setq item (aref ritem (aref itemset i))) + (when (< item 0) + (aset redset count (- item)) + (setq count (1+ count))) + (setq i (1+ i))) + ;; Make a reductions structure and copy the data into it. + (when (> count 0) + (setq p (make-reductions) + rules (make-vector count 0)) + (set-reductions-number p (core-number this-state)) + (set-reductions-nreds p count) + (set-reductions-rules p rules) + (setq i 0) + (while (< i count) + ;; (p->rules)[i] = redset[i] + (aset rules i (aref redset i)) + (setq i (1+ i))) + (if last-reduction + (set-reductions-next last-reduction p) + (setq first-reduction p)) + (setq last-reduction p)))) + +(defun wisent-generate-states () + "Compute the nondeterministic finite state machine from the grammar." + (working-dynamic-status "(compute nondeterministic finite state machine)") + (wisent-allocate-storage) + (wisent-initialize-closure nitems) + (wisent-initialize-states) + (while this-state + ;; Set up RULESET and ITEMSET for the transitions out of this + ;; state. RULESET gets a 1 bit for each rule that could reduce + ;; now. ITEMSET gets a vector of all the items that could be + ;; accepted next. + (wisent-closure (core-items this-state) (core-nitems this-state)) + ;; Record the reductions allowed out of this state. + (wisent-save-reductions) + ;; Find the itemsets of the states that shifts can reach. + (wisent-new-itemsets) + ;; Find or create the core structures for those states. + (wisent-append-states) + ;; Create the shifts structures for the shifts to those states, + ;; now that the state numbers transitioning to are known. + (if (> nshifts 0) + (wisent-save-shifts)) + ;; States are queued when they are created; process them all. + (setq this-state (core-next this-state))) + ;; Set up initial and final states as parser wants them. + (wisent-augment-automaton)) + +;;;; --------------------------- +;;;; Compute look-ahead criteria +;;;; --------------------------- + +;; Compute how to make the finite state machine deterministic; find +;; which rules need lookahead in each state, and which lookahead +;; tokens they accept. + +;; `wisent-lalr', the entry point, builds these data structures: + +;; GOTO-MAP, FROM-STATE and TO-STATE record each shift transition +;; which accepts a variable (a nonterminal). NGOTOS is the number of +;; such transitions. +;; FROM-STATE[t] is the state number which a transition leads from and +;; TO-STATE[t] is the state number it leads to. +;; All the transitions that accept a particular variable are grouped +;; together and GOTO-MAP[i - NTOKENS] is the index in FROM-STATE and +;; TO-STATE of the first of them. + +;; CONSISTENT[s] is non-nil if no lookahead is needed to decide what +;; to do in state s. + +;; LARULENO is a vector which records the rules that need lookahead in +;; various states. The elements of LARULENO that apply to state s are +;; those from LOOKAHEADS[s] through LOOKAHEADS[s+1]-1. Each element +;; of LARULENO is a rule number. + +;; If LR is the length of LARULENO, then a number from 0 to LR-1 can +;; specify both a rule and a state where the rule might be applied. +;; LA is a LR by NTOKENS matrix of bits. +;; LA[l, i] is 1 if the rule LARULENO[l] is applicable in the +;; appropriate state when the next token is symbol i. +;; If LA[l, i] and LA[l, j] are both 1 for i != j, it is a conflict. + +(wisent-defcontext digraph + INDEX R VERTICES + infinity top) + +(defun wisent-traverse (i) + "Traverse I." + (let (j k height Ri Fi break) + (setq top (1+ top) + height top) + (aset VERTICES top i) ;; VERTICES[++top] = i + (aset INDEX i top) ;; INDEX[i] = height = top + + (setq Ri (aref R i)) + (when Ri + (setq j 0) + (while (>= (aref Ri j) 0) + (if (zerop (aref INDEX (aref Ri j))) + (wisent-traverse (aref Ri j))) + ;; if (INDEX[i] > INDEX[R[i][j]]) + (if (> (aref INDEX i) (aref INDEX (aref Ri j))) + ;; INDEX[i] = INDEX[R[i][j]]; + (aset INDEX i (aref INDEX (aref Ri j)))) + (setq Fi (aref F i) + k 0) + (while (< k tokensetsize) + ;; F (i)[k] |= F (R[i][j])[k]; + (aset Fi k (logior (aref Fi k) + (aref (aref F (aref Ri j)) k))) + (setq k (1+ k))) + (setq j (1+ j)))) + + (when (= (aref INDEX i) height) + (setq break nil) + (while (not break) + (setq j (aref VERTICES top) ;; j = VERTICES[top--] + top (1- top)) + (aset INDEX j infinity) + (if (= i j) + (setq break t) + (setq k 0) + (while (< k tokensetsize) + ;; F (j)[k] = F (i)[k]; + (aset (aref F j) k (aref (aref F i) k)) + (setq k (1+ k)))))) + )) + +(defun wisent-digraph (relation) + "Digraph RELATION." + (wisent-with-context digraph + (setq infinity (+ ngotos 2) + INDEX (make-vector (1+ ngotos) 0) + VERTICES (make-vector (1+ ngotos) 0) + top 0 + R relation) + (let ((i 0)) + (while (< i ngotos) + (if (and (= (aref INDEX i) 0) (aref R i)) + (wisent-traverse i)) + (setq i (1+ i)))))) + +(defun wisent-set-state-table () + "Build state table." + (let (sp) + (setq state-table (make-vector nstates nil) + sp first-state) + (while sp + (aset state-table (core-number sp) sp) + (setq sp (core-next sp))))) + +(defun wisent-set-accessing-symbol () + "Build accessing symbol table." + (let (sp) + (setq accessing-symbol (make-vector nstates 0) + sp first-state) + (while sp + (aset accessing-symbol (core-number sp) (core-accessing-symbol sp)) + (setq sp (core-next sp))))) + +(defun wisent-set-shift-table () + "Build shift table." + (let (sp) + (setq shift-table (make-vector nstates nil) + sp first-shift) + (while sp + (aset shift-table (shifts-number sp) sp) + (setq sp (shifts-next sp))))) + +(defun wisent-set-reduction-table () + "Build reduction table." + (let (rp) + (setq reduction-table (make-vector nstates nil) + rp first-reduction) + (while rp + (aset reduction-table (reductions-number rp) rp) + (setq rp (reductions-next rp))))) + +(defun wisent-set-maxrhs () + "Setup MAXRHS length." + (let (i len max) + (setq len 0 + max 0 + i 0) + (while (aref ritem i) + (if (> (aref ritem i) 0) + (setq len (1+ len)) + (if (> len max) + (setq max len)) + (setq len 0)) + (setq i (1+ i))) + (setq maxrhs max))) + +(defun wisent-initialize-LA () + "Set up LA." + (let (i j k count rp sp np v) + (setq consistent (make-vector nstates nil) + lookaheads (make-vector (1+ nstates) 0) + count 0 + i 0) + (while (< i nstates) + (aset lookaheads i count) + (setq rp (aref reduction-table i) + sp (aref shift-table i)) + ;; if (rp && + ;; (rp->nreds > 1 + ;; || (sp && ! ISVAR(accessing-symbol[sp->shifts[0]])))) + (if (and rp + (or (> (reductions-nreds rp) 1) + (and sp + (not (wisent-ISVAR + (aref accessing-symbol + (aref (shifts-shifts sp) 0))))))) + (setq count (+ count (reductions-nreds rp))) + (aset consistent i t)) + + (when sp + (setq k 0 + j (shifts-nshifts sp) + v (shifts-shifts sp)) + (while (< k j) + (when (= (aref accessing-symbol (aref v k)) + error-token-number) + (aset consistent i nil) + (setq k j)) ;; break + (setq k (1+ k)))) + (setq i (1+ i))) + + (aset lookaheads nstates count) + + (if (zerop count) + (progn + (setq LA (make-vector 1 nil) + LAruleno (make-vector 1 0) + lookback (make-vector 1 nil))) + (setq LA (make-vector count nil) + LAruleno (make-vector count 0) + lookback (make-vector count nil))) + (setq i 0 j (length LA)) + (while (< i j) + (aset LA i (make-vector tokensetsize 0)) + (setq i (1+ i))) + + (setq np 0 + i 0) + (while (< i nstates) + (when (not (aref consistent i)) + (setq rp (aref reduction-table i)) + (when rp + (setq j 0 + k (reductions-nreds rp) + v (reductions-rules rp)) + (while (< j k) + (aset LAruleno np (aref v j)) + (setq np (1+ np) + j (1+ j))))) + (setq i (1+ i))))) + +(defun wisent-set-goto-map () + "Set up GOTO-MAP." + (let (sp i j symbol k temp-map state1 state2 v) + (setq goto-map (make-vector (1+ nvars) 0) + temp-map (make-vector (1+ nvars) 0)) + + (setq ngotos 0 + sp first-shift) + (while sp + (setq i (1- (shifts-nshifts sp)) + v (shifts-shifts sp)) + (while (>= i 0) + (setq symbol (aref accessing-symbol (aref v i))) + (if (wisent-ISTOKEN symbol) + (setq i 0) ;; break + (setq ngotos (1+ ngotos)) + ;; goto-map[symbol]++; + (aset goto-map (- symbol ntokens) + (1+ (aref goto-map (- symbol ntokens))))) + (setq i (1- i))) + (setq sp (shifts-next sp))) + + (setq k 0 + i ntokens + j 0) + (while (< i nsyms) + (aset temp-map j k) + (setq k (+ k (aref goto-map j)) + i (1+ i) + j (1+ j))) + (setq i ntokens + j 0) + (while (< i nsyms) + (aset goto-map j (aref temp-map j)) + (setq i (1+ i) + j (1+ j))) + ;; goto-map[nsyms] = ngotos; + ;; temp-map[nsyms] = ngotos; + (aset goto-map j ngotos) + (aset temp-map j ngotos) + + (setq from-state (make-vector ngotos 0) + to-state (make-vector ngotos 0) + sp first-shift) + (while sp + (setq state1 (shifts-number sp) + v (shifts-shifts sp) + i (1- (shifts-nshifts sp))) + (while (>= i 0) + (setq state2 (aref v i) + symbol (aref accessing-symbol state2)) + (if (wisent-ISTOKEN symbol) + (setq i 0) ;; break + ;; k = temp-map[symbol]++; + (setq k (aref temp-map (- symbol ntokens))) + (aset temp-map (- symbol ntokens) (1+ k)) + (aset from-state k state1) + (aset to-state k state2)) + (setq i (1- i))) + (setq sp (shifts-next sp))) + )) + +(defun wisent-map-goto (state symbol) + "Map a STATE/SYMBOL pair into its numeric representation." + (let (high low middle s result) + ;; low = goto-map[symbol]; + ;; high = goto-map[symbol + 1] - 1; + (setq low (aref goto-map (- symbol ntokens)) + high (1- (aref goto-map (- (1+ symbol) ntokens)))) + (while (and (not result) (<= low high)) + (setq middle (/ (+ low high) 2) + s (aref from-state middle)) + (cond + ((= s state) + (setq result middle)) + ((< s state) + (setq low (1+ middle))) + (t + (setq high (1- middle))))) + (or result + (error "Internal error in `wisent-map-goto'")) + )) + +(defun wisent-initialize-F () + "Set up F." + (let (i j k sp edge rowp rp reads nedges stateno symbol v break) + (setq F (make-vector ngotos nil) + i 0) + (while (< i ngotos) + (aset F i (make-vector tokensetsize 0)) + (setq i (1+ i))) + + (setq reads (make-vector ngotos nil) + edge (make-vector (1+ ngotos) 0) + nedges 0 + rowp 0 ;; rowp = F + i 0) + (while (< i ngotos) + (setq stateno (aref to-state i) + sp (aref shift-table stateno)) + (when sp + (setq k (shifts-nshifts sp) + v (shifts-shifts sp) + j 0 + break nil) + (while (and (not break) (< j k)) + ;; symbol = accessing-symbol[sp->shifts[j]]; + (setq symbol (aref accessing-symbol (aref v j))) + (if (wisent-ISVAR symbol) + (setq break t) ;; break + (wisent-SETBIT (aref F rowp) symbol) + (setq j (1+ j)))) + + (while (< j k) + ;; symbol = accessing-symbol[sp->shifts[j]]; + (setq symbol (aref accessing-symbol (aref v j))) + (when (aref nullable (- symbol ntokens)) + (aset edge nedges (wisent-map-goto stateno symbol)) + (setq nedges (1+ nedges))) + (setq j (1+ j))) + + (when (> nedges 0) + ;; reads[i] = rp = NEW2(nedges + 1, short); + (setq rp (make-vector (1+ nedges) 0) + j 0) + (aset reads i rp) + (while (< j nedges) + ;; rp[j] = edge[j]; + (aset rp j (aref edge j)) + (setq j (1+ j))) + (aset rp nedges -1) + (setq nedges 0))) + (setq rowp (1+ rowp)) + (setq i (1+ i))) + (wisent-digraph reads) + )) + +(defun wisent-add-lookback-edge (stateno ruleno gotono) + "Add a lookback edge. +STATENO, RULENO, GOTONO are self-explanatory." + (let (i k found) + (setq i (aref lookaheads stateno) + k (aref lookaheads (1+ stateno)) + found nil) + (while (and (not found) (< i k)) + (if (= (aref LAruleno i) ruleno) + (setq found t) + (setq i (1+ i)))) + + (or found + (error "Internal error in `wisent-add-lookback-edge'")) + + ;; value . next + ;; lookback[i] = (gotono . lookback[i]) + (aset lookback i (cons gotono (aref lookback i))))) + +(defun wisent-transpose (R-arg n) + "Return the transpose of R-ARG, of size N. +Destroy R-ARG, as it is replaced with the result. R-ARG[I] is nil or +a -1 terminated list of numbers. RESULT[NUM] is nil or the -1 +terminated list of the I such as NUM is in R-ARG[I]." + (let (i j new-R end-R nedges v sp) + (setq new-R (make-vector n nil) + end-R (make-vector n nil) + nedges (make-vector n 0)) + + ;; Count. + (setq i 0) + (while (< i n) + (setq v (aref R-arg i)) + (when v + (setq j 0) + (while (>= (aref v j) 0) + (aset nedges (aref v j) (1+ (aref nedges (aref v j)))) + (setq j (1+ j)))) + (setq i (1+ i))) + + ;; Allocate. + (setq i 0) + (while (< i n) + (when (> (aref nedges i) 0) + (setq sp (make-vector (1+ (aref nedges i)) 0)) + (aset sp (aref nedges i) -1) + (aset new-R i sp) + (aset end-R i 0)) + (setq i (1+ i))) + + ;; Store. + (setq i 0) + (while (< i n) + (setq v (aref R-arg i)) + (when v + (setq j 0) + (while (>= (aref v j) 0) + (aset (aref new-R (aref v j)) (aref end-R (aref v j)) i) + (aset end-R (aref v j) (1+ (aref end-R (aref v j)))) + (setq j (1+ j)))) + (setq i (1+ i))) + + new-R)) + +(defun wisent-build-relations () + "Build relations." + (let (i j k rulep rp sp length nedges done state1 stateno + symbol1 symbol2 edge states v) + (setq includes (make-vector ngotos nil) + edge (make-vector (1+ ngotos) 0) + states (make-vector (1+ maxrhs) 0) + i 0) + + (while (< i ngotos) + (setq nedges 0 + state1 (aref from-state i) + symbol1 (aref accessing-symbol (aref to-state i)) + rulep (aref derives (- symbol1 ntokens))) + + (while (> (car rulep) 0) + (aset states 0 state1) + (setq length 1 + stateno state1 + rp (aref rrhs (car rulep))) ;; rp = ritem + rrhs[*rulep] + (while (> (aref ritem rp) 0) ;; *rp > 0 + (setq symbol2 (aref ritem rp) + sp (aref shift-table stateno) + k (shifts-nshifts sp) + v (shifts-shifts sp) + j 0) + (while (< j k) + (setq stateno (aref v j)) + (if (= (aref accessing-symbol stateno) symbol2) + (setq j k) ;; break + (setq j (1+ j)))) + ;; states[length++] = stateno; + (aset states length stateno) + (setq length (1+ length)) + (setq rp (1+ rp))) + + (if (not (aref consistent stateno)) + (wisent-add-lookback-edge stateno (car rulep) i)) + + (setq length (1- length) + done nil) + (while (not done) + (setq done t + rp (1- rp)) + (when (and (>= rp 0) (wisent-ISVAR (aref ritem rp))) + ;; stateno = states[--length]; + (setq length (1- length) + stateno (aref states length)) + (aset edge nedges (wisent-map-goto stateno (aref ritem rp))) + (setq nedges (1+ nedges)) + (if (aref nullable (- (aref ritem rp) ntokens)) + (setq done nil)))) + (setq rulep (cdr rulep))) + + (when (> nedges 0) + (setq v (make-vector (1+ nedges) 0) + j 0) + (aset includes i v) + (while (< j nedges) + (aset v j (aref edge j)) + (setq j (1+ j))) + (aset v nedges -1)) + (setq i (1+ i))) + + (setq includes (wisent-transpose includes ngotos)) + )) + +(defun wisent-compute-FOLLOWS () + "Compute follows." + (wisent-digraph includes)) + +(defun wisent-compute-lookaheads () + "Compute lookaheads." + (let (i j n v1 v2 sp) + (setq n (aref lookaheads nstates) + i 0) + (while (< i n) + (setq sp (aref lookback i)) + (while sp + (setq v1 (aref LA i) + v2 (aref F (car sp)) + j 0) + (while (< j tokensetsize) + ;; LA (i)[j] |= F (sp->value)[j] + (aset v1 j (logior (aref v1 j) (aref v2 j))) + (setq j (1+ j))) + (setq sp (cdr sp))) + (setq i (1+ i))))) + +(defun wisent-lalr () + "Make the nondeterministic finite state machine deterministic." + (working-dynamic-status "(make finite state machine deterministic)") + (setq tokensetsize (wisent-WORDSIZE ntokens)) + (wisent-set-state-table) + (wisent-set-accessing-symbol) + (wisent-set-shift-table) + (wisent-set-reduction-table) + (wisent-set-maxrhs) + (wisent-initialize-LA) + (wisent-set-goto-map) + (wisent-initialize-F) + (wisent-build-relations) + (wisent-compute-FOLLOWS) + (wisent-compute-lookaheads)) + +;;;; ----------------------------------------------- +;;;; Find and resolve or report look-ahead conflicts +;;;; ----------------------------------------------- + +(defsubst wisent-log-resolution (state LAno token resolution) + "Log a shift-reduce conflict resolution. +In specified STATE between rule pointed by lookahead number LANO and +TOKEN, resolved as RESOLUTION." + (if (or wisent-verbose-flag wisent-debug-flag) + (wisent-log + "Conflict in state %d between rule %d and token %s resolved as %s.\n" + state (aref LAruleno LAno) (wisent-tag token) resolution))) + +(defun wisent-flush-shift (state token) + "Turn off the shift recorded in the specified STATE for TOKEN. +Used when we resolve a shift-reduce conflict in favor of the reduction." + (let (shiftp i k v) + (when (setq shiftp (aref shift-table state)) + (setq k (shifts-nshifts shiftp) + v (shifts-shifts shiftp) + i 0) + (while (< i k) + (if (and (not (zerop (aref v i))) + (= token (aref accessing-symbol (aref v i)))) + (aset v i 0)) + (setq i (1+ i)))))) + +(defun wisent-resolve-sr-conflict (state lookaheadnum) + "Attempt to resolve shift-reduce conflict for one rule. +Resolve by means of precedence declarations. The conflict occurred in +specified STATE for the rule pointed by the lookahead symbol +LOOKAHEADNUM. It has already been checked that the rule has a +precedence. A conflict is resolved by modifying the shift or reduce +tables so that there is no longer a conflict." + (let (i redprec errp errs nerrs token sprec sassoc) + ;; Find the rule to reduce by to get precedence of reduction + (setq token (aref tags (aref rprec (aref LAruleno lookaheadnum))) + redprec (wisent-prec token) + errp (make-errs) + errs (make-vector ntokens 0) + nerrs 0 + i 0) + (set-errs-errs errp errs) + (while (< i ntokens) + (setq token (aref tags i)) + (when (and (wisent-BITISSET (aref LA lookaheadnum) i) + (wisent-BITISSET lookaheadset i) + (setq sprec (wisent-prec token))) + ;; Shift-reduce conflict occurs for token number I and it has + ;; a precedence. The precedence of shifting is that of token + ;; I. + (cond + ((< sprec redprec) + (wisent-log-resolution state lookaheadnum i "reduce") + ;; Flush the shift for this token + (wisent-RESETBIT lookaheadset i) + (wisent-flush-shift state i) + ) + ((> sprec redprec) + (wisent-log-resolution state lookaheadnum i "shift") + ;; Flush the reduce for this token + (wisent-RESETBIT (aref LA lookaheadnum) i) + ) + (t + ;; Matching precedence levels. + ;; For left association, keep only the reduction. + ;; For right association, keep only the shift. + ;; For nonassociation, keep neither. + (setq sassoc (wisent-assoc token)) + (cond + ((eq sassoc 'right) + (wisent-log-resolution state lookaheadnum i "shift")) + ((eq sassoc 'left) + (wisent-log-resolution state lookaheadnum i "reduce")) + ((eq sassoc 'nonassoc) + (wisent-log-resolution state lookaheadnum i "an error")) + ) + (when (not (eq sassoc 'right)) + ;; Flush the shift for this token + (wisent-RESETBIT lookaheadset i) + (wisent-flush-shift state i)) + (when (not (eq sassoc 'left)) + ;; Flush the reduce for this token + (wisent-RESETBIT (aref LA lookaheadnum) i)) + (when (eq sassoc 'nonassoc) + ;; Record an explicit error for this token + (aset errs nerrs i) + (setq nerrs (1+ nerrs))) + ))) + (setq i (1+ i))) + (when (> nerrs 0) + (set-errs-nerrs errp nerrs) + (aset err-table state errp)) + )) + +(defun wisent-set-conflicts (state) + "Find and attempt to resolve conflicts in specified STATE." + (let (i j k v shiftp symbol) + (unless (aref consistent state) + (fillarray lookaheadset 0) + + (when (setq shiftp (aref shift-table state)) + (setq k (shifts-nshifts shiftp) + v (shifts-shifts shiftp) + i 0) + (while (and (< i k) + (wisent-ISTOKEN + (setq symbol (aref accessing-symbol (aref v i))))) + (or (zerop (aref v i)) + (wisent-SETBIT lookaheadset symbol)) + (setq i (1+ i)))) + + ;; Loop over all rules which require lookahead in this state + ;; first check for shift-reduce conflict, and try to resolve + ;; using precedence + (setq i (aref lookaheads state) + k (aref lookaheads (1+ state))) + (while (< i k) + (when (aref rprec (aref LAruleno i)) + (setq v (aref LA i) + j 0) + (while (< j tokensetsize) + (if (zerop (logand (aref v j) (aref lookaheadset j))) + (setq j (1+ j)) + ;; if (LA (i)[j] & lookaheadset[j]) + (wisent-resolve-sr-conflict state i) + (setq j tokensetsize)))) ;; break + (setq i (1+ i))) + + ;; Loop over all rules which require lookahead in this state + ;; Check for conflicts not resolved above. + (setq i (aref lookaheads state)) + (while (< i k) + (setq v (aref LA i) + j 0) + (while (< j tokensetsize) + ;; if (LA (i)[j] & lookaheadset[j]) + (if (not (zerop (logand (aref v j) (aref lookaheadset j)))) + (aset conflicts state t)) + (setq j (1+ j))) + (setq j 0) + (while (< j tokensetsize) + ;; lookaheadset[j] |= LA (i)[j]; + (aset lookaheadset j (logior (aref lookaheadset j) + (aref v j))) + (setq j (1+ j))) + (setq i (1+ i))) + ))) + +(defun wisent-resolve-conflicts () + "Find and resolve conflicts." + (working-dynamic-status "(resolve conflicts)") + (let (i) + (setq conflicts (make-vector nstates nil) + shiftset (make-vector tokensetsize 0) + lookaheadset (make-vector tokensetsize 0) + err-table (make-vector nstates nil) + i 0) + (while (< i nstates) + (wisent-set-conflicts i) + (setq i (1+ i))))) + +(defun wisent-count-sr-conflicts (state) + "Count the number of shift/reduce conflicts in specified STATE." + (let (i j k shiftp symbol v) + (setq src-count 0 + shiftp (aref shift-table state)) + (when shiftp + (fillarray shiftset 0) + (fillarray lookaheadset 0) + (setq k (shifts-nshifts shiftp) + v (shifts-shifts shiftp) + i 0) + (while (< i k) + (when (not (zerop (aref v i))) + (setq symbol (aref accessing-symbol (aref v i))) + (if (wisent-ISVAR symbol) + (setq i k) ;; break + (wisent-SETBIT shiftset symbol))) + (setq i (1+ i))) + + (setq k (aref lookaheads (1+ state)) + i (aref lookaheads state)) + (while (< i k) + (setq v (aref LA i) + j 0) + (while (< j tokensetsize) + ;; lookaheadset[j] |= LA (i)[j] + (aset lookaheadset j (logior (aref lookaheadset j) + (aref v j))) + (setq j (1+ j))) + (setq i (1+ i))) + + (setq k 0) + (while (< k tokensetsize) + ;; lookaheadset[k] &= shiftset[k]; + (aset lookaheadset k (logand (aref lookaheadset k) + (aref shiftset k))) + (setq k (1+ k))) + + (setq i 0) + (while (< i ntokens) + (if (wisent-BITISSET lookaheadset i) + (setq src-count (1+ src-count))) + (setq i (1+ i)))) + src-count)) + +(defun wisent-count-rr-conflicts (state) + "Count the number of reduce/reduce conflicts in specified STATE." + (let (i j count n m) + (setq rrc-count 0 + m (aref lookaheads state) + n (aref lookaheads (1+ state))) + (when (>= (- n m) 2) + (setq i 0) + (while (< i ntokens) + (setq count 0 + j m) + (while (< j n) + (if (wisent-BITISSET (aref LA j) i) + (setq count (1+ count))) + (setq j (1+ j))) + + (if (>= count 2) + (setq rrc-count (1+ rrc-count))) + (setq i (1+ i)))) + rrc-count)) + +(defvar wisent-expected-conflicts nil + "*If non-nil suppress the warning about shift/reduce conflicts. +It is a decimal integer N that says there should be no warning if +there are N shift/reduce conflicts and no reduce/reduce conflicts. A +warning is given if there are either more or fewer conflicts, or if +there are any reduce/reduce conflicts.") + +(defun wisent-total-conflicts () + "Report the total number of conflicts." + (unless (and (zerop rrc-total) + (or (zerop src-total) + (= src-total (or wisent-expected-conflicts 0)))) + (let* ((src (wisent-source)) + (src (if src (concat " in " src) "")) + (msg (format "Grammar%s contains" src))) + (if (> src-total 0) + (setq msg (format "%s %d shift/reduce conflict%s" + msg src-total (if (> src-total 1) + "s" "")))) + (if (and (> src-total 0) (> rrc-total 0)) + (setq msg (format "%s and" msg))) + (if (> rrc-total 0) + (setq msg (format "%s %d reduce/reduce conflict%s" + msg rrc-total (if (> rrc-total 1) + "s" "")))) + (message msg)))) + +(defun wisent-print-conflicts () + "Report conflicts." + (let (i) + (setq src-total 0 + rrc-total 0 + i 0) + (while (< i nstates) + (when (aref conflicts i) + (wisent-count-sr-conflicts i) + (wisent-count-rr-conflicts i) + (setq src-total (+ src-total src-count) + rrc-total (+ rrc-total rrc-count)) + (when (or wisent-verbose-flag wisent-debug-flag) + (wisent-log "State %d contains" i) + (if (> src-count 0) + (wisent-log " %d shift/reduce conflict%s" + src-count (if (> src-count 1) "s" ""))) + + (if (and (> src-count 0) (> rrc-count 0)) + (wisent-log " and")) + + (if (> rrc-count 0) + (wisent-log " %d reduce/reduce conflict%s" + rrc-count (if (> rrc-count 1) "s" ""))) + + (wisent-log ".\n"))) + (setq i (1+ i))) + (wisent-total-conflicts))) + +;;;; -------------------------------------- +;;;; Report information on generated parser +;;;; -------------------------------------- +(defun wisent-print-grammar () + "Print grammar." + (let (i j r break left-count right-count) + + (wisent-log "\n\nGrammar\n\n Number, Rule\n") + (setq i 1) + (while (<= i nrules) + ;; Don't print rules disabled in `wisent-reduce-grammar-tables'. + (when (aref ruseful i) + (wisent-log " %s %s ->" + (wisent-pad-string (number-to-string i) 6) + (wisent-tag (aref rlhs i))) + (setq r (aref rrhs i)) + (if (> (aref ritem r) 0) + (while (> (aref ritem r) 0) + (wisent-log " %s" (wisent-tag (aref ritem r))) + (setq r (1+ r))) + (wisent-log " /* empty */")) + (wisent-log "\n")) + (setq i (1+ i))) + + (wisent-log "\n\nTerminals, with rules where they appear\n\n") + (wisent-log "%s (-1)\n" (wisent-tag 0)) + (setq i 1) + (while (< i ntokens) + (wisent-log "%s (%d)" (wisent-tag i) i) + (setq j 1) + (while (<= j nrules) + (setq r (aref rrhs j) + break nil) + (while (and (not break) (> (aref ritem r) 0)) + (if (setq break (= (aref ritem r) i)) + (wisent-log " %d" j) + (setq r (1+ r)))) + (setq j (1+ j))) + (wisent-log "\n") + (setq i (1+ i))) + + (wisent-log "\n\nNonterminals, with rules where they appear\n\n") + (setq i ntokens) + (while (< i nsyms) + (setq left-count 0 + right-count 0 + j 1) + (while (<= j nrules) + (if (= (aref rlhs j) i) + (setq left-count (1+ left-count))) + (setq r (aref rrhs j) + break nil) + (while (and (not break) (> (aref ritem r) 0)) + (if (= (aref ritem r) i) + (setq right-count (1+ right-count) + break t) + (setq r (1+ r)))) + (setq j (1+ j))) + (wisent-log "%s (%d)\n " (wisent-tag i) i) + (when (> left-count 0) + (wisent-log " on left:") + (setq j 1) + (while (<= j nrules) + (if (= (aref rlhs j) i) + (wisent-log " %d" j)) + (setq j (1+ j)))) + (when (> right-count 0) + (if (> left-count 0) + (wisent-log ",")) + (wisent-log " on right:") + (setq j 1) + (while (<= j nrules) + (setq r (aref rrhs j) + break nil) + (while (and (not break) (> (aref ritem r) 0)) + (if (setq break (= (aref ritem r) i)) + (wisent-log " %d" j) + (setq r (1+ r)))) + (setq j (1+ j)))) + (wisent-log "\n") + (setq i (1+ i))) + )) + +(defun wisent-print-reductions (state) + "Print reductions on STATE." + (let (i j k v symbol m n defaulted + default-LA default-rule cmax count shiftp errp nodefault) + (setq nodefault nil + i 0) + (fillarray shiftset 0) + + (setq shiftp (aref shift-table state)) + (when shiftp + (setq k (shifts-nshifts shiftp) + v (shifts-shifts shiftp) + i 0) + (while (< i k) + (when (not (zerop (aref v i))) + (setq symbol (aref accessing-symbol (aref v i))) + (if (wisent-ISVAR symbol) + (setq i k) ;; break + ;; If this state has a shift for the error token, don't + ;; use a default rule. + (if (= symbol error-token-number) + (setq nodefault t)) + (wisent-SETBIT shiftset symbol))) + (setq i (1+ i)))) + + (setq errp (aref err-table state)) + (when errp + (setq k (errs-nerrs errp) + v (errs-errs errp) + i 0) + (while (< i k) + (if (not (zerop (setq symbol (aref v i)))) + (wisent-SETBIT shiftset symbol)) + (setq i (1+ i)))) + + (setq m (aref lookaheads state) + n (aref lookaheads (1+ state))) + + (cond + ((and (= (- n m) 1) (not nodefault)) + (setq default-rule (aref LAruleno m) + v (aref LA m) + k 0) + (while (< k tokensetsize) + (aset lookaheadset k (logand (aref v k) + (aref shiftset k))) + (setq k (1+ k))) + + (setq i 0) + (while (< i ntokens) + (if (wisent-BITISSET lookaheadset i) + (wisent-log " %s\t[reduce using rule %d (%s)]\n" + (wisent-tag i) default-rule + (wisent-tag (aref rlhs default-rule)))) + (setq i (1+ i))) + (wisent-log " $default\treduce using rule %d (%s)\n\n" + default-rule + (wisent-tag (aref rlhs default-rule))) + ) + ((>= (- n m) 1) + (setq cmax 0 + default-LA -1 + default-rule 0) + (when (not nodefault) + (setq i m) + (while (< i n) + (setq v (aref LA i) + count 0 + k 0) + (while (< k tokensetsize) + ;; lookaheadset[k] = LA (i)[k] & ~shiftset[k] + (aset lookaheadset k + (logand (aref v k) + (lognot (aref shiftset k)))) + (setq k (1+ k))) + (setq j 0) + (while (< j ntokens) + (if (wisent-BITISSET lookaheadset j) + (setq count (1+ count))) + (setq j (1+ j))) + (if (> count cmax) + (setq cmax count + default-LA i + default-rule (aref LAruleno i))) + (setq k 0) + (while (< k tokensetsize) + (aset shiftset k (logior (aref shiftset k) + (aref lookaheadset k))) + (setq k (1+ k))) + (setq i (1+ i)))) + + (fillarray shiftset 0) + + (when shiftp + (setq k (shifts-nshifts shiftp) + v (shifts-shifts shiftp) + i 0) + (while (< i k) + (when (not (zerop (aref v i))) + (setq symbol (aref accessing-symbol (aref v i))) + (if (wisent-ISVAR symbol) + (setq i k) ;; break + (wisent-SETBIT shiftset symbol))) + (setq i (1+ i)))) + + (setq i 0) + (while (< i ntokens) + (setq defaulted nil + count (if (wisent-BITISSET shiftset i) 1 0) + j m) + (while (< j n) + (when (wisent-BITISSET (aref LA j) i) + (if (zerop count) + (progn + (if (not (= j default-LA)) + (wisent-log + " %s\treduce using rule %d (%s)\n" + (wisent-tag i) (aref LAruleno j) + (wisent-tag (aref rlhs (aref LAruleno j)))) + (setq defaulted t)) + (setq count (1+ count))) + (if defaulted + (wisent-log + " %s\treduce using rule %d (%s)\n" + (wisent-tag i) (aref LAruleno default-LA) + (wisent-tag (aref rlhs (aref LAruleno default-LA))))) + (setq defaulted nil) + (wisent-log + " %s\t[reduce using rule %d (%s)]\n" + (wisent-tag i) (aref LAruleno j) + (wisent-tag (aref rlhs (aref LAruleno j)))))) + (setq j (1+ j))) + (setq i (1+ i))) + + (if (>= default-LA 0) + (wisent-log + " $default\treduce using rule %d (%s)\n" + default-rule + (wisent-tag (aref rlhs default-rule)))) + )))) + +(defun wisent-print-actions (state) + "Print actions on STATE." + (let (i j k v state1 symbol shiftp errp redp rule nerrs break) + (setq shiftp (aref shift-table state) + redp (aref reduction-table state) + errp (aref err-table state)) + (if (and (not shiftp) (not redp)) + (if (= final-state state) + (wisent-log " $default\taccept\n") + (wisent-log " NO ACTIONS\n")) + (if (not shiftp) + (setq i 0 + k 0) + (setq k (shifts-nshifts shiftp) + v (shifts-shifts shiftp) + i 0 + break nil) + (while (and (not break) (< i k)) + (if (zerop (setq state1 (aref v i))) + (setq i (1+ i)) + (setq symbol (aref accessing-symbol state1)) + ;; The following line used to be turned off. + (if (wisent-ISVAR symbol) + (setq break t) ;; break + (wisent-log " %s\tshift, and go to state %d\n" + (wisent-tag symbol) state1) + (setq i (1+ i))))) + (if (> i 0) + (wisent-log "\n"))) + + (when errp + (setq nerrs (errs-nerrs errp) + v (errs-errs errp) + j 0) + (while (< j nerrs) + (if (aref v j) + (wisent-log " %s\terror (nonassociative)\n" + (wisent-tag (aref v j)))) + (setq j (1+ j))) + (if (> j 0) + (wisent-log "\n"))) + + (cond + ((and (aref consistent state) redp) + (setq rule (aref (reductions-rules redp) 0) + symbol (aref rlhs rule)) + (wisent-log " $default\treduce using rule %d (%s)\n\n" + rule (wisent-tag symbol)) + ) + (redp + (wisent-print-reductions state) + )) + + (when (< i k) + (setq v (shifts-shifts shiftp)) + (while (< i k) + (when (setq state1 (aref v i)) + (setq symbol (aref accessing-symbol state1)) + (wisent-log " %s\tgo to state %d\n" + (wisent-tag symbol) state1)) + (setq i (1+ i))) + (wisent-log "\n")) + ))) + +(defun wisent-print-core (state) + "Print STATE core." + (let (i k rule statep sp sp1) + (setq statep (aref state-table state) + k (core-nitems statep)) + (when (> k 0) + (setq i 0) + (while (< i k) + ;; sp1 = sp = ritem + statep->items[i]; + (setq sp1 (aref (core-items statep) i) + sp sp1) + (while (> (aref ritem sp) 0) + (setq sp (1+ sp))) + + (setq rule (- (aref ritem sp))) + (wisent-log " %s -> " (wisent-tag (aref rlhs rule))) + + (setq sp (aref rrhs rule)) + (while (< sp sp1) + (wisent-log "%s " (wisent-tag (aref ritem sp))) + (setq sp (1+ sp))) + (wisent-log ".") + (while (> (aref ritem sp) 0) + (wisent-log " %s" (wisent-tag (aref ritem sp))) + (setq sp (1+ sp))) + (wisent-log " (rule %d)\n" rule) + (setq i (1+ i))) + (wisent-log "\n")))) + +(defun wisent-print-state (state) + "Print information on STATE." + (wisent-log "\n\nstate %d\n\n" state) + (wisent-print-core state) + (wisent-print-actions state)) + +(defun wisent-print-states () + "Print information on states." + (let ((i 0)) + (while (< i nstates) + (wisent-print-state i) + (setq i (1+ i))))) + +(defun wisent-print-results () + "Print information on generated parser. +Report detailed informations if `wisent-verbose-flag' or +`wisent-debug-flag' are non-nil." + (when (or wisent-verbose-flag wisent-debug-flag) + (wisent-print-useless)) + (wisent-print-conflicts) + (when (or wisent-verbose-flag wisent-debug-flag) + (wisent-print-grammar) + (wisent-print-states)) + ;; Append output to log file when running in batch mode + (when (wisent-noninteractive) + (wisent-append-to-log-file) + (wisent-clear-log))) + +;;;; --------------------------------- +;;;; Build the generated parser tables +;;;; --------------------------------- + +(defun wisent-action-row (state actrow) + "Figure out the actions for the specified STATE. +Decide what to do for each type of token if seen as the lookahead +token in specified state. The value returned is used as the default +action for the state. In addition, ACTROW is filled with what to do +for each kind of token, index by symbol number, with nil meaning do +the default action. The value 'error, means this situation is an +error. The parser recognizes this value specially. + +This is where conflicts are resolved. The loop over lookahead rules +considered lower-numbered rules last, and the last rule considered +that likes a token gets to handle it." + (let (i j k m n v default-rule nreds rule max count + shift-state symbol redp shiftp errp nodefault) + + (fillarray actrow nil) + + (setq default-rule 0 + nodefault nil ;; nil inhibit having any default reduction + nreds 0 + m 0 + n 0 + redp (aref reduction-table state)) + + (when redp + (setq nreds (reductions-nreds redp)) + (when (>= nreds 1) + ;; loop over all the rules available here which require + ;; lookahead + (setq m (aref lookaheads state) + n (aref lookaheads (1+ state)) + i (1- n)) + (while (>= i m) + ;; and find each token which the rule finds acceptable to + ;; come next + (setq j 0) + (while (< j ntokens) + ;; and record this rule as the rule to use if that token + ;; follows. + (if (wisent-BITISSET (aref LA i) j) + (aset actrow j (- (aref LAruleno i))) + ) + (setq j (1+ j))) + (setq i (1- i))))) + + ;; Now see which tokens are allowed for shifts in this state. For + ;; them, record the shift as the thing to do. So shift is + ;; preferred to reduce. + (setq shiftp (aref shift-table state)) + (when shiftp + (setq k (shifts-nshifts shiftp) + v (shifts-shifts shiftp) + i 0) + (while (< i k) + (setq shift-state (aref v i)) + (if (zerop shift-state) + nil ;; continue + (setq symbol (aref accessing-symbol shift-state)) + (if (wisent-ISVAR symbol) + (setq i k) ;; break + (aset actrow symbol shift-state) + ;; Do not use any default reduction if there is a shift + ;; for error + (if (= symbol error-token-number) + (setq nodefault t)))) + (setq i (1+ i)))) + + ;; See which tokens are an explicit error in this state (due to + ;; %nonassoc). For them, record error as the action. + (setq errp (aref err-table state)) + (when errp + (setq k (errs-nerrs errp) + v (errs-errs errp) + i 0) + (while (< i k) + (aset actrow (aref v i) wisent-error-tag) + (setq i (1+ i)))) + + ;; Now find the most common reduction and make it the default + ;; action for this state. + (when (and (>= nreds 1) (not nodefault)) + (if (aref consistent state) + (setq default-rule (- (aref (reductions-rules redp) 0))) + (setq max 0 + i m) + (while (< i n) + (setq count 0 + rule (- (aref LAruleno i)) + j 0) + (while (< j ntokens) + (if (and (numberp (aref actrow j)) + (= (aref actrow j) rule)) + (setq count (1+ count))) + (setq j (1+ j))) + (if (> count max) + (setq max count + default-rule rule)) + (setq i (1+ i))) + ;; actions which match the default are replaced with zero, + ;; which means "use the default" + (when (> max 0) + (setq j 0) + (while (< j ntokens) + (if (and (numberp (aref actrow j)) + (= (aref actrow j) default-rule)) + (aset actrow j nil)) + (setq j (1+ j))) + ))) + + ;; If have no default rule, if this is the final state the default + ;; is accept else it is an error. So replace any action which + ;; says "error" with "use default". + (when (zerop default-rule) + (if (= final-state state) + (setq default-rule wisent-accept-tag) + (setq j 0) + (while (< j ntokens) + (if (eq (aref actrow j) wisent-error-tag) + (aset actrow j nil)) + (setq j (1+ j))) + (setq default-rule wisent-error-tag))) + default-rule)) + +(defconst wisent-default-tag 'default + "Tag used in an action table to indicate a default action.") + +;; These variables only exist locally in the function +;; `wisent-state-actions' and are shared by all other nested callees. +(wisent-defcontext semantic-actions + ;; Uninterned symbols used in code generation. + stack sp gotos state + ;; Name of the current semantic action + NAME) + +(defun wisent-state-actions () + "Figure out the actions for every state. +Return the action table." + (working-dynamic-status "(build state actions)") + ;; Store the semantic action obarray in (unused) RCODE[0]. + (aset rcode 0 (make-vector 13 0)) + (let (i j action-table actrow action) + (setq action-table (make-vector nstates nil) + actrow (make-vector ntokens nil) + i 0) + (wisent-with-context semantic-actions + (setq stack (make-symbol "stack") + sp (make-symbol "sp") + gotos (make-symbol "gotos") + state (make-symbol "state")) + (while (< i nstates) + (setq action (wisent-action-row i actrow)) + ;; Translate a reduction into semantic action + (and (integerp action) (< action 0) + (setq action (wisent-semantic-action (- action)))) + (aset action-table i (list (cons wisent-default-tag action))) + (setq j 0) + (while (< j ntokens) + (when (setq action (aref actrow j)) + ;; Translate a reduction into semantic action + (and (integerp action) (< action 0) + (setq action (wisent-semantic-action (- action)))) + (aset action-table i (cons (cons (aref tags j) action) + (aref action-table i))) + ) + (setq j (1+ j))) + (aset action-table i (nreverse (aref action-table i))) + (setq i (1+ i))) + action-table))) + +(defun wisent-goto-actions () + "Figure out what to do after reducing with each rule. +Depending on the saved state from before the beginning of parsing the +data that matched this rule. Return the goto table." + (working-dynamic-status "(build goto actions)") + (let (i j m n symbol state goto-table) + (setq goto-table (make-vector nstates nil) + i ntokens) + (while (< i nsyms) + (setq symbol (- i ntokens) + m (aref goto-map symbol) + n (aref goto-map (1+ symbol)) + j m) + (while (< j n) + (setq state (aref from-state j)) + (aset goto-table state + (cons (cons (aref tags i) (aref to-state j)) + (aref goto-table state))) + (setq j (1+ j))) + (setq i (1+ i))) + goto-table)) + +(defsubst wisent-quote-p (sym) + "Return non-nil if SYM is bound to the `quote' function." + (condition-case nil + (eq (indirect-function sym) + (indirect-function 'quote)) + (error nil))) + +(defsubst wisent-backquote-p (sym) + "Return non-nil if SYM is bound to the `backquote' function." + (condition-case nil + (eq (indirect-function sym) + (indirect-function 'backquote)) + (error nil))) + +(defun wisent-check-$N (x m) + "Return non-nil if X is a valid $N or $regionN symbol. +That is if X is a $N or $regionN symbol with N >= 1 and N <= M. +Also warn if X is a $N or $regionN symbol with N < 1 or N > M." + (when (symbolp x) + (let* ((n (symbol-name x)) + (i (and (string-match "\\`\\$\\(region\\)?\\([0-9]+\\)\\'" n) + (string-to-number (match-string 2 n))))) + (when i + (if (and (>= i 1) (<= i m)) + t + (message + "*** In %s, %s might be a free variable (rule has %s)" + NAME x (format (cond ((< m 1) "no component") + ((= m 1) "%d component") + ("%d components")) + m)) + nil))))) + +(defun wisent-semantic-action-expand-body (body n &optional found) + "Parse BODY of semantic action. +N is the maximum number of $N variables that can be referenced in +BODY. Warn on references out of permitted range. +Optional argument FOUND is the accumulated list of '$N' references +encountered so far. +Return a cons (FOUND . XBODY), where FOUND is the list of $N +references found in BODY, and XBODY is BODY expression with +`backquote' forms expanded." + (if (not (listp body)) + ;; BODY is an atom, no expansion needed + (progn + (if (wisent-check-$N body n) + ;; Accumulate $i symbol + (add-to-list 'found body)) + (cons found body)) + ;; BODY is a list, expand inside it + (let (xbody sexpr) + ;; If backquote expand it first + (if (wisent-backquote-p (car body)) + (setq body (macroexpand body))) + (while body + (setq sexpr (car body) + body (cdr body)) + (cond + ;; Function call excepted quote expression + ((and (consp sexpr) + (not (wisent-quote-p (car sexpr)))) + (setq sexpr (wisent-semantic-action-expand-body sexpr n found) + found (car sexpr) + sexpr (cdr sexpr))) + ;; $i symbol + ((wisent-check-$N sexpr n) + ;; Accumulate $i symbol + (add-to-list 'found sexpr)) + ) + ;; Accumulate expanded forms + (setq xbody (nconc xbody (list sexpr)))) + (cons found xbody)))) + +(defun wisent-semantic-action (r) + "Set up the Elisp function for semantic action at rule R. +On entry RCODE[R] contains a vector [BODY N (NTERM I)] where BODY is the +body of the semantic action, N is the maximum number of values +available in the parser's stack, NTERM is the nonterminal the semantic +action belongs to, and I is the index of the semantic action inside +NTERM definition. Return the semantic action symbol. +The semantic action function accepts three arguments: + +- the state/value stack +- the top-of-stack index +- the goto table + +And returns the updated top-of-stack index." + (if (not (aref ruseful r)) + (aset rcode r nil) + (let* ((actn (aref rcode r)) + (n (aref actn 1)) ; nb of val avail. in stack + (NAME (apply 'format "%s:%d" (aref actn 2))) + (form (wisent-semantic-action-expand-body (aref actn 0) n)) + ($l (car form)) ; list of $vars used in body + (form (cdr form)) ; expanded form of body + (nt (aref rlhs r)) ; nonterminal item no. + (bl nil) ; `let*' binding list + $v i j) + + ;; Compute $N and $regionN bindings + (setq i n) + (while (> i 0) + (setq j (1+ (* 2 (- n i)))) + ;; Only bind $regionI if used in action + (setq $v (intern (format "$region%d" i))) + (if (memq $v $l) + (setq bl (cons `(,$v (cdr (aref ,stack (- ,sp ,j)))) bl))) + ;; Only bind $I if used in action + (setq $v (intern (format "$%d" i))) + (if (memq $v $l) + (setq bl (cons `(,$v (car (aref ,stack (- ,sp ,j)))) bl))) + (setq i (1- i))) + + ;; Compute J, the length of rule's RHS. It will give the + ;; current parser state at STACK[SP - 2*J], and where to push + ;; the new semantic value and the next state, respectively at: + ;; STACK[SP - 2*J + 1] and STACK[SP - 2*J + 2]. Generally N, + ;; the maximum number of values available in the stack, is equal + ;; to J. But, for mid-rule actions, N is the number of rule + ;; elements before the action and J is always 0 (empty rule). + (setq i (aref rrhs r) + j 0) + (while (> (aref ritem i) 0) + (setq j (1+ j) + i (1+ i))) + + ;; Create the semantic action symbol. + (setq actn (intern NAME (aref rcode 0))) + + ;; Store source code in function cell of the semantic action + ;; symbol. It will be byte-compiled at automaton's compilation + ;; time. Using a byte-compiled automaton can significantly + ;; speed up parsing! + (fset actn + `(lambda (,stack ,sp ,gotos) + (let* (,@bl + ($region + ,(cond + ((= n 1) + (if (assq '$region1 bl) + '$region1 + `(cdr (aref ,stack (1- ,sp))))) + ((> n 1) + `(wisent-production-bounds + ,stack (- ,sp ,(1- (* 2 n))) (1- ,sp))))) + ($action ,NAME) + ($nterm ',(aref tags nt)) + ,@(and (> j 0) `((,sp (- ,sp ,(* j 2))))) + (,state (cdr (assq $nterm + (aref ,gotos + (aref ,stack ,sp)))))) + (setq ,sp (+ ,sp 2)) + ;; push semantic value + (aset ,stack (1- ,sp) (cons ,form $region)) + ;; push next state + (aset ,stack ,sp ,state) + ;; return new top of stack + ,sp))) + + ;; Return the semantic action symbol + actn))) + +;;;; ---------------------------- +;;;; Build parser LALR automaton. +;;;; ---------------------------- + +(defun wisent-parser-automaton () + "Compute and return LALR(1) automaton from GRAMMAR. +GRAMMAR is in internal format. GRAM/ACTS are grammar rules +in internal format. STARTS defines the start symbols." + ;; Check for useless stuff + (wisent-reduce-grammar) + + (wisent-set-derives) + (wisent-set-nullable) + ;; convert to nondeterministic finite state machine. + (wisent-generate-states) + ;; make it deterministic. + (wisent-lalr) + ;; Find and record any conflicts: places where one token of + ;; lookahead is not enough to disambiguate the parsing. Also + ;; resolve s/r conflicts based on precedence declarations. + (wisent-resolve-conflicts) + (wisent-print-results) + + (vector (wisent-state-actions) ; action table + (wisent-goto-actions) ; goto table + start-table ; start symbols + (aref rcode 0) ; sem. action symbol obarray + ) + ) + +;;;; ------------------- +;;;; Parse input grammar +;;;; ------------------- + +(defconst wisent-reserved-symbols (list wisent-error-term) + "The list of reserved symbols. +Also all symbols starting with a character defined in +`wisent-reserved-capitals' are reserved for internal use.") + +(defconst wisent-reserved-capitals '(?\$ ?\@) + "The list of reserved capital letters. +All symbol starting with one of these letters are reserved for +internal use.") + +(defconst wisent-starts-nonterm '$STARTS + "Main start symbol. +It gives the rules for start symbols.") + +(defvar wisent-single-start-flag nil + "Non-nil means allows only one start symbol like in Bison. +That is don't add extra start rules to the grammar. This is +useful to compare the Wisent's generated automaton with the Bison's +one.") + +(defsubst wisent-ISVALID-VAR (x) + "Return non-nil if X is a character or an allowed symbol." + (and x (symbolp x) + (not (memq (aref (symbol-name x) 0) wisent-reserved-capitals)) + (not (memq x wisent-reserved-symbols)))) + +(defsubst wisent-ISVALID-TOKEN (x) + "Return non-nil if X is a character or an allowed symbol." + (or (wisent-char-p x) + (wisent-ISVALID-VAR x))) + +(defun wisent-push-token (symbol &optional nocheck) + "Push a new SYMBOL in the list of tokens. +Bypass checking if NOCHECK is non-nil." + ;; Check + (or nocheck (wisent-ISVALID-TOKEN symbol) + (error "Invalid terminal symbol: %S" symbol)) + (if (memq symbol token-list) + (message "*** duplicate terminal `%s' ignored" symbol) + ;; Set up properties + (wisent-set-prec symbol nil) + (wisent-set-assoc symbol nil) + (wisent-set-item-number symbol ntokens) + ;; Add + (setq ntokens (1+ ntokens) + token-list (cons symbol token-list)))) + +(defun wisent-push-var (symbol &optional nocheck) + "Push a new SYMBOL in the list of nonterminals. +Bypass checking if NOCHECK is non-nil." + ;; Check + (unless nocheck + (or (wisent-ISVALID-VAR symbol) + (error "Invalid nonterminal symbol: %S" symbol)) + (if (memq symbol var-list) + (error "Nonterminal `%s' already defined" symbol))) + ;; Set up properties + (wisent-set-item-number symbol nvars) + ;; Add + (setq nvars (1+ nvars) + var-list (cons symbol var-list))) + +(defun wisent-parse-nonterminals (defs) + "Parse nonterminal definitions in DEFS. +Fill in each element of the global arrays RPREC, RCODE, RUSEFUL with +respectively rule precedence level, semantic action code and +usefulness flag. Return a list of rules of the form (LHS . RHS) where +LHS and RHS are respectively the Left Hand Side and Right Hand Side of +the rule." + (setq rprec nil + rcode nil + nitems 0 + nrules 0) + (let (def nonterm rlist rule rules rhs rest item items + rhl plevel semact @n @count iactn) + (setq @count 0) + (while defs + (setq def (car defs) + defs (cdr defs) + nonterm (car def) + rlist (cdr def) + iactn 0) + (or (consp rlist) + (error "Invalid nonterminal definition syntax: %S" def)) + (while rlist + (setq rule (car rlist) + rlist (cdr rlist) + items (car rule) + rest (cdr rule) + rhl 0 + rhs nil) + + ;; Check & count items + (setq nitems (1+ nitems)) ;; LHS item + (while items + (setq item (car items) + items (cdr items) + nitems (1+ nitems)) ;; RHS items + (if (listp item) + ;; Mid-rule action + (progn + (setq @count (1+ @count) + @n (intern (format "@%d" @count))) + (wisent-push-var @n t) + ;; Push a new empty rule with the mid-rule action + (setq semact (vector item rhl (list nonterm iactn)) + iactn (1+ iactn) + plevel nil + rcode (cons semact rcode) + rprec (cons plevel rprec) + item @n ;; Replace action by @N nonterminal + rules (cons (list item) rules) + nitems (1+ nitems) + nrules (1+ nrules))) + ;; Check terminal or nonterminal symbol + (cond + ((or (memq item token-list) (memq item var-list))) + ;; Create new literal character token + ((wisent-char-p item) (wisent-push-token item t)) + ((error "Symbol `%s' is used, but is not defined as a token and has no rules" + item)))) + (setq rhl (1+ rhl) + rhs (cons item rhs))) + + ;; Check & collect rule precedence level + (setq plevel (when (vectorp (car rest)) + (setq item (car rest) + rest (cdr rest)) + (if (and (= (length item) 1) + (memq (aref item 0) token-list) + (wisent-prec (aref item 0))) + (wisent-item-number (aref item 0)) + (error "Invalid rule precedence level syntax: %S" item))) + rprec (cons plevel rprec)) + + ;; Check & collect semantic action body + (setq semact (vector + (if rest + (if (cdr rest) + (error "Invalid semantic action syntax: %S" rest) + (car rest)) + ;; Give a default semantic action body: nil + ;; for an empty rule or $1, the value of the + ;; first symbol in the rule, otherwise. + (if (> rhl 0) '$1 '())) + rhl + (list nonterm iactn)) + iactn (1+ iactn) + rcode (cons semact rcode)) + (setq rules (cons (cons nonterm (nreverse rhs)) rules) + nrules (1+ nrules)))) + + (setq ruseful (make-vector (1+ nrules) t) + rprec (vconcat (cons nil (nreverse rprec))) + rcode (vconcat (cons nil (nreverse rcode)))) + (nreverse rules) + )) + +(defun wisent-parse-grammar (grammar &optional start-list) + "Parse GRAMMAR and build a suitable internal representation. +Optional argument START-LIST defines the start symbols. +GRAMMAR is a list of form: (TOKENS ASSOCS . NONTERMS) + +TOKENS is a list of terminal symbols (tokens). + +ASSOCS is nil or an alist of (ASSOC-TYPE . ASSOC-VALUE) elements +describing the associativity of TOKENS. ASSOC-TYPE must be one of the +`default-prec' `nonassoc', `left' or `right' symbols. When ASSOC-TYPE +is `default-prec', ASSOC-VALUE must be nil or t (the default). +Otherwise it is a list of tokens which must have been previously +declared in TOKENS. + +NONTERMS is the list of non terminal definitions (see function +`wisent-parse-nonterminals')." + (working-dynamic-status "(parse input grammar)") + (or (and (consp grammar) (> (length grammar) 2)) + (error "Bad input grammar")) + + (let (i r rhs pre dpre lst start-var assoc rules item + token var def tokens defs ep-token ep-var ep-def) + + ;; Built-in tokens + (setq ntokens 0 nvars 0) + (wisent-push-token wisent-eoi-term t) + (wisent-push-token wisent-error-term t) + + ;; Check/collect terminals + (setq lst (car grammar)) + (while lst + (wisent-push-token (car lst)) + (setq lst (cdr lst))) + + ;; Check/Set up tokens precedence & associativity + (setq lst (nth 1 grammar) + pre 0 + defs nil + dpre nil + default-prec t) + (while lst + (setq def (car lst) + assoc (car def) + tokens (cdr def) + lst (cdr lst)) + (if (eq assoc 'default-prec) + (progn + (or (null (cdr tokens)) + (memq (car tokens) '(t nil)) + (error "Invalid default-prec value: %S" tokens)) + (setq default-prec (car tokens)) + (if dpre + (message "*** redefining default-prec to %s" + default-prec)) + (setq dpre t)) + (or (memq assoc '(left right nonassoc)) + (error "Invalid associativity syntax: %S" assoc)) + (setq pre (1+ pre)) + (while tokens + (setq token (car tokens) + tokens (cdr tokens)) + (if (memq token defs) + (message "*** redefining precedence of `%s'" token)) + (or (memq token token-list) + ;; Define token not previously declared. + (wisent-push-token token)) + (setq defs (cons token defs)) + ;; Record the precedence and associativity of the terminal. + (wisent-set-prec token pre) + (wisent-set-assoc token assoc)))) + + ;; Check/Collect nonterminals + (setq lst (nthcdr 2 grammar) + defs nil) + (while lst + (setq def (car lst) + lst (cdr lst)) + (or (consp def) + (error "Invalid nonterminal definition: %S" def)) + (if (memq (car def) token-list) + (error "Nonterminal `%s' already defined as token" (car def))) + (wisent-push-var (car def)) + (setq defs (cons def defs))) + (or defs + (error "No input grammar")) + (setq defs (nreverse defs)) + + ;; Set up the start symbol. + (setq start-table nil) + (cond + + ;; 1. START-LIST is nil, the start symbol is the first + ;; nonterminal defined in the grammar (Bison like). + ((null start-list) + (setq start-var (caar defs))) + + ;; 2. START-LIST contains only one element, it is the start + ;; symbol (Bison like). + ((or wisent-single-start-flag (null (cdr start-list))) + (setq start-var (car start-list)) + (or (assq start-var defs) + (error "Start symbol `%s' has no rule" start-var))) + + ;; 3. START-LIST contains more than one element. All defines + ;; potential start symbols. One of them (the first one by + ;; default) will be given at parse time to be the parser goal. + ;; If `wisent-single-start-flag' is non-nil that feature is + ;; disabled and the first nonterminal in START-LIST defines + ;; the start symbol, like in case 2 above. + ((not wisent-single-start-flag) + + ;; START-LIST is a list of nonterminals '(nt0 ... ntN). + ;; Build and push ad hoc start rules in the grammar: + + ;; ($STARTS ((nt0) $1) ((nt1) $1) ... ((ntN) $1)) + ;; ($nt1 (($$nt1 nt1) $2)) + ;; ... + ;; ($ntN (($$ntN ntN) $2)) + + ;; Where internal symbols $ntI and $$ntI are respectively + ;; nonterminals and terminals. + + ;; The internal start symbol $STARTS is used to build the + ;; LALR(1) automaton. The true default start symbol used by the + ;; parser is the first nonterminal in START-LIST (nt0). + (setq start-var wisent-starts-nonterm + lst (nreverse start-list)) + (while lst + (setq var (car lst) + lst (cdr lst)) + (or (memq var var-list) + (error "Start symbol `%s' has no rule" var)) + (unless (assq var start-table) ;; Ignore duplicates + ;; For each nt start symbol + (setq ep-var (intern (format "$%s" var)) + ep-token (intern (format "$$%s" var))) + (wisent-push-token ep-token t) + (wisent-push-var ep-var t) + (setq + ;; Add entry (nt . $$nt) to start-table + start-table (cons (cons var ep-token) start-table) + ;; Add rule ($nt (($$nt nt) $2)) + defs (cons (list ep-var (list (list ep-token var) '$2)) defs) + ;; Add start rule (($nt) $1) + ep-def (cons (list (list ep-var) '$1) ep-def)) + )) + (wisent-push-var start-var t) + (setq defs (cons (cons start-var ep-def) defs)))) + + ;; Set up rules main data structure & RPREC, RCODE, RUSEFUL + (setq rules (wisent-parse-nonterminals defs)) + + ;; Set up the terminal & nonterminal lists. + (setq nsyms (+ ntokens nvars) + token-list (nreverse token-list) + lst var-list + var-list nil) + (while lst + (setq var (car lst) + lst (cdr lst) + var-list (cons var var-list)) + (wisent-set-item-number ;; adjust nonterminal item number to + var (+ ntokens (wisent-item-number var)))) ;; I += NTOKENS + + ;; Store special item numbers + (setq error-token-number (wisent-item-number wisent-error-term) + start-symbol (wisent-item-number start-var)) + + ;; Keep symbols in the TAGS vector so that TAGS[I] is the symbol + ;; associated to item number I. + (setq tags (vconcat token-list var-list)) + ;; Set up RLHS RRHS & RITEM data structures from list of rules + ;; (LHS . RHS) received from `wisent-parse-nonterminals'. + (setq rlhs (make-vector (1+ nrules) nil) + rrhs (make-vector (1+ nrules) nil) + ritem (make-vector (1+ nitems) nil) + i 0 + r 1) + (while rules + (aset rlhs r (wisent-item-number (caar rules))) + (aset rrhs r i) + (setq rhs (cdar rules) + pre nil) + (while rhs + (setq item (wisent-item-number (car rhs))) + ;; Get default precedence level of rule, that is the + ;; precedence of the last terminal in it. + (and (wisent-ISTOKEN item) + default-prec + (setq pre item)) + + (aset ritem i item) + (setq i (1+ i) + rhs (cdr rhs))) + ;; Setup the precedence level of the rule, that is the one + ;; specified by %prec or the default one. + (and (not (aref rprec r)) ;; Already set by %prec + pre + (wisent-prec (aref tags pre)) + (aset rprec r pre)) + (aset ritem i (- r)) + (setq i (1+ i) + r (1+ r)) + (setq rules (cdr rules))) + )) + +;;;; --------------------- +;;;; Compile input grammar +;;;; --------------------- + +;;;###autoload +(defun wisent-compile-grammar (grammar &optional start-list) + "Compile the LALR(1) GRAMMAR. + +GRAMMAR is a list (TOKENS ASSOCS . NONTERMS) where: + +- TOKENS is a list of terminal symbols (tokens). + +- ASSOCS is nil, or an alist of (ASSOC-TYPE . ASSOC-VALUE) elements + describing the associativity of TOKENS. ASSOC-TYPE must be one of + the `default-prec' `nonassoc', `left' or `right' symbols. When + ASSOC-TYPE is `default-prec', ASSOC-VALUE must be nil or t (the + default). Otherwise it is a list of tokens which must have been + previously declared in TOKENS. + +- NONTERMS is a list of nonterminal definitions. + +Optional argument START-LIST specify the possible grammar start +symbols. This is a list of nonterminals which must have been +previously declared in GRAMMAR's NONTERMS form. By default, the start +symbol is the first nonterminal defined. When START-LIST contains +only one element, it is the start symbol. Otherwise, all elements are +possible start symbols, unless `wisent-single-start-flag' is non-nil. +In that case, the first element is the start symbol, and others are +ignored. + +Return an automaton as a vector: [ACTIONS GOTOS STARTS FUNCTIONS] +where: + +- ACTIONS is a state/token matrix telling the parser what to do at + every state based on the current lookahead token. That is shift, + reduce, accept or error. + +- GOTOS is a state/nonterminal matrix telling the parser the next + state to go to after reducing with each rule. + +- STARTS is an alist which maps the allowed start nonterminal symbols + to tokens that will be first shifted into the parser stack. + +- FUNCTIONS is an obarray of semantic action symbols. Each symbol's + function definition is the semantic action lambda expression." + (if (wisent-automaton-p grammar) + grammar ;; Grammar already compiled just return it + (wisent-with-context compile-grammar + (let* ((working-status-dynamic-type 'working-text-display) + (gc-cons-threshold 1000000) + automaton) + (garbage-collect) + (working-status-forms "Compiling grammar" "done" + (setq wisent-new-log-flag t) + ;; Parse input grammar + (wisent-parse-grammar grammar start-list) + ;; Generate the LALR(1) automaton + (setq automaton (wisent-parser-automaton)) + (working-dynamic-status t) + automaton))))) + +;;;; -------------------------- +;;;; Byte compile input grammar +;;;; -------------------------- + +(require 'bytecomp) + +;;;###autoload +(defun wisent-byte-compile-grammar (form) + "Byte compile the `wisent-compile-grammar' FORM. +Automatically called by the Emacs Lisp byte compiler as a +`byte-compile' handler." + ;; Eval the `wisent-compile-grammar' form to obtain an LALR + ;; automaton internal data structure. Then, because the internal + ;; data structure contains an obarray, convert it to a lisp form so + ;; it can be byte-compiled. + (byte-compile-form (wisent-automaton-lisp-form (eval form)))) + +;;;###autoload +(put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar) + +(defun wisent-automaton-lisp-form (automaton) + "Return a Lisp form that produces AUTOMATON. +See also `wisent-compile-grammar' for more details on AUTOMATON." + (or (wisent-automaton-p automaton) + (signal 'wrong-type-argument + (list 'wisent-automaton-p automaton))) + (let ((obn (make-symbol "ob")) ; Generated obarray name + (obv (aref automaton 3)) ; Semantic actions obarray + ) + `(let ((,obn (make-vector 13 0))) + ;; Generate code to initialize the semantic actions obarray, + ;; in local variable OBN. + ,@(let (obcode) + (mapatoms + #'(lambda (s) + (setq obcode + (cons `(fset (intern ,(symbol-name s) ,obn) + #',(symbol-function s)) + obcode))) + obv) + obcode) + ;; Generate code to create the automaton. + (vector + ;; In code generated to initialize the action table, take + ;; care of symbols that are interned in the semantic actions + ;; obarray. + (vector + ,@(mapcar + #'(lambda (state) ;; for each state + `(list + ,@(mapcar + #'(lambda (tr) ;; for each transition + (let ((k (car tr)) ; token + (a (cdr tr))) ; action + (if (and (symbolp a) + (intern-soft (symbol-name a) obv)) + `(cons ,(if (symbolp k) `(quote ,k) k) + (intern-soft ,(symbol-name a) ,obn)) + `(quote ,tr)))) + state))) + (aref automaton 0))) + ;; The code of the goto table is unchanged. + ,(aref automaton 1) + ;; The code of the alist of start symbols is unchanged. + ',(aref automaton 2) + ;; The semantic actions obarray is in the local variable OBN. + ,obn)))) + +(provide 'wisent-comp) + +;;; wisent-comp.el ends here diff --git a/auto-install/wisent.el b/auto-install/wisent.el new file mode 100644 index 0000000..d5169c7 --- /dev/null +++ b/auto-install/wisent.el @@ -0,0 +1,483 @@ +;;; wisent.el --- GNU Bison for Emacs - Runtime + +;; Copyright (C) 2009, 2010 Eric M. Ludlam +;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 David Ponce + +;; Author: David Ponce +;; Maintainer: David Ponce +;; Created: 30 January 2002 +;; Keywords: syntax +;; X-RCS: $Id: wisent.el,v 1.43 2010-04-09 02:07:37 zappo Exp $ + +;; This file is not part of GNU Emacs. + +;; This program 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 2, or (at +;; your option) any later version. + +;; This program 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 this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; Parser engine and runtime of Wisent. +;; +;; Wisent (the European Bison ;-) is an Elisp implementation of the +;; GNU Compiler Compiler Bison. The Elisp code is a port of the C +;; code of GNU Bison 1.28 & 1.31. +;; +;; For more details on the basic concepts for understanding Wisent, +;; read the Bison manual ;) +;; +;; For more details on Wisent itself read the Wisent manual. + +;;; History: +;; + +;;; Code: +(provide 'wisent) + +(defgroup wisent nil + " + /\\_.-^^^-._/\\ The GNU + \\_ _/ + ( `o ` (European ;-) Bison + \\ ` / + ( D ,¨ for Emacs! + ` ~ ,¨ + `\"\"" + :group 'semantic) + + +;;;; ------------- +;;;; Runtime stuff +;;;; ------------- + +;;; Compatibility +(eval-and-compile + (if (fboundp 'char-valid-p) + (defalias 'wisent-char-p 'char-valid-p) + (defalias 'wisent-char-p 'char-or-char-int-p))) + +;;; Printed representation of terminals and nonterminals +(defconst wisent-escape-sequence-strings + '( + (?\a . "'\\a'") ; C-g + (?\b . "'\\b'") ; backspace, BS, C-h + (?\t . "'\\t'") ; tab, TAB, C-i + (?\n . "'\\n'") ; newline, C-j + (?\v . "'\\v'") ; vertical tab, C-k + (?\f . "'\\f'") ; formfeed character, C-l + (?\r . "'\\r'") ; carriage return, RET, C-m + (?\e . "'\\e'") ; escape character, ESC, C-[ + (?\\ . "'\\'") ; backslash character, \ + (?\d . "'\\d'") ; delete character, DEL + ) + "Printed representation of usual escape sequences.") + +(defsubst wisent-item-to-string (item) + "Return a printed representation of ITEM. +ITEM can be a nonterminal or terminal symbol, or a character literal." + (if (wisent-char-p item) + (or (cdr (assq item wisent-escape-sequence-strings)) + (format "'%c'" item)) + (symbol-name item))) + +(defsubst wisent-token-to-string (token) + "Return a printed representation of lexical token TOKEN." + (format "%s%s(%S)" (wisent-item-to-string (car token)) + (if (nth 2 token) (format "@%s" (nth 2 token)) "") + (nth 1 token))) + +;;; Special symbols +(defconst wisent-eoi-term '$EOI + "End Of Input token.") + +(defconst wisent-error-term 'error + "Error recovery token.") + +(defconst wisent-accept-tag 'accept + "Accept result after input successfully parsed.") + +(defconst wisent-error-tag 'error + "Process a syntax error.") + +;;; Special functions +(defun wisent-automaton-p (obj) + "Return non-nil if OBJ is a LALR automaton. +If OBJ is a symbol check its value." + (and obj (symbolp obj) (boundp obj) + (setq obj (symbol-value obj))) + (and (vectorp obj) (= 4 (length obj)) + (vectorp (aref obj 0)) (vectorp (aref obj 1)) + (= (length (aref obj 0)) (length (aref obj 1))) + (listp (aref obj 2)) (vectorp (aref obj 3)))) + +(defsubst wisent-region (&rest positions) + "Return the start/end positions of the region including POSITIONS. +Each element of POSITIONS is a pair (START-POS . END-POS) or nil. The +returned value is the pair (MIN-START-POS . MAX-END-POS) or nil if no +POSITIONS are available." + (let ((pl (delq nil positions))) + (if pl + (cons (apply #'min (mapcar #'car pl)) + (apply #'max (mapcar #'cdr pl)))))) + +;;; Reporting +;;;###autoload +(defvar wisent-parse-verbose-flag nil + "*Non-nil means to issue more messages while parsing.") + +;;;###autoload +(defun wisent-parse-toggle-verbose-flag () + "Toggle whether to issue more messages while parsing." + (interactive) + (setq wisent-parse-verbose-flag (not wisent-parse-verbose-flag)) + (when (cedet-called-interactively-p 'interactive) + (message "More messages while parsing %sabled" + (if wisent-parse-verbose-flag "en" "dis")))) + +(defsubst wisent-message (string &rest args) + "Print a one-line message if `wisent-parse-verbose-flag' is set. +Pass STRING and ARGS arguments to `message'." + (and wisent-parse-verbose-flag + (apply 'message string args))) + +;;;; -------------------- +;;;; The LR parser engine +;;;; -------------------- + +(defcustom wisent-parse-max-stack-size 500 + "The parser stack size." + :type 'integer + :group 'wisent) + +(defcustom wisent-parse-max-recover 3 + "Number of tokens to shift before turning off error status." + :type 'integer + :group 'wisent) + +(defvar wisent-discarding-token-functions nil + "List of functions to be called when discarding a lexical token. +These functions receive the lexical token discarded. +When the parser encounters unexpected tokens, it can discards them, +based on what directed by error recovery rules. Either when the +parser reads tokens until one is found that can be shifted, or when an +semantic action calls the function `wisent-skip-token' or +`wisent-skip-block'. +For language specific hooks, make sure you define this as a local +hook.") + +(defvar wisent-pre-parse-hook nil + "Normal hook run just before entering the LR parser engine.") + +(defvar wisent-post-parse-hook nil + "Normal hook run just after the LR parser engine terminated.") + +(defvar wisent-loop nil + "The current parser action. +Stop parsing when set to nil. +This variable only has meaning in the scope of `wisent-parse'.") + +(defvar wisent-nerrs nil + "The number of parse errors encountered so far.") + +(defvar wisent-lookahead nil + "The lookahead lexical token. +This value is non-nil if the parser terminated because of an +unrecoverable error.") + +;; Variables and macros that are useful in semantic actions. +(defvar wisent-parse-lexer-function nil + "The user supplied lexer function. +This function don't have arguments. +This variable only has meaning in the scope of `wisent-parse'.") + +(defvar wisent-parse-error-function nil + "The user supplied error function. +This function must accept one argument, a message string. +This variable only has meaning in the scope of `wisent-parse'.") + +(defvar wisent-input nil + "The last token read. +This variable only has meaning in the scope of `wisent-parse'.") + +(defvar wisent-recovering nil + "Non-nil means that the parser is recovering. +This variable only has meaning in the scope of `wisent-parse'.") + +;; Variables that only have meaning in the scope of a semantic action. +;; These global definitions avoid byte-compiler warnings. +(defvar $region nil) +(defvar $nterm nil) +(defvar $action nil) + +(defmacro wisent-lexer () + "Obtain the next terminal in input." + '(funcall wisent-parse-lexer-function)) + +(defmacro wisent-error (msg) + "Call the user supplied error reporting function with message MSG." + `(funcall wisent-parse-error-function ,msg)) + +(defmacro wisent-errok () + "Resume generating error messages immediately for subsequent syntax errors. +This is useful primarily in error recovery semantic actions." + '(setq wisent-recovering nil)) + +(defmacro wisent-clearin () + "Discard the current lookahead token. +This will cause a new lexical token to be read. +This is useful primarily in error recovery semantic actions." + '(setq wisent-input nil)) + +(defmacro wisent-abort () + "Abort parsing and save the lookahead token. +This is useful primarily in error recovery semantic actions." + '(setq wisent-lookahead wisent-input + wisent-loop nil)) + +(defmacro wisent-set-region (start end) + "Change the region of text matched by the current nonterminal. +START and END are respectively the beginning and end positions of the +region. If START or END values are not a valid positions the region +is set to nil." + `(setq $region (and (number-or-marker-p ,start) + (number-or-marker-p ,end) + (cons ,start ,end)))) + +(defun wisent-skip-token () + "Skip the lookahead token in order to resume parsing. +Return nil. +Must be used in error recovery semantic actions." + (if (eq (car wisent-input) wisent-eoi-term) + ;; Does nothing at EOI to avoid infinite recovery loop. + nil + (wisent-message "%s: skip %s" $action + (wisent-token-to-string wisent-input)) + (run-hook-with-args + 'wisent-discarding-token-functions wisent-input) + (wisent-clearin) + (wisent-errok))) + +(defun wisent-skip-block (&optional bounds) + "Safely skip a parenthesized block in order to resume parsing. +Return nil. +Must be used in error recovery semantic actions. +Optional argument BOUNDS is a pair (START . END) which indicates where +the parenthesized block starts. Typically the value of a `$regionN' +variable, where `N' is the Nth element of the current rule components +that match the block beginning. It defaults to the value of the +`$region' variable." + (let ((start (car (or bounds $region))) + end input) + (if (not (number-or-marker-p start)) + ;; No nonterminal region available, skip the lookahead token. + (wisent-skip-token) + ;; Try to skip a block. + (if (not (setq end (save-excursion + (goto-char start) + (and (looking-at "\\s(") + (condition-case nil + (1- (scan-lists (point) 1 0)) + (error nil)))))) + ;; Not actually a block, skip the lookahead token. + (wisent-skip-token) + ;; OK to safely skip the block, so read input until a matching + ;; close paren or EOI is encountered. + (setq input wisent-input) + (while (and (not (eq (car input) wisent-eoi-term)) + (< (nth 2 input) end)) + (run-hook-with-args + 'wisent-discarding-token-functions input) + (setq input (wisent-lexer))) + (wisent-message "%s: in enclosing block, skip from %s to %s" + $action + (wisent-token-to-string wisent-input) + (wisent-token-to-string input)) + (if (eq (car wisent-input) wisent-eoi-term) + ;; Does nothing at EOI to avoid infinite recovery loop. + nil + (wisent-clearin) + (wisent-errok)) + ;; Set end of $region to end of block. + (wisent-set-region (car $region) (1+ end)) + nil)))) + +;;; Core parser engine +(defsubst wisent-production-bounds (stack i j) + "Determine the start and end locations of a production value. +Return a pair (START . END), where START is the first available start +location, and END the last available end location, in components +values of the rule currently reduced. +Return nil when no component location is available. +STACK is the parser stack. +I and J are the indices in STACK of respectively the value of the +first and last components of the current rule. +This function is for internal use by semantic actions' generated +lambda-expression." + (let ((f (cadr (aref stack i))) + (l (cddr (aref stack j)))) + (while (/= i j) + (cond + ((not f) (setq f (cadr (aref stack (setq i (+ i 2)))))) + ((not l) (setq l (cddr (aref stack (setq j (- j 2)))))) + ((setq i j)))) + (and f l (cons f l)))) + +(defmacro wisent-parse-action (i al) + "Return the next parser action. +I is a token item number and AL is the list of (item . action) +available at current state. The first element of AL contains the +default action for this state." + `(cdr (or (assq ,i ,al) (car ,al)))) + +(defsubst wisent-parse-start (start starts) + "Return the first lexical token to shift for START symbol. +STARTS is the table of allowed start symbols or nil if the LALR +automaton has only one entry point." + (if (null starts) + ;; Only one entry point, return the first lexical token + ;; available in input. + (wisent-lexer) + ;; Multiple start symbols defined, return the internal lexical + ;; token associated to START. By default START is the first + ;; nonterminal defined in STARTS. + (let ((token (cdr (if start (assq start starts) (car starts))))) + (if token + (list token (symbol-name token)) + (error "Invalid start symbol %s" start))))) + +(defun wisent-parse (automaton lexer &optional error start) + "Parse input using the automaton specified in AUTOMATON. + +- AUTOMATON is an LALR(1) automaton generated by + `wisent-compile-grammar'. + +- LEXER is a function with no argument called by the parser to obtain + the next terminal (token) in input. + +- ERROR is an optional reporting function called when a parse error + occurs. It receives a message string to report. It defaults to the + function `wisent-message'. + +- START specify the start symbol (nonterminal) used by the parser as + its goal. It defaults to the start symbol defined in the grammar + \(see also `wisent-compile-grammar')." + (run-hooks 'wisent-pre-parse-hook) + (let* ((actions (aref automaton 0)) + (gotos (aref automaton 1)) + (starts (aref automaton 2)) + (stack (make-vector wisent-parse-max-stack-size nil)) + (sp 0) + (wisent-loop t) + (wisent-parse-error-function (or error 'wisent-message)) + (wisent-parse-lexer-function lexer) + (wisent-recovering nil) + (wisent-input (wisent-parse-start start starts)) + state tokid choices choice) + (setq wisent-nerrs 0 ;; Reset parse error counter + wisent-lookahead nil) ;; and lookahead token + (aset stack 0 0) ;; Initial state + (while wisent-loop + (setq state (aref stack sp) + tokid (car wisent-input) + wisent-loop (wisent-parse-action tokid (aref actions state))) + (cond + + ;; Input successfully parsed + ;; ------------------------- + ((eq wisent-loop wisent-accept-tag) + (setq wisent-loop nil)) + + ;; Syntax error in input + ;; --------------------- + ((eq wisent-loop wisent-error-tag) + ;; Report this error if not already recovering from an error. + (setq choices (aref actions state)) + (or wisent-recovering + (wisent-error + (format "Syntax error, unexpected %s, expecting %s" + (wisent-token-to-string wisent-input) + (mapconcat 'wisent-item-to-string + (delq wisent-error-term + (mapcar 'car (cdr choices))) + ", ")))) + ;; Increment the error counter + (setq wisent-nerrs (1+ wisent-nerrs)) + ;; If just tried and failed to reuse lookahead token after an + ;; error, discard it. + (if (eq wisent-recovering wisent-parse-max-recover) + (if (eq tokid wisent-eoi-term) + (wisent-abort) ;; Terminate if at end of input. + (wisent-message "Error recovery: skip %s" + (wisent-token-to-string wisent-input)) + (run-hook-with-args + 'wisent-discarding-token-functions wisent-input) + (setq wisent-input (wisent-lexer))) + + ;; Else will try to reuse lookahead token after shifting the + ;; error token. + + ;; Each real token shifted decrements this. + (setq wisent-recovering wisent-parse-max-recover) + ;; Pop the value/state stack to see if an action associated + ;; to special terminal symbol 'error exists. + (while (and (>= sp 0) + (not (and (setq state (aref stack sp) + choices (aref actions state) + choice (assq wisent-error-term choices)) + (natnump (cdr choice))))) + (setq sp (- sp 2))) + + (if (not choice) + ;; No 'error terminal was found. Just terminate. + (wisent-abort) + ;; Try to recover and continue parsing. + ;; Shift the error terminal. + (setq state (cdr choice) ; new state + sp (+ sp 2)) + (aset stack (1- sp) nil) ; push value + (aset stack sp state) ; push new state + ;; Adjust input to error recovery state. Unless 'error + ;; triggers a reduction, eat the input stream until an + ;; expected terminal symbol is found, or EOI is reached. + (if (cdr (setq choices (aref actions state))) + (while (not (or (eq (car wisent-input) wisent-eoi-term) + (assq (car wisent-input) choices))) + (wisent-message "Error recovery: skip %s" + (wisent-token-to-string wisent-input)) + (run-hook-with-args + 'wisent-discarding-token-functions wisent-input) + (setq wisent-input (wisent-lexer))))))) + + ;; Shift current token on top of the stack + ;; --------------------------------------- + ((natnump wisent-loop) + ;; Count tokens shifted since error; after + ;; `wisent-parse-max-recover', turn off error status. + (setq wisent-recovering (and (natnump wisent-recovering) + (> wisent-recovering 1) + (1- wisent-recovering))) + (setq sp (+ sp 2)) + (aset stack (1- sp) (cdr wisent-input)) + (aset stack sp wisent-loop) + (setq wisent-input (wisent-lexer))) + + ;; Reduce by rule (call semantic action) + ;; ------------------------------------- + (t + (setq sp (funcall wisent-loop stack sp gotos)) + (or wisent-input (setq wisent-input (wisent-lexer)))))) + (run-hooks 'wisent-post-parse-hook) + (car (aref stack 1)))) + +;;; wisent.el ends here diff --git a/auto-install/working.el b/auto-install/working.el new file mode 100644 index 0000000..2eaecbd --- /dev/null +++ b/auto-install/working.el @@ -0,0 +1,639 @@ +;;; working --- Display a "working" message in the minibuffer. + +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2007, 2008, 2009 Eric M. Ludlam + +;; Author: Eric M. Ludlam +;; Version: 1.5 +;; Keywords: status + +;; This program 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 2, or (at your option) +;; any later version. + +;; This program 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; Working lets Emacs Lisp programmers easily display working messages. +;; These messages typically come in the form of a percentile, or generic +;; doodles if a maximum is unknown. +;; +;; The working entry points are quite simple. If you have a loop that needs +;; to display a status as it goes along, it would look like this: +;; +;; (working-status-forms "Doing stuff" "done" +;; (while condition +;; (working-status (calc-percentile)) +;; (my-work)) +;; (working-status t)) +;; +;; If you cannot calculate a percentile, use the function +;; `working-dynamic-status' instead, and pass in what you know. For +;; both status printing functions, the first argument is optional, +;; and you may pass in additional arguments as `format' elements +;; to the first argument of `working-status-forms'. +;; +;; See the examples at the end of the buffer. + +;;; Backwards Compatibility: +;; +;; If you want to use working in your program, but don't want to force people +;; to install working, use could add this at the beginning of your program for +;; compatibility. +;; +;; (eval-and-compile +;; (condition-case nil +;; (require 'working) +;; (error +;; (progn +;; (defmacro working-status-forms (message donestr &rest forms) +;; "Contain a block of code during which a working status is shown." +;; (list 'let (list (list 'msg message) (list 'dstr donestr) +;; '(ref1 0)) +;; (cons 'progn forms))) +;; +;; (defun working-status (&optional percent &rest args) +;; "Called within the macro `working-status-forms', show the status." +;; (message "%s%s" (apply 'format msg args) +;; (if (eq percent t) (concat "... " dstr) +;; (format "... %3d%%" +;; (or percent +;; (floor (* 100.0 (/ (float (point)) +;; (point-max))))))))) +;; +;; (defun working-dynamic-status (&optional number &rest args) +;; "Called within the macro `working-status-forms', show the status." +;; (message "%s%s" (apply 'format msg args) +;; (format "... %c" (aref [ ?- ?/ ?| ?\\ ] (% ref1 4)))) +;; (setq ref1 (1+ ref1))) +;; +;; (put 'working-status-forms 'lisp-indent-function 2))))) +;; +;; Depending on what features you use, it is, of course, easy to +;; reduce the total size of the above by omitting those features you +;; do not use. + +;;; History: +;; +;; 1.0 First Version +;; +;; 1.1 Working messages are no longer logged. +;; Added a generic animation display funciton: +;; Convert celeron to animator +;; Added a bounce display +;; Made working robust under a multi-frame environment (speedbar) +;; +;; 1.2 Fix up documentation. +;; Updated dotgrowth function for exceptionally large numbers of dots. +;; Added the percentage bubble displays. +;; +;; 1.3 Added `working-status-timeout' and `working-status-call-process'. +;; Added test fns `working-wait-for-keypress' and `working-verify-sleep'. +;; +;; 1.4 ??? +;; +;; 1.5 Use features from the fame library. +;; + +(require 'custom) +(require 'fame) + +;;; Code: +(defgroup working nil + "Working messages display." + :prefix "working" + :group 'lisp + ) + +;;; User configurable variables +;; +(defcustom working-status-percentage-type 'working-bar-percent-display + "*Function used to display the percent status. +Functions provided in `working' are: + `working-percent-display' + `working-bar-display' + `working-bar-percent-display' + `working-percent-bar-display' + `working-bubble-display' + `working-bubble-precent-display' + `working-celeron-percent-display'" + :group 'working + :type '(choice (const working-percent-display) + (const working-bar-display) + (const working-bar-percent-display) + (const working-percent-bar-display) + (const working-bubble-display) + (const working-bubble-percent-display) + (const working-celeron-percent-display) + (const nil))) + +(defcustom working-status-dynamic-type 'working-celeron-display + "*Function used to display an animation indicating progress being made. +Dynamic working types occur when the program does not know how long +it will take ahead of time. Functions provided in `working' are: + `working-number-display' + `working-text-display' + `working-spinner-display' + `working-dotgrowth-display' + `working-celeron-display' + `working-bounce-display'" + :group 'working + :type '(choice (const working-number-display) + (const working-text-display) + (const working-spinner-display) + (const working-dotgrowth-display) + (const working-celeron-display) + (const working-bounce-display) + (const nil))) + +(defcustom working-percentage-step 2 + "*Percentage display step. +A number representing how large a step must be taken when working a +percentage display. A number such as `2' means `2%'." + :group 'working' + :type 'number) + +;;; Mode line hacks +;; +;; When the user doesn't want messages in the minibuffer, hack the mode +;; line of the current buffer. +(if (featurep 'xemacs) + (eval-and-compile (defalias 'working-mode-line-update 'redraw-modeline)) + (eval-and-compile (defalias 'working-mode-line-update 'force-mode-line-update))) + +(defvar working-mode-line-message nil + "Message used by working when showing status in the mode line.") + +(if (boundp 'global-mode-string) + (progn + ;; If this variable exists, use it to push the working message into + ;; an interesting part of the mode line. + (if (null global-mode-string) + (setq global-mode-string (list ""))) + (setq global-mode-string + (append global-mode-string '(working-mode-line-message)))) + ;; Else, use minor mode trickery to get a reliable way of doing the + ;; same thing across many versions of Emacs. + (setq minor-mode-alist (cons + '(working-mode-line-message working-mode-line-message) + minor-mode-alist)) + ) + +(defvar working-use-echo-area-p t + "*Non-nil use the echo area to display working messages.") + +;;; Variables used in stages +;; +(defvar working-message nil + "Message stored when in a status loop.") +(defvar working-donestring nil + "Done string stored when in a status loop.") +(defvar working-ref1 nil + "A reference number used in a status loop.") +(defvar working-last-percent 0 + "A reference number used in a status loop.") + +;;; Programmer functions +;; +(eval-when-compile + (cond + ((fboundp 'noninteractive) + ;; Silence the XEmacs byte compiler + (defvar noninteractive)) + ((boundp 'noninteractive) + ;; Silence the Emacs byte compiler + (defun noninteractive nil)) + )) + +(defsubst working-noninteractive () + "Return non-nil if running without interactive terminal." + (if (boundp 'noninteractive) + noninteractive + (noninteractive))) + +(defun working-message-echo (&rest args) + "Print but don't log a one-line message at the bottom of the screen. +See the function `message' for details on ARGS." + (or (working-noninteractive) + (apply 'fame-message-nolog args))) + +(defalias 'working-current-message 'fame-current-message) +(defalias 'working-temp-message 'fame-temp-message) + +(defun working-message (&rest args) + "Display a message using `working-message-echo' or in mode line. +See the function `message' for details on ARGS." + (if working-use-echo-area-p + (apply 'working-message-echo args) + (when (not working-mode-line-message) + ;; If we start out nil, put stuff in to show we are up to + (setq working-mode-line-message "Working...") + (working-mode-line-update) + (sit-for 0) + ))) + +;;; Compatibility +(cond ((fboundp 'run-with-timer) + (eval-and-compile (defalias 'working-run-with-timer 'run-with-timer)) + (eval-and-compile (defalias 'working-cancel-timer 'cancel-timer)) + ) + ;;Add compatibility here + (t + ;; This gets the message out but has no timers. + (defun working-run-with-timer (&rest foo) + (working-message working-message)) + (defun working-cancel-timer (&rest foo) + (working-message "%s%s" + working-message + working-donestring))) + ) + +(defmacro working-status-forms (message donestr &rest forms) + "Contain a block of code during which a working status is shown. +MESSAGE is the message string to use and DONESTR is the completed text +to use when the functions `working-status' is called from FORMS." + (let ((current-message (make-symbol "working-current-message"))) + `(let ((,current-message (working-current-message)) + (working-message ,message) + (working-donestring ,donestr) + (working-ref1 0) + (working-last-percent 0)) + (unwind-protect + (progn ,@forms) + (setq working-mode-line-message nil) + (if working-use-echo-area-p + (message ,current-message) + (working-mode-line-update) + (sit-for 0)))) + )) +(put 'working-status-forms 'lisp-indent-function 2) + +(defmacro working-status-timeout (timeout message donestr &rest forms) + "Contain a block of code during which working status is shown. +The code may call `sit-for' or `accept-process-output', so a timer +is needed to update the message. +TIMEOUT is the length of time to wait between message updates. +MESSAGE is the message string to use and DONESTR is the completed text +to use when the functions `working-status' is called from FORMS." + (let ((current-message (make-symbol "working-current-message"))) + `(let* ((,current-message (working-current-message)) + (working-message ,message) + (working-donestring ,donestr) + (working-ref1 0) + (time ,timeout) + (working-timer + (working-run-with-timer time time 'working-dynamic-status))) + (unwind-protect + (progn ,@forms) + (working-cancel-timer working-timer) + (working-dynamic-status t) + (setq working-mode-line-message nil) + (if working-use-echo-area-p + (message ,current-message) + (working-mode-line-update) + (sit-for 0)))) + )) +(put 'working-status-timeout 'lisp-indent-function 3) + +(defun working-status-call-process + (timeout message donestr program &optional infile buffer display &rest args) + "Display working messages while running a process. +TIMEOUT is how fast to display the messages. +MESSAGE is the message to show, and DONESTR is the string to add when done. +CALLPROCESSARGS are the same style of args as passed to `call-process'. +The are: PROGRAM, INFILE, BUFFER, DISPLAY, and ARGS. +Since it actually calls `start-process', not all features will work." + (working-status-timeout timeout message donestr + (let ((proc (apply 'start-process "working" + (if (listp buffer) (car buffer) buffer) + program args))) + (set-process-sentinel proc 'list) + (while (eq (process-status proc) 'run) + (accept-process-output proc) + ;; accept-process-output caused my solaris Emacs 20.3 to crash. + ;; If this is unreliable for you, use the below which will work + ;; in that situation. + ;; (if (not (sit-for timeout)) (read-event)) + )))) + +(defun working-status (&optional percent &rest args) + "Called within the macro `working-status-forms', show the status. +If PERCENT is nil, then calculate PERCENT from the value of `point' in +the current buffer. If it is a number or float, use it as the raw +percentile. +Additional ARGS are passed to fill on % elements of MESSAGE from the +macro `working-status-forms'." + (when (and working-message working-status-percentage-type) + (let ((p (or percent + (floor (* 100.0 (/ (float (point)) (point-max))))))) + (if (or (eq p t) + (> (- p working-last-percent) working-percentage-step)) + (let* ((m1 (apply 'format working-message args)) + (m2 (funcall working-status-percentage-type (length m1) p))) + (working-message "%s%s" m1 m2) + (setq working-last-percent p)))))) + +(defun working-dynamic-status (&optional number &rest args) + "Called within the macro `working-status-forms', show the status. +If NUMBER is nil, then increment a local NUMBER from 0 with each call. +If it is a number or float, use it as the raw percentile. +Additional ARGS are passed to fill on % elements of MESSAGE from the +macro `working-status-forms'." + (when (and working-message working-status-dynamic-type) + (let* ((n (or number working-ref1)) + (m1 (apply 'format working-message args)) + (m2 (funcall working-status-dynamic-type (length m1) n))) + (working-message "%s%s" m1 m2) + (setq working-ref1 (1+ working-ref1))))) + +;;; Utilities +;; +(defun working-message-frame-width () + "Return the width of the frame the working message will be in." + (let* ((mbw (cond ((fboundp 'frame-parameter) + (frame-parameter (selected-frame) 'minibuffer)) + ((fboundp 'frame-property) + (frame-property (selected-frame) 'minibuffer)))) + (fr (if (windowp mbw) + (window-frame mbw) + default-minibuffer-frame))) + (frame-width fr))) + +;;; Percentage display types. +;; +(defun working-percent-display (length percent) + "Return the percentage of the buffer that is done in a string. +LENGTH is the amount of display that has been used. PERCENT +is t to display the done string, or the percentage to display." + (cond ((eq percent t) (concat "... " working-donestring)) + ;; All the % signs because it then gets passed to message. + (t (format "... %3d%%" percent)))) + +(defun working-bar-display (length percent) + "Return a string with a bar-graph showing percent. +LENGTH is the amount of display that has been used. PERCENT +is t to display the done string, or the percentage to display." + (let ((bs (- (working-message-frame-width) length 5))) + (cond ((eq percent t) + (concat ": [" (make-string bs ?#) "] " working-donestring)) + ((< bs 0) "") + (t (let ((bsl (floor (* (/ percent 100.0) bs)))) + (concat ": [" + (make-string bsl ?#) + (make-string (- bs bsl) ?.) + "]")))))) + +(defun working-bar-percent-display (length percent) + "Return a string with a bar-graph and percentile showing percentage. +LENGTH is the amount of display that has been used. PERCENT +is t to display the done string, or the percentage to display." + (let* ((ps (if (eq percent t) + (concat "... " working-donestring) + (working-percent-display length percent))) + (psl (+ 2 length (length ps)))) + (cond ((eq percent t) + (concat (working-bar-display psl 100) " " ps)) + (t + (setq working-ref1 (length ps)) + (concat (working-bar-display psl percent) " " ps))))) + +(defun working-percent-bar-display (length percent) + "Return a string with a percentile and bar-graph showing percentage. +LENGTH is the amount of display that has been used. PERCENT +is t to display the done string, or the percentage to display." + (let* ((ps (if (eq percent t) + (concat "... " working-donestring) + (working-percent-display length percent))) + (psl (+ 1 length (length ps)))) + (cond ((eq percent t) + (concat ps " " (working-bar-display psl 100))) + (t + (setq working-ref1 (length ps)) + (concat ps " " (working-bar-display psl percent)))))) + +(defun working-bubble-display (length percent) + "Return a string with a bubble graph indicating the precent completed. +LENGTH is the amount of the display that has been used. PERCENT +is t to display the done string, or the percentage to display." + (if (eq percent t) + (concat " [@@@@@@@@@@@@@@@@@@@@] " working-donestring) + (let ((bs " [") + (bubbles [ ?. ?- ?o ?O ?@ ])) + (if (> percent 5) + (setq bs (concat bs (make-string (/ (floor percent) 5) ?@)))) + (setq bs (concat bs + (char-to-string (aref bubbles (% (floor percent) 5))))) + (if (< (/ (floor percent) 5) 20) + (setq bs (concat bs (make-string (- 19 (/ (floor percent) 5)) ? )))) + (concat bs "]")))) + +(defun working-bubble-percent-display (length percent) + "Return a string with a percentile and bubble graph showing percentage. +LENGTH is the amount of display that has been used. PERCENT +is t to display the done string, or the percentage to display." + (let* ((ps (if (eq percent t) + (concat " ... " working-donestring) + (working-percent-display length percent))) + (psl (+ 1 length (length ps)))) + (cond ((eq percent t) + (concat (working-bubble-display psl t))) + (t + (setq working-ref1 (length ps)) + (concat (working-bubble-display psl percent) ps))))) + +(defun working-celeron-percent-display (length percent) + "Return a string with a celeron and string showing percent. +LENGTH is the amount of display that has been used. PERCENT +is t to display the done string, or the percentage to display." + (prog1 + (cond ((eq percent t) (working-celeron-display length t)) + ;; All the % signs because it then gets passed to message. + (t (format "%s %3d%%" + (working-celeron-display length 0) + percent))) + (setq working-ref1 (1+ working-ref1)))) + +;;; Dynamic display types. +;; +(defun working-number-display (length number) + "Return a string displaying the number of things that happened. +LENGTH is the amount of display that has been used. NUMBER +is t to display the done string, or the number to display." + (cond ((eq number t) (concat "... " working-donestring)) + ;; All the % signs because it then gets passed to message. + (t (format "... %d" number)))) + +(defun working-text-display (length text) + "Return a string displaying the name of things that happened. +LENGTH is the amount of display that has been used. TEXT +is t to display the done string, or the text to display." + (if (eq text t) + (concat "... " working-donestring) + (format "... %s" text))) + +(defun working-spinner-display (length number) + "Return a string displaying a spinner based on a number. +LENGTH is the amount of display that has been used. NUMBER +is t to display the done string, or the number to display." + (cond ((eq number t) (concat "... " working-donestring)) + ;; All the % signs because it then gets passed to message. + (t (format "... %c" (aref [ ?- ?/ ?| ?\\ ] (% working-ref1 4)))))) + +(defun working-dotgrowth-display (length number) + "Return a string displaying growing dots due to activity. +LENGTH is the amount of display that has been used. NUMBER +is t to display the done string, or the number to display. +This display happens to ignore NUMBER." + (let* ((width (- (working-message-frame-width) 4 length)) + (num-wrap (/ working-ref1 width)) + (num-. (% working-ref1 width)) + (dots [ ?. ?, ?o ?* ?O ?@ ?# ])) + (concat " (" (make-string num-. (aref dots (% num-wrap (length dots)))) ")" + (if (eq number t) (concat " " working-donestring) "")))) + +(defun working-frame-animation-display (length number frames) + "Manage a simple frame-based animation for working functions. +LENGTH is the number of characters left. NUMBER is a passed in +number (which happens to be ignored.). While coders pass t into +NUMBER, functions using this should convert NUMBER into a vector +describing how to render the done message. +Argument FRAMES are the frames used in the animation." + (cond ((vectorp number) + (let ((zone (- (length (aref frames 0)) (length (aref number 0)) + (length (aref number 1))))) + (if (< (length working-donestring) zone) + (concat " " (aref number 0) + (make-string + (ceiling (/ (- (float zone) + (length working-donestring)) 2)) ? ) + working-donestring + (make-string + (floor (/ (- (float zone) + (length working-donestring)) 2)) ? ) + (aref number 1)) + (concat " " (aref frames (% working-ref1 (length frames))) + " " working-donestring)))) + (t (concat " " (aref frames (% working-ref1 (length frames))))))) + +(defvar working-celeron-strings + [ "[O ]" "[oO ]" "[-oO ]" "[ -oO ]" "[ -oO ]" "[ -oO]" + "[ -O]" "[ O]" "[ Oo]" "[ Oo-]" "[ Oo- ]" "[ Oo- ]" + "[Oo- ]" "[O- ]"] + "Strings representing a silly celeron.") + +(defun working-celeron-display (length number) + "Return a string displaying a celeron as things happen. +LENGTH is the amount of display that has been used. NUMBER +is t to display the done string, or the number to display." + (cond ((eq number t) + (working-frame-animation-display length [ "[" "]" ] + working-celeron-strings)) + ;; All the % signs because it then gets passed to message. + (t (working-frame-animation-display length number + working-celeron-strings)))) + +(defvar working-bounce-strings + [ + "[_ ]" + "[ - ]" + "[ ~ ]" + "[ - ]" + "[ _ ]" + "[ - ]" + "[ ~ ]" + "[ - ]" + "[ _ ]" + "[ -]" + + ] + "Strings for the bounce animation.") + +(defun working-bounce-display (length number) + "Return a string displaying a celeron as things happen. +LENGTH is the amount of display that has been used. NUMBER +is t to display the done string, or the number to display." + (cond ((eq number t) + (working-frame-animation-display length [ "[" "]" ] + working-bounce-strings)) + ;; All the % signs because it then gets passed to message. + (t (working-frame-animation-display length number + working-bounce-strings)))) + +;;; Some edebug hooks +;; +(add-hook + 'edebug-setup-hook + (lambda () + (def-edebug-spec working-status-forms (form form def-body)) + (def-edebug-spec working-status-timeout (form form form def-body)))) + +;;; Example function using `working' +;; +(defun working-verify-parenthesis-a () + "Verify all the parenthesis in an elisp program buffer." + (interactive) + (working-status-forms "Scanning" "done" + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + ;; Use default buffer position. + (working-status) + (forward-sexp 1) + (sleep-for 0.05) + ) + (working-status t)) + (sit-for 1))) + +(defun working-verify-parenthesis-b () + "Verify all the parenthesis in an elisp program buffer." + (interactive) + (working-status-forms "Scanning" "done" + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + ;; Use default buffer position. + (working-dynamic-status nil) + (forward-sexp 1) + (sleep-for 0.05) + ) + (working-dynamic-status t)) + (sit-for 0))) + +(defun working-wait-for-keypress () + "Display funny graphics while waiting for a keypress." + (interactive) + (working-status-timeout .1 "Working Test: Press a key" "done" + (while (sit-for 10))) + (when (input-pending-p) + (if (fboundp 'read-event) + (read-event) + (read-char))) + ) + +(defun working-verify-sleep () + "Display funny graphics while waiting for sleep to sleep." + (interactive) + (working-status-call-process .1 "Zzzzz" "Snort" "sleep" nil nil nil "2")) + +(defun working-verify-mode-line () + "Display graphics in the mode-line for timeout." + (interactive) + (let ((working-use-echo-area-p nil)) + (message "Pres a Key") + (working-status-timeout .1 "" "" + (while (sit-for 10))) + )) + +(provide 'working) + +;;; working.el ends here diff --git a/auto-install/xpath-parser.el b/auto-install/xpath-parser.el new file mode 100644 index 0000000..f19ac57 --- /dev/null +++ b/auto-install/xpath-parser.el @@ -0,0 +1,556 @@ +;;; xpath-parser.el --- XPATH parser + +;; Copyright (C) 2001 Alex Schroeder + +;; Author: Alex Schroeder +;; Maintainer: Oliver Scholz +;; Version: 1.0.0 +;; Keywords: xml +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?XmlParser +;; Version: $Id: xpath-parser.el,v 1.6 2003/12/16 00:27:36 egoge Exp egoge $ + +;; This file is not part of GNU Emacs. + +;; This 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 2, or (at your option) any later +;; version. + +;; This 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Used by xpath.el, tables created automatically from xpath.bnf. The +;; main entry points are `xpath-lex-string' and `xpath-lex-region'. +;; These two functions prepare a list of preliminary tokens and store +;; them in the variable `xpath-token-input'. Next, call `wisent-parse' +;; using `xpath-tables' and `xpath-pop-input' and an error function of +;; your liking: (wisent-parse xpath-tables #'xpath-pop-input #'error) +;; +;; `wisent-parse' then returns a list of elements STEP. Each STEP has +;; the form (TEST PREDICATE). Both TEST and PREDICATE have the form +;; (FUNC PARAMS...). FUNC is always a function which must accept all +;; the PARAMS as arguments, plus a node. The TEST FUNC must then return +;; a list of nodes, the PREDICATE must return either nil or non-nil. +;; The PREDICATE is used for filtering the list returned by TEST FUNC. +;; +;; See xpath.el for more information on all the functions used. + +;;; Code: + +(require 'wisent) +(eval-when-compile (require 'wisent-comp)) + +;; (setq wisent-verbose-flag t) +(defconst xpath-document-root-symbol + (make-symbol "document-root") + "Symbol used to indicate the document root. +This is used to specify that a query should start from the owner +document. This is necessary for absolute location paths.") + +(defvar xpath-tables + (wisent-compile-grammar + '((NCNAME LITERAL NUMBER VARIABLEREFERENCE + AND OR DIV MOD + COLON AXISSUF DOTDOT LT GT LE GE NE STAR PLUS MINUS SLASH + UNION LPAREN RPAREN LBRACK RBRACK AT DOT EQ COMMA + NODETYPE FUNCTIONNAME + ANCESTOR ANCESTOR-OR-SELF ATTRIBUTE CHILD DESCENDANT + DESCENDANT-OR-SELF FOLLOWING FOLLOWING-SIBLING NAMESPACE + PARENT PRECEDING PRECEDING-SIBLING SELF) + nil + (TopExpr + ((LocationPath))) + (LocationPath + ((RelativeLocationPath)) + ((AbsoluteLocationPath))) + (AbsoluteLocationPath + ;; ((SLASH)) + ((SLASH RelativeLocationPath) + (append (list xpath-document-root-symbol) $2)) + ((AbbreviatedAbsoluteLocationPath))) + (RelativeLocationPath + ((Step) $1) + ((RelativeLocationPath SLASH Step) + (append $1 $3 nil)) + ((AbbreviatedRelativeLocationPath))) + (Step + ((Basis predicates) + (list + (append $1 $2))) + ((AbbreviatedStep))) + (predicates + (nil) + ((predicates Predicate) + (append $1 $2))) + (Basis + ((AxisName AXISSUF NodeTest) + (list $1 $3)) + ((AbbreviatedBasis) + (list 'xpath-child-axis $1))) + (AxisName + ((ANCESTOR) + 'xpath-ancestor-axis) + ((ANCESTOR-OR-SELF) + 'xpath-ancestor-or-self-axis) + ((ATTRIBUTE) + 'xpath-attribute-axis) + ((CHILD) + 'xpath-child-axis) + ((DESCENDANT) + 'xpath-descendant-axis) + ((DESCENDANT-OR-SELF) + 'xpath-descendant-or-self-axis) + ((FOLLOWING) + 'xpath-following-axis) + ((FOLLOWING-SIBLING) + 'xpath-following-sibling-axis) + ((NAMESPACE) + 'xpath-namespace-axis) + ((PARENT) + 'xpath-parent-axis) + ((PRECEDING) + 'xpath-preceding-axis) + ((PRECEDING-SIBLING) + 'xpath-sibling-axis) + ((SELF) + 'xpath-self-axis)) + (NodeTest + ((NameTest) + (list 'xpath-name-filter $1)) + ((NODETYPE LPAREN Arglist RPAREN) + (list 'xpath-node-type-filter $1)) + ;; ((PROCESSING-INSTRUCTION LPAREN LITERAL RPAREN)) + ) + (Predicate + ((LBRACK PredicateExpr RBRACK) + (list $2))) + (PredicateExpr + ((Expr))) + (AbbreviatedAbsoluteLocationPath + ((SLASH SLASH RelativeLocationPath))) + (AbbreviatedRelativeLocationPath + ((RelativeLocationPath SLASH SLASH Step))) + (AbbreviatedStep + ((DOT)) + ((DOTDOT))) + (AbbreviatedBasis + ((NodeTest)) + ((AT NodeTest))) + (Expr + ((OrExpr))) + (PrimaryExpr + ((VARIABLEREFERENCE)) + ((LPAREN Expr RPAREN)) + ((LITERAL)) + ((NUMBER)) + ((FunctionCall))) + (FunctionCall + ((FUNCTIONNAME LPAREN Arglist RPAREN) + (append + (list (intern (concat "xpath-function/" $1))) + $3))) + ;; (FunctionName + ;; ((POSITION) + ;; 'xpath-position-function) + ;; ((LAST) + ;; 'xpath-last-function) + ;; ((COUNT) + ;; 'xpath-count-function) + ;; ((NAME) + ;; 'xpath-name-function)) + (Arglist + (nil) + ((Arguments))) + (Arguments + ((Argument) + (list $1)) + ((Arguments COMMA Argument) + (append $1 + (list $3)))) + (Argument + ((Expr))) + (UnionExpr + ((PathExpr)) + ((UnionExpr UNION PathExpr))) + (PathExpr + ((LocationPath) + (list 'xpath-resolve-steps 'xpath-context-node + (list 'quote $1))) + ((FilterExpr)) + ((FilterExpr SLASH RelativeLocationPath)) + ((FilterExpr SLASH SLASH RelativeLocationPath))) + (FilterExpr + ((PrimaryExpr)) + ((FilterExpr Predicate))) + (OrExpr + ((AndExpr)) + ((OrExpr OR AndExpr))) + (AndExpr + ((EqualityExpr)) + ((AndExpr AND EqualityExpr))) + (EqualityExpr + ((RelationalExpr)) + ((EqualityExpr EQ RelationalExpr) + (list 'xpath-equal $1 $3)) + ((EqualityExpr NE RelationalExpr))) + (RelationalExpr + ((AdditiveExpr)) + ((RelationalExpr LT AdditiveExpr)) + ((RelationalExpr GT AdditiveExpr)) + ((RelationalExpr LE AdditiveExpr)) + ((RelationalExpr GE AdditiveExpr))) + (AdditiveExpr + ((MultiplicativeExpr)) + ((AdditiveExpr PLUS MultiplicativeExpr)) + ((AdditiveExpr MINUS MultiplicativeExpr))) + (MultiplicativeExpr + ((UnaryExpr)) + ((MultiplicativeExpr STAR UnaryExpr)) + ((MultiplicativeExpr DIV UnaryExpr)) + ((MultiplicativeExpr MOD UnaryExpr))) + (UnaryExpr + ((UnionExpr)) + ((MINUS UnaryExpr))) + (NameTest + ((STAR)) + ((NCNAME COLON STAR)) + ((NCNAME COLON NCNAME)) + ((NCNAME))) + ;; (NodeType + ;; ((COMMENT)) + ;; ((TEXT)) + ;; ((PROCESSING-INSTRUCTION)) + ;; ((NODE))) + ) + nil + ;; '(LocationPath) + ) + "Parser automaton for XPath.") + +(eval-and-compile + (defconst xpath-operator-names + '(("and" . AND) + ("or" . OR) + ("div" . DIV) + ("mod" . MOD))) + + (defconst xpath-other-operators + '(("/" . SLASH) + ;; ("//" . DSLASH) + ("|" . UNION) + ("-" . MINUS) + ("+" . PLUS) + ("=" . EQ) + ("!=" . NE) + (">=" . GE) + ("<=" . LE) + (">" . GT) + ("<" . LT))) + + (defvar xpath-other-tokens + '((":" . COLON) ; CAVEAT: to resolve QNames + ("*" . STAR) ; CAVEAT + ("]" . RBRACK) + (")" . RPAREN) + ("[" . LBRACK) + ("(" . LPAREN) + ("," . COMMA) + ("." . DOT) + ("@" . AT) + ;; ("|" . UNION) + ;; ("/" . SLASH) + ;; ("-" . MINUS) + ;; ("+" . PLUS) + ;; ("!=" . NE) + ;; (">=" . GE) + ;; ("<=" . LE) + ;; (">" . GT) + ;; ("<" . LT) + (".." . DOTDOT) + ("::" . AXISSUF))) + + (defconst xpath-node-types + '(("comment" . COMMENT) + ("text" . TEXT) + ("processing-instruction" . PROCESSING-INSTRUCTION) + ("node" . NODE))) + + (defconst xpath-axes + '(("ancestor" . ANCESTOR) + ("ancestor-or-self" . ANCESTOR-OR-SELF) + ("attribute" . ATTRIBUTE) + ("child" . CHILD) + ("descendant" . DESCENDANT) + ("descendant-or-self" . DESCENDANT-OR-SELF) + ("following" . FOLLOWING) + ("following-sibling" . FOLLOWING-SIBLING) + ("namespace" . NAMESPACE) + ("parent" . PARENT) + ("preceding" . PRECEDING) + ("preceding-sibling" . PRECEDING-SIBLING) + ("self" . SELF))) + ) ; End: `eval-and-compile' + +(defconst xpath-lexer-obarray + (let ((xpath-obarray (make-vector 13 0))) + ;; We need this only for non-letter tokens, because we return a + ;; letter-keyword (like an axis name) by interning the match-string. + (dolist (elt (append xpath-other-tokens xpath-other-operators)) + (set (intern (car elt) xpath-obarray) (cdr elt))) + xpath-obarray) + "Obarray to lookup some token classes.") + +(defsubst xpath-lookup-token (str) + "Return the tokenclass of token string STR." + (symbol-value (intern str xpath-lexer-obarray))) + +(eval-when-compile + (defconst xpath-ncname-rx + `(and (or letter ?_) (zero-or-more (or letter digit ?. ?- ?_))) + "Symbolic regexp matching NCnames.")) + +(defconst xpath-ncname-regexp + (eval-when-compile + (rx-to-string xpath-ncname-rx)) + "Regexp matching NCNames.") + +(defconst xpath-number-regexp + (rx (or (and (one-or-more digit) + (optional (and ?. (zero-or-more digit)))) + (and ?. (one-or-more digit)))) + "Regexp matching numbers.") + +(defconst xpath-variable-reference-regexp + (eval-when-compile + (rx-to-string `(and ?$ + (optional (and ,xpath-ncname-rx + ?:)) + ,xpath-ncname-rx))) + "Regexp matching VariableReferences.") + +(defsubst xpath-lex-advance-and-return (token &optional return step) + "Move forward and return the token as appropriate for parser. +This function assumes that the match-data are set appropriately. + +See `xpath-next-token' for a description of the format of the +return value. + +RETURN is the number of the submatch which determines parts of +the value returned. It defaults to 0. STEP is the submatch to +whose end point will move, it defaults to the value of RETURN." + (or return (setq return 0)) + (goto-char (match-end (or step return))) + (let ((str (match-string-no-properties return))) + (nconc + (list token + str) + (cons (match-beginning return) + (match-end return))))) + +(defsubst xpath-operator-allowed-p (preceding) + "Return non-nil, if an OPERATOR token is allowed at this point. +See XPath specification section 3.7, bullet point #1. +PRECEDING is a symbol, the last token previously returned by the +lexer." + (and preceding + (not (memq preceding + (eval-when-compile + (append '(AT DOTDOT LPAREN LBRACK COMMA) + (mapcar 'cdr + (append xpath-operator-names + xpath-other-operators + )))))))) + +(defsubst xpath-lex-resolve-ncname (str beg end preceding) + "Return the appropriate token value for NCName string STR. + +There are special lexical conventions for OperatorName, +FunctionName, NodeType and AxisName. This function resolves these +conventions. See XPath specification section 3.7, bullet points +2-4. + +BEG and END are the begin and end of STR in the buffer +respectively. PRECEDING is the last token class previously +returned by the lexer. + +See `xpath-next-token' for a description of the format of the +return value." + (let (token) + (cond + ;; OperatorName + ((and (member str (eval-when-compile + (mapcar 'car xpath-operator-names))) + (xpath-operator-allowed-p preceding)) + (setq token (intern (upcase str)))) + ;; FunctionName or NodeType + ((eq (char-after) ?\() + (setq token + (if (member str (eval-when-compile + (mapcar 'car xpath-node-types))) + 'NODETYPE + 'FUNCTIONNAME))) + ;; AxisName + ((looking-at "::") + (setq token (intern (upcase str)))) + ;; Other + (t (setq token 'NCNAME))) + (nconc (list token str) (cons beg end)))) + +(defun xpath-next-token (preceding) + "Return the next XPath token from the buffer. + +PRECEDING should be the last token-class returned by this +function on a previous call or nil. + +The return value is a list of the form +\(TOKEN-CLASS VALUE START . END) +as a Wisent parser automaton expects it from its lexing +function." + (skip-chars-forward "\x20\x9\xd\xa") ; ExprWhitespace + (cond + ;; End of input. + ((eobp) + (list wisent-eoi-term)) + + ;; '*', other tokens like '(', other operators like '/'. + ;; See XPath spec section 3.7: `ExprToken' and `Operator'. + ;; + ;; The question whether a '*' is a `MultiplyOperator' or part of a + ;; `NodeTest' is resolved by the Wisent parser automaton. + ((looking-at (eval-when-compile + (regexp-opt (mapcar 'car + (append xpath-other-operators + xpath-other-tokens))))) + (xpath-lex-advance-and-return (xpath-lookup-token (match-string 0)))) + + ;; NCName: AxisName, NodeType, FunctionName or NameTest. + ;; + ;; We deal with `NodeTest's in the parser automaton. Therefore we + ;; have a token class for NCNames: NCNAME. We return this class if + ;; the NCName at hand is neither AxisName nor NodeType nor + ;; FunctionName. + ((looking-at xpath-ncname-regexp) + (goto-char (match-end 0)) + (skip-chars-forward "\x20\x9\xd\xa") ; ExprWhitespace + (xpath-lex-resolve-ncname (match-string 0) + (match-beginning 0) + (match-end 0) + preceding)) + + ;; Literal + ((looking-at (rx (or (and ?\" (submatch (zero-or-more (not (any "\"")))) ?\") + (and ?\' (submatch (zero-or-more (not (any "\'")))) ?\')))) + (xpath-lex-advance-and-return 'LITERAL 1 0)) + + ;; Number + ((looking-at xpath-number-regexp) + (xpath-lex-advance-and-return 'NUMBER)) + + ;; VariableReference + ((looking-at xpath-variable-reference-regexp) + (xpath-lex-advance-and-return 'VARIABLEREFERENCE)) + + (t (error "Could not reckognize token: %s" + (buffer-substring (point) (point-max)))))) + + +(defun xpath-steps (str) + "Return the XPATH steps for string STR." + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (let (last-token) + (wisent-parse xpath-tables + (lambda () + (let ((token (xpath-next-token last-token))) + (setq last-token (car token)) + token)))))) + +;;; Test stuff + +;; (defvar egoge-test nil) +;; (defun egoge-test () +;; (interactive) +;; (let ((token (xpath-next-token egoge-test))) +;; (setq egoge-test (car token)) +;; (print token))) + +;; (xpath-test-lex-string "node1/node2") +;; (xpath-steps "child::node1/child::node2") +;; (xpath-test-lex-string "/node1") +;; (xpath-steps "/node1") +;; (xpath-steps "node1/node2") +;; (xpath-steps "child::para[position()=2]") + +(defmacro xpath-assert (expr) + `(unless ,expr + (error "Test failed: %S" ',expr))) + +(defun xpath-test-lex-string (str) + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (let (last-token list) + (while (not (eobp)) + (let ((token (xpath-next-token last-token))) + (setq last-token (car token)) + (push token list))) + (nreverse list)))) + + +(when nil + + (xpath-assert (equal (xpath-steps "child::para") + '((xpath-child-axis (xpath-name-filter "para"))))) + (xpath-assert (equal (xpath-steps "child::para/parent::*") + '((xpath-child-axis (xpath-name-filter "para")) + (xpath-parent-axis (xpath-name-filter "*"))))) + (xpath-assert (equal (xpath-steps "child::para/parent::text()") + '((xpath-child-axis (xpath-name-filter "para")) + (xpath-parent-axis (xpath-node-type-filter "text"))))) + (xpath-assert (equal (xpath-steps "child::*") + '((xpath-child-axis (xpath-name-filter "*"))))) + (xpath-assert (equal (xpath-steps "child::foo/child::bar/child::test") + '((xpath-child-axis (xpath-name-filter "foo")) + (xpath-child-axis (xpath-name-filter "bar")) + (xpath-child-axis (xpath-name-filter "test"))))) + (xpath-assert (equal (xpath-test-lex-string "child::*[position() = 1]") + '((CHILD "child" 1 . 6) + (AXISSUF "::" 6 . 8) + (STAR "*" 8 . 9) + (LBRACK "[" 9 . 10) + (FUNCTIONNAME "position" 10 . 18) + (LPAREN "(" 18 . 19) + (RPAREN ")" 19 . 20) + (EQ "=" 21 . 22) + (NUMBER "1" 23 . 24) + (RBRACK "]" 24 . 25)))) + (xpath-assert (equal (xpath-steps "child::*[position() = 1]") + '((xpath-child-axis (xpath-name-filter "*") + (xpath-equal (xpath-function/position) "1"))))) + (xpath-assert (equal (xpath-steps "child::*[position(1,2,3,4) = 1]") + '((xpath-child-axis (xpath-name-filter "*") + (xpath-equal (xpath-function/position + "1" "2" "3" "4") + "1"))))) + (xpath-assert (equal (xpath-steps "child::*[attribute::type=\"id\"]") + '((xpath-child-axis (xpath-name-filter "*") + (xpath-equal (xpath-resolve-steps + xpath-context-node + (quote ((xpath-attribute-axis + (xpath-name-filter "type"))))) + "id"))))) + ) + +(provide 'xpath-parser) + +;;; xpath-parser.el ends here diff --git a/auto-install/xpath.el b/auto-install/xpath.el new file mode 100644 index 0000000..1fe5048 --- /dev/null +++ b/auto-install/xpath.el @@ -0,0 +1,669 @@ +;;; xpath.el --- XPATH implementation + +;; Copyright (C) 2001 Alex Schroeder + +;; Author: Alex Schroeder +;; Maintainer: Oliver Scholz +;; Version: 1.0.0 +;; Keywords: xml +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?XmlParser +;; Version: $Id: xpath.el,v 1.1 2003/12/16 00:32:00 egoge Exp egoge $ + +;; This file is not part of GNU Emacs. + +;; This 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 2, or (at your option) any later +;; version. + +;; This 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; If you are working with XML documents, you may parse the documents +;; using the XML parser included with Emacs (xml.el), and pass the data +;; structure to the DOM implementation (dom.el). You can then use XPATH +;; to find DOM nodes. + +;;; Test: + +;; The test code assumes a file named sample.xml with the following +;; content: + +;; +;; +;; +;; My own book! +;; First +;; +;; +;; John +;; Wiegley +;; +;; +;; +;; +;; +;; A very small chapter +;; Wonder where the content is... +;; +;; + +;;; Code: + +(require 'cl) +(require 'dom) +(require 'xpath-parser) + +;; Axes + +(defun xpath-follow-axis (node axis) + "Return all the nodes on AXIS relative to node. +AXIS must be a string used in `xpath-axes'." + (let ((func (cadr (assoc axis xpath-axes)))) + (if func + (funcall func node) + (error "Unknown axis: " axis)))) + +(defun xpath-ancestor-axis (node) + "Return the elements on the ancestor axis. +The ancestor axis contains the ancestors of the context node. The +ancestors of the context node consist of the parent of context node and +the parent's parent and so on. Thus, the ancestor axis will always +include the root node, unless the context node is the root node. + +See `dom-node-parent-node'." + (let ((parent (dom-node-parent-node node)) + result) + (while parent + (setq result (cons parent result) + parent (dom-node-parent-node parent))) + (nreverse result))) + +(defun xpath-ancestor-or-self-axis (node) + "Return NODE and the elements of the ancestor axis. +The ancestor-or-self axis contains the context node and the ancestors of +the context node. Thus, the ancestor axis will always include the root +node. + +See `xpath-ancestor-axis'." + (cons node (xpath-ancestor-axis node))) + +(defun xpath-attribute-axis (node) + "Return the elements of the attribute axis. +The attribute axis contains the attributes of the context node. The +axis will be empty unless the context node is an element. + +See `dom-node-attributes'." + (dom-node-attributes node)) + +(defun xpath-child-axis (node) + "Return the elements of the child axis. +The child axis contains the children of the context node. + +See `dom-node-child-nodes'." + (dom-node-child-nodes node)) + +(defun xpath-descendant-axis (node) + "Return the elements of the descendant axis. +The descendant axis contains the descendants of the context node. A +descendant is a child or a child of a child and so on. Thus the +descendant axis never contains attribute or namespace nodes." + ;; We don't want to call this recursively because of performance. + (setq node (dom-node-first-child node)) + (let (stack result) + (while node + (setq result (cons node result) + node (cond ((dom-node-first-child node) + (when (dom-node-next-sibling node) + (push (dom-node-next-sibling node) stack)) + (dom-node-first-child node)) + ((dom-node-next-sibling node)) + (t (pop stack))))) + (nreverse result))) + +(defun xpath-descendant-or-self-axis (node) + "Return the elements of the descendant-or-self axis. +The descendant-or-self axis contains the context node and the +descendants of the context node. + +See `xpath-descendant-axis'." + (cons node (xpath-descendant-axis node))) + +(defun xpath-following-axis (node) + "Return the elements of the following axis. +The following axis contains all nodes in the same document as the +context node that are after the context node in document order, +excluding any descendants and excluding attribute nodes and namespace +nodes." + ;; We don't want to call this recursively because of performance. + (let ((ancestors (xpath-ancestor-or-self-axis node)) + stack result) + ;; The stack holds all the ancestors which have a next sibling. + ;; Note that this is very very inefficient if dom-node-next-sibling + ;; is very inefficient (as it currently is). + (dolist (ancestor ancestors) + (let ((next-sibling (dom-node-next-sibling ancestor))) + (when next-sibling + (setq stack (cons next-sibling stack))))) + (setq stack (nreverse stack) + node (pop stack)) + (while node + (setq result (cons node result) + node (cond ((dom-node-first-child node) + (when (dom-node-next-sibling node) + (push (dom-node-next-sibling node) stack)) + (dom-node-first-child node)) + ((dom-node-next-sibling node)) + (t (pop stack))))) + (nreverse result))) + +(defun xpath-following-sibling-axis (node) + "Return the elements of the following-sibling axis. +The following-sibling axis contains all the following siblings of the +context node. If the context node is an attribute node or namespace +node, the following-sibling axis is empty." + (let ((parent (dom-node-parent-node node))) + (when parent + (cdr (memq node (dom-node-child-nodes parent)))))) + +(defun xpath-parent-axis (node) + "Return the only element of the parent-axis. +The parent axis contains the parent of the context node, if there is +one. + +See `dom-node-parent'." + (list (dom-node-parent-node node))) + +(defun xpath-preceding-axis (node) + "Return the elements of the preceding axis. +The preceding axis contains all nodes in the same document as the +context node that are before the context node in document order, +excluding any ancestors and excluding attribute nodes and namespace +nodes." + ;; We don't want to call this recursively because of performance. + (let ((ancestors (xpath-ancestor-or-self-axis node)) + (context-node node) + stack result) + ;; We just add the elements in document order, skipping ancestors, + ;; until we reach the context node. + (setq node (dom-document-element (dom-node-owner-document context-node))) + (while node + (when (not (memq node ancestors)) + (setq result (cons node result))) + (setq node (cond ((dom-node-first-child node) + (when (dom-node-next-sibling node) + (push (dom-node-next-sibling node) stack)) + (dom-node-first-child node)) + ((dom-node-next-sibling node)) + (t (pop stack)))) + (when (eq node context-node) + (setq node nil))) + result)) + +(defun xpath-preceding-sibling-axis (node) + "Return the elements on the preceding-sibling axis. +The preceding-sibling axis contains all the preceding siblings of the +context node. If the context node is an attribute node or namespace +node, the preceding-sibling axis is empty." + (let ((parent (dom-node-parent-node node))) + (when parent + (let ((list (dom-node-child-nodes parent)) + result) + (while (and list (not (eq (car list) node))) + (setq result (cons (car list) result) + list (cdr list))) + result)))) + +;; FIXME: Namespaces not implemented. +;; The namespace axis contains the namespace nodes of the context node. +;; The axis will be empty unless the context node is an element. + +(defun xpath-self-axis (node) + "Return the element on the self axis. +The self axis contains just the context node itself." + (list node)) + +;; Node tests + +(defun xpath-name-filter (nodes name) + "Filter NODES by NAME. +If NAME is \"*\", return NODES." + (if (string= name "*") + nodes + (let (result) + (dolist (node nodes) + (when (string= name (dom-node-name node)) + (setq result (cons node result)))) + (nreverse result)))) + +(defun xpath-text-filter (nodes) + "Filter NODES, retaining only text nodes." + (let (result) + (dolist (node nodes) + (when (eq (dom-node-type node) dom-text-node) + (setq result (cons node result)))) + (nreverse result))) + +;; FIXME: xpath-comment-filter and xpath-processing-instruction-filter +;; are not implemented, yet. + +;;; Node Set Functions + +;; For each node in the node-set to be filtered, the PredicateExpr is +;; evaluated with that node as the context node, with the number of +;; nodes in the node-set as the context size, and with the proximity +;; position of the node in the node-set with respect to the axis as the +;; context position; if PredicateExpr evaluates to true for that node, +;; the node is included in the new node-set; otherwise, it is not +;; included. + +(defvar xpath-context-node) +(defvar xpath-context-size) +(defvar xpath-context-position) + +;; A PredicateExpr is evaluated by evaluating the Expr and converting +;; the result to a boolean. If the result is a number, the result will +;; be converted to true if the number is equal to the context position +;; and will be converted to false otherwise; if the result is not a +;; number, then the result will be converted as if by a call to the +;; boolean function. Thus a location path para[3] is equivalent to +;; para[position()=3]. + +;; FIXME: Function related stuff is not implemented. + +(defun xpath-function/last () + "Return a number equal to the context size from the expression +evaluation context." + xpath-context-size) + +(defun xpath-function/position () + "Return a number equal to the context position from the expression +evaluation context." + xpath-context-position) + +(defun xpath-function/count (node-set) + "Return the number of nodes in NODE-SET." + (length node-set)) + +(defun xpath-function/name (&optional node-set) + "Return the name of the first element in NODE-SET. +If optional argument NODE-SET is not given, return the name +of the context-node." + (if node-set + (dom-node-name (car node-set)) + (dom-node-name xpath-context-node))) + +;; Operations + +(defun xpath-number (&optional obj) + "Return the numeric value for OBJ." + (unless obj + (setq obj xpath-context-node)) + (cond ((and (listp obj) + (dom-element-p (car obj))) + (setq obj (xpath-string obj))) + ((dom-element-p obj); This is not in the spec! + (setq obj (xpath-string obj)))) + (cond ((numberp obj) + obj) + ((stringp obj) + (if (string-match "[^0-9.eE- \t\n\r\l]" obj) + 'NaN + (string-to-number obj))) + ((eq obj nil) + 0) + ((eq obj t) + 1) + (t (error "Cannot convert %S to a string" obj)))) + +(defun xpath-string (obj) + "Return the string-value for OBJ. +This is computed as follows: +No computation is necessary for strings. +Numbers are passed to `string-to-number'. +nil is \"false\". t is \"true\". +A DOM Element is passed to `dom-element-text-content'. +A DOM Node List gets the string value of its first element. +A DOM Attribute is passed to `dom-attr-value'." + (cond ((stringp obj) + obj) + ((numberp obj) + (string-to-number obj)) + ((eq obj nil) + "false") + ((eq obj t) + "true") + ((and (listp obj) + (dom-element-p (car obj))) + (dom-element-text-content (car obj))) + ((dom-element-p obj) + (dom-element-text-content (car obj))) + ((dom-attr-p obj) + (dom-attr-value obj)) + (t (error "Cannot convert %S to a string" obj)))) + +;; A little evaluator. +(defun xpath-eval (expression) + "Evaluate EXPRESSION." + (if (and (listp expression) + (functionp (car expression))) + (eval expression) + expression)) + +(defun xpath-equal (nodes a b) + "Filter nodes, retaining nodes where A and B are equal. +Equality is determined as follows: +If either A or B are booleans, compare booleans. +If either A or B are numbers, compare numbers. +Else, compare strings. See `xpath-string'." + ;; FIXME: Needs more work to be really compliant. + (let ((xpath-context-position 0) + (xpath-context-size (length nodes)) + result) + (dolist (node nodes) + (setq xpath-context-position (1+ xpath-context-position)) + (let* ((xpath-context-node node) + (a (xpath-eval a)) + (b (xpath-eval b))) + (when (cond ((listp a) + (let (result) + (while (and (not result) a) + (setq result (xpath-equal nodes (car a) b) + a (cdr a))) + result)) + ((listp b) + (let (result) + (while (and (not result) b) + (setq result (xpath-equal nodes a (car b)) + b (cdr b))) + result)) +;; ((or (boolean-p a) (boolean-p b)) +;; ;; The following trick treats any non-nil value as t. +;; (eq (not a) (not b))) + ((or (eq a t) (eq b t)) + ;; The following trick treats any non-nil value as t. + (eq (not a) (not b))) + ((or (numberp a) (numberp b)) + (= (xpath-number a) (xpath-number b))) + ((or (stringp a) (stringp b)) + (string= (xpath-string a) (xpath-string b))) + (t + (equal a b))) + (setq result (cons node result))))) + (nreverse result))) + +;; Resolving an XPath + +(defun xpath-resolve-axis (nodes func) + "Apply FUNC to every node in NODES and return the concatenation." + ;; Use append instead of nconc, because if this is the child axis, for + ;; example, then the list returned will be the original list of + ;; children. + (apply 'append (mapcar (lambda (node) (funcall func node)) + nodes))) + +(defun xpath-resolve (node xpath) + "Resolve XPATH relative to NODE. +XPATH is a string, NODE is the context node. +This returns a list of nodes." + (let ((steps (xpath-steps xpath))) + ;; If XPATH is an absolute location path, then the car of STEPS is + ;; the (uninterned) symbol in the variable + ;; `xpath-document-root-symbol'. In this case we must start from + ;; the root element. + (when (eq (car steps) xpath-document-root-symbol) + (setq node (dom-document-element + (dom-node-owner-document node)) + steps (cdr steps))) + (xpath-resolve-steps node steps))) + +(defun xpath-resolve-steps (node steps) + "Resolve STEPS relative to NODE. +STEPS is a parsed XPATH. +See `xpath-resolve' and `xpath-steps'." + (let ((nodes (list node))) + (dolist (step steps) + ;; For each node, get the nodes on the axis and concatenate the result. + (let ((func (car step))) + (setq nodes (xpath-resolve-axis nodes func))) + ;; Apply each of the predicates. + (let ((predicates (cdr step)) + predicate) + (while (and nodes predicates) + (setq predicate (car predicates) + predicates (cdr predicates)) + (let ((func (car predicate)) + (args (cdr predicate))) + (setq nodes (apply func nodes args)))))) + nodes)) + +;;; Test stuff + +(defmacro xpath-assert (expr) + `(unless ,expr + (error "Test failed: %S" ',expr))) + +(defun xpath-test-clean-xml (obj) + (cond ((null obj) nil) + ((atom obj) obj) + ((consp (car obj)) + (cons (xpath-test-clean-xml (car obj)) + (xpath-test-clean-xml (cdr obj)))) + (t (cond + ((stringp (car obj)) + (if (string-match "\\`[\n\t ]+\\'" (car obj)) + (xpath-test-clean-xml (cdr obj)) + (cons + (and + (string-match "\\`[\n\t ]*\\(.*\\)[\n\t ]*\\'" (car obj)) + (match-string 1 (car obj))) + (xpath-test-clean-xml (cdr obj))))) + (t (cons (car obj) (xpath-test-clean-xml (cdr obj)))))))) + +(when (and nil + (file-readable-p "sample.xml")) + + (require 'xml) + (defvar xpath-test-data + (xpath-test-clean-xml + (car (xml-parse-file "sample.xml")))) + + (defvar xpath-test-document + (dom-make-document-from-xml xpath-test-data)) + + ;; (defvar xpath-test-node + ;; (car (dom-document-get-elements-by-tag-name + ;; xpath-test-document + ;; 'title))) + + ;; (xpath-resolve xpath-test-node "descendant::title") + ;; (xpath-resolve xpath-test-node "child::bookbiblio/child::title") + ;; (xpath-resolve xpath-test-node "/child::chapter/child::title") + + ;; (setq data (car (xml-parse-file "sample.xml"))) + (let ((title (car (dom-document-get-elements-by-tag-name + xpath-test-document + 'title)))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-ancestor-axis title)) + '(bookbiblio bookinfo book))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-ancestor-or-self-axis title)) + '(title bookbiblio bookinfo book))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-attribute-axis (dom-document-element + xpath-test-document))) + '(id))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-child-axis (dom-document-element + xpath-test-document))) + '(bookinfo chapter))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-descendant-axis + (dom-element-last-child + (dom-document-element + xpath-test-document)))) + '(title \#text para \#text))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-descendant-or-self-axis + (dom-element-last-child + (dom-document-element + xpath-test-document)))) + '(chapter title \#text para \#text))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-descendant-axis + (dom-document-element xpath-test-document))) + '(bookinfo bookbiblio title \#text edition \#text + authorgroup author firstname \#text surname + \#text chapter title \#text para \#text))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-following-axis + (dom-element-first-child + (dom-document-element + xpath-test-document)))) + '(chapter title \#text para \#text))) + (xpath-assert (equal (mapcar 'dom-node-name (xpath-following-axis title)) + '(edition \#text authorgroup author firstname + \#text surname \#text chapter title + \#text para \#text))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-following-sibling-axis title)) + '(edition authorgroup))) + (xpath-assert (equal (mapcar 'dom-node-name (xpath-parent-axis title)) + '(bookbiblio))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-preceding-axis + (dom-node-last-child + (dom-document-element + xpath-test-document)))) + '(\#text surname \#text firstname author + authorgroup \#text edition \#text title + bookbiblio bookinfo))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-preceding-sibling-axis + (dom-node-last-child + (dom-document-element + xpath-test-document)))) + '(bookinfo))) + (xpath-assert (equal + (mapcar 'dom-node-name + (xpath-preceding-sibling-axis + (dom-node-last-child ; authorgroup + (dom-node-first-child ; bookbiblio + (dom-node-first-child ; bookinfo + (dom-document-element xpath-test-document)))))) ; book + '(edition title))) + (xpath-assert (equal (xpath-self-axis title) (list title)))) + + (let ((node-list (dom-document-get-elements-by-tag-name + xpath-test-document '*))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-name-filter node-list 'title)) + '(title title))) + (xpath-assert (equal (mapcar 'dom-node-value + (xpath-text-filter node-list)) + '("My own book!" "First" "John" "Wiegley" + "A very small chapter" + "Wonder where the content is...")))) + + (let ((root (dom-document-element xpath-test-document))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-resolve-axis (list root) + 'xpath-child-axis)) + '(bookinfo chapter))) + (xpath-assert (equal (mapcar 'dom-node-name + (xpath-resolve-axis + (dom-node-child-nodes root) + 'xpath-child-axis)) + '(bookbiblio title para))) + (xpath-assert (equal (mapcar 'dom-node-text-content + (xpath-resolve root "descendant::title")) + '("My own book!" + "A very small chapter"))) + (xpath-assert (equal + (mapcar 'dom-node-text-content + (xpath-resolve root + "descendant::chapter/child::title")) + '("A very small chapter")))) + + (xpath-assert (xpath-equal '(yes) t 5)) + (xpath-assert (not (xpath-equal '(yes) nil 5))) + (xpath-assert (xpath-equal '(yes) 5.0 5)) + (xpath-assert (not (xpath-equal '(yes) 4 5))) + (xpath-assert (xpath-equal '(yes) "5.0" 5)) + (xpath-assert (xpath-equal '(yes) '(+ 3 2) 5)) + ;; What is `xpath-resolve-args'?? + ;; Is here some problem lurking? + ;; (xpath-assert (equal (xpath-resolve-args '(1 (= 1 1) 3)) + ;; '(1 t 3))) + ;; (xpath-assert (equal (xpath-resolve-args '(4 (+ 3 2) 6)) + ;; '(4 5 6))) + (xpath-assert (xpath-equal '(yes) '(1 2 3) 3)) + (xpath-assert (not (xpath-equal '(yes) '(1 2 3) 4))) + (xpath-assert (xpath-equal '(yes) 3 '(1 2 3))) + (xpath-assert (not (xpath-equal '(yes) 4 '(1 2 3)))) + (xpath-assert (xpath-equal '(yes) '(1 2 3) '(3 4 5))) + (xpath-assert (not (xpath-equal '(yes) '(1 2 3) '(4 5 6)))) + + (let ((root (dom-document-element xpath-test-document))) + (xpath-assert (equal + (mapcar 'dom-node-name + (xpath-resolve root "child::*[position()=1]")) + '(bookinfo))) + (xpath-assert (equal + (mapcar 'dom-node-name + (xpath-resolve root "child::*[position()=2]")) + '(chapter))) + (xpath-assert (null + (xpath-resolve root + "child::*[attribute::id=\"compiler\"]")))) + + (let ((root (dom-document-element xpath-test-document))) + (xpath-assert + (equal + (mapcar + 'dom-node-name + (xpath-resolve root "self::*[attribute::id=\"compiler\"]")) + '(book)))) + + ;; Absolute Paths. + (let ((node (car (dom-document-get-elements-by-tag-name + xpath-test-document 'edition)))) + (xpath-assert (equal + (mapcar 'dom-node-name + (xpath-resolve node "/descendant::title")) + '(title title)))) + + ;; Abbreviated syntax. + (let ((root (dom-document-element xpath-test-document))) + (xpath-assert + (equal + (mapcar + 'dom-node-text-content + (xpath-resolve root "descendant::authorgroup/author/firstname")) + '("John")))) + + ;; (let ((root (dom-document-element xpath-test-document))) + ;; (xpath-resolve root "descendant::authorgroup/author/firstname[position()]")) + + + (let ((node (car (dom-document-get-elements-by-tag-name + xpath-test-document 'edition)))) + (xpath-assert (equal (mapcar 'dom-node-text-content + (xpath-resolve node "/chapter/title")) + '("A very small chapter")))) + + ) + +(provide 'xpath) + +;;; xpath.el ends here. diff --git a/mmm-mode-0.4.8/AUTHORS b/mmm-mode-0.4.8/AUTHORS new file mode 100644 index 0000000..332e958 --- /dev/null +++ b/mmm-mode-0.4.8/AUTHORS @@ -0,0 +1,16 @@ +MMM Mode was originally designed and written by Michael Shulman +. + +It was inspired by mmm.el for XEmacs by Gongquan Chen . + +Recent contributors have included: + +bishop +Joe Kelsey +Alan Shutko +Michael Alan Dorman +Brian P Templeton +Yann Dirson +Marcus Harnisch + +and others... diff --git a/mmm-mode-0.4.8/COPYING b/mmm-mode-0.4.8/COPYING new file mode 100644 index 0000000..d60c31a --- /dev/null +++ b/mmm-mode-0.4.8/COPYING @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program 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 2 of the License, or + (at your option) any later version. + + This program 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 this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/mmm-mode-0.4.8/ChangeLog b/mmm-mode-0.4.8/ChangeLog new file mode 100644 index 0000000..d2478a6 --- /dev/null +++ b/mmm-mode-0.4.8/ChangeLog @@ -0,0 +1,1059 @@ +2004-06-16 Alan Shutko + + * version.texi: Release 0.4.8. + + * mmm-vars.el: Release 0.4.8. + + * mmm-mode.el: Release 0.4.8. + + * mmm-noweb.el (mmm-syntax-region-list) + (mmm-syntax-other-regions, mmm-word-other-regions) + (mmm-space-other-regions, mmm-undo-syntax-other-regions): Added + from Joe's email. They're here right now, until a better place + can be found. + + * configure.in: Incr version for release. + +2004-06-10 Alan Shutko + + * mmm-class.el (mmm-ify): Change defaults for front-delim and + back-delim to nil. 0 was breaking the no-delimiter case in + mmm-match-region. + +2004-06-02 Alan Shutko + + * mmm-sample.el (html-js): Support JS version in language attribute. + +2004-06-01 Alan Shutko + + * mmm-vars.el (mmm-save-local-variables): Updated cc-mode local + variables. + + * Makefile.am (lisp_LISP): Removed mmm-php.el, since it doesn't + appear to be in CVS. + + * missing: Updated for automake 1.7.9. + +2003-10-18 Alan Shutko + + * mmm-vars.el (mmm-save-local-variables): Add semantic stuff and + c-syntactic-eol. + +2003-03-25 Michael A. Shulman + + * mmm-mode.spec: Added file for building SRPMs, from bishop + + * autogen.sh: Added file for building from CVS + +2003-03-22 Michael A. Shulman + + * mmm-sample.el (html-php): Added new submode class. + (eperl): Corrected, added comment detection. + + * mmm-cmds.el (mmm-insert-by-key): Added undo collapsing. + +2003-03-09 Michael A. Shulman + + * mmm-vars.el (mmm-set-mode-line): Added support for "buffer mode" + display name. + + * mmm-cmds.el (mmm-insert-by-key): Match and calculate names, and + store front and back positions for delimiter overlays. + + * mmm-mason.el: Added match-name parameter. + + * mmm-sample.el: Added delimiter-mode and match-name parameters. + + * mmm-region.el: Restructured current-overlay functions. + (mmm-make-region, mmm-make-overlay, mmm-get-face): Create + delimiter overlays with modes and faces, add display-name and name + parameters, and handle evaporation intelligently. + (mmm-front-start, mmm-back-end, etc.): Use delimiter overlays. + (mmm-update-current-submode): Delete overlays whose front + delimiter has evaporated. + + * mmm-class.el (mmm-ify, mmm-match-region): Added matching for + region names. + + * mmm-vars.el (mmm-delimiter-mode, mmm-delimiter-face): Added. + +2003-03-08 Michael A. Shulman + + * mmm-region.el (mmm-clear-overlays): Fixed bug so turning mmm + mode off now restores primary mode correctly. + +2003-03-03 Michael A. Shulman + + * mmm-noweb.el (mmm-noweb-bind-keys): Implemented a "local to + submode class" keymap binding. + + * mmm-vars.el (mmm-set-mode-line): Used correct name for variable. + +2003-03-02 Michael A. Shulman + + * mmm-mode.el (mmm-mode): Removed ancient docstring, which had + references to long-deprecated and removed functions. The info + file is now the official user reference. + + * mmm-region.el (mmm-update-submode-region): Run hooks specified + by the region being entered, or the dominant if not. + + * mmm-vars.el (mmm-primary-mode-entry-hook): Added variable. + + * mmm-vars.el (mmm-subregion-invalid-placement): Renamed from + mmm-subregion-crosses-parents. + (mmm-primary-mode-display-name): Added variable. + (mmm-set-mode-line): Added function to allow display of specified + names outside regions. + + * mmm-region.el (mmm-valid-submode-region): Corrected algorithm, + improved documentation, renamed error. + +2003-02-05 Joe Kelsey + + * mmm-vars.el (mmm-add-to-group): New function mmm-add-to-group + adds new private classes to an existing group. + + * mmm.texinfo (Noweb): Add documentation about noweb mode. + + * mmm-auto.el (mmm-autoloaded-classes): Add noweb to + autoloaded classes. + + * mmm-noweb.el: Modified chunk naming to give noweb-chunks + different names so that they will be indented independently. + + * mmm-sample.el: Make html-js look for language= or type= + attributes because you may have other script types. + +2003-01-30 Joe Kelsey + + * Makefile.am: Add mmm-cweb.el, mmm-php.el and mmm-noweb.el + + * mmm-noweb.el: Add support for noweb. + + * mmm-class.el (mmm-ify, mmm-make-region): Add support for setting + the NAME property on regions. + + * mmm-cmds.el (mmm-insert-by-key): Add support for setting the + NAME property on inserts. + +2002-11-11 Alan Shutko + + * .cvsignore: Add semantic.cache. + + * mmm-vars.el (mmm-save-local-variables): Update C variables to + save, based on Emacs CVS. + + * mmm-cweb.el (cweb): Tweaked indentation. Add cweb to the + +2001-05-16 Michael Abraham Shulman + + * mmm-mode.el (mmm-mode-on): Make style variables buffer-local. + Continue on all MMM errors. + + * mmm-vars.el (mmm-save-local-variables): Added all c-modes + indentation style variables. + + * mmm-auto.el, mmm-sample.el: + Added `sgml-dtd' submode class from Yann Dirson . + +2001-05-15 Michael Abraham Shulman + + * mmm-auto.el: Added cweb to autoloaded classes. + +2001-05-14 Michael Abraham Shulman + + * mmm-region.el: Passed arguments to `signal'. + + * mmm-vars.el: Defined new submode placement error conditions. + +2001-05-14 Alan Shutko + + * mmm-cweb.el: New file. + + * mmm-region.el (mmm-valid-submode-region): New function. + (mmm-make-region): Allow nested submodes and put the priority in + the overlay. + +2001-02-23 Michael Abraham Shulman + + * configure.in, mmm-mode.el, mmm-vars.el, version.texi: Released 0.4.7 + +2001-02-18 Alan Shutko + + * mmm-vars.el (mmm-classes-alist): Document new keywords. + + * mmm.texinfo (Region Placement): Document the front-match, + back-match and end-not-begin keywords. + + * mmm-class.el (mmm-match-region, mmm-ify): Add front-match & + back-match keywords to specify which submatch to treat as the + delimiter. Add end-not-begin key. + (mmm-match->point): Add front-match and back-match args. + +2001-02-12 Alan Shutko + + * mmm-mason.el (mmm-mason-end-line,mmm-mason-start-line): Use bolp + and eolp. + +2001-02-03 Michael Abraham Shulman + + * mmm-mode.el, mmm-region.el, mmm-vars.el: + Added `mmm-primary-mode' variable so that `major-mode' can be saved. + +2001-01-27 Alan Shutko + + * mmm.texinfo: Added direntry for automated info installation. + +2001-01-26 Alan Shutko + + * configure.in: Use elisp macros from w3 to check for emacs and + lisp dir. + + * aclocal.m4: Pulled elisp-related checks from the W3 library, so + --with-emacs= will work. + +2001-01-15 Michael Abraham Shulman + + * mmm-cmds.el (mmm-insert-by-key): + Use match-face and major-mode-preferences. + + * mmm-sample.el (mmm-here-doc-get-mode): + Try each word individually first. + + * mmm-utils.el (mmm-format-matches): + Removed reference to `count' variable. + + * mmm-sample.el, mmm-univ.el, mmm-utils.el: + Allowed language names for preference lookup as "mode names". + + * mmm-vars.el (mmm-set-major-mode-preferences): Added function. + +2001-01-14 Michael Abraham Shulman + + * mmm-class.el, mmm-utils.el (mmm-format-matches): + Changed to allow accessing any subexp, not + limited by a numerical value of save-matches. + +2001-01-13 Michael Abraham Shulman + + * mmm-sample.el, mmm-vars.el: Modified CSS to use preferred mode. + + * mmm-vars.el (mmm-save-local-variables): + Added syntax and indentation variables for + cc-mode and variants. + + * mmm-vars.el (mmm-major-mode-preferences): + Added check for `jde-mode' for Java code. + +2001-01-12 Michael Abraham Shulman + + * mmm-auto.el: Added ePerl and JSP to autoload. + +2001-01-11 Michael Abraham Shulman + + * mmm-sample.el: Added ePerl submode class. + + * mmm-mason.el, mmm-sample.el: + Modified classes to use preferred mode list. + + * mmm-vars.el, mmm-region.el: + Added alist to keep track of user-preferred major modes. + + * mmm-mason.el, mmm-rpm.el, mmm-sample.el: + Added flags telling which faces to use for which regions. + + * mmm-class.el, mmm-region.el, mmm-vars.el: + Added multiple faces and optional levels of decoration. + +2001-01-09 Michael Abraham Shulman + + * mmm-vars.el (mmm-save-local-variables): + Added `parse-sexp-ignore-comments', which + seems to fix indentation in php-mode. + +2001-01-08 Michael Abraham Shulman + + * mmm-region.el (mmm-update-mode-info): + Hacked so `font-lock-keywords-alist' works. + +2001-01-05 Michael Abraham Shulman + + * mmm.texinfo: Added set-background example for XEmacs. + Added info-dir-entry. + +2000-09-29 Michael Abraham Shulman + + * mmm-class.el (mmm-apply-class): + Rearranged parameters so faces actually work. + +2000-09-18 Michael Abraham Shulman + + * configure.in, mmm-vars.el, version.texi: Released 0.4.6 + +2000-09-17 Michael Abraham Shulman + + * FAQ: Added Q about name capitalization. + +2000-09-16 Michael Abraham Shulman + + * mmm-compat.el (mmm-keywords-used): Added `:private'. + +2000-09-12 Michael Abraham Shulman + + * FAQ: Added file + +2000-09-12 Michael Abraham Shulman + + * Checklist: Added comment about adding files to the distribution. + + * README: Added comment about installing with multiple emacsen. + + * Makefile.am: Added FAQ + + * mmm-mode.el: Created Emacs Lisp Archive Entry + +2000-09-05 Michael Abraham Shulman + + * mmm.texinfo: Set MASON_VERSION. + + * mmm-cmds.el (mmm-display-insertion-key): + Prevented (nthcdr -1 ...); breaks in XEmacs. + +2000-08-29 Michael Abraham Shulman + + * mmm-vars.el (mmm-save-local-variables): Added abbrev-mode variables. + + * mmm-region.el (mmm-update-mode-info): + Tested against `mmm-set-file-name-for-modes'. + + * mmm-vars.el (mmm-set-file-name-for-modes): + Changed to a list for finer control. + +2000-08-24 Michael Abraham Shulman + + * mmm-region.el (mmm-make-region): + Explicitly set keyword defaults in &rest parameter. + + * mmm-class.el (mmm-ify): + Explicitly set defaults for keywords in &rest parameter. + +2000-08-23 Michael Abraham Shulman + + * mmm-region.el, mmm-vars.el (mmm-set-buffer-file-name-p): + Added to control file name setting. + + * mmm-vars.el (mmm-save-local-variables): + Added `mode-popup-menu' for XEmacs. + + * mmm-region.el (mmm-update-mode-info): + Added some tests for XEmacs 20 to prevent + errors and unwanted prompts. + Cleared modified flag before killing leftover temporary buffers. + +2000-08-21 Michael Abraham Shulman + + * mmm.texinfo: + Added comments on RPM Spec, File Variables, and Here-documents. + + * mmm-auto.el: Autoloaded `rpm'. + + * mmm-auto.el: Autoloaded `rpm-sh' submode class from mmm-rpm.el. + + * mmm-rpm.el: Added file (contributed by Marcus Harnisch). + +2000-08-17 Michael Abraham Shulman + + * mmm-vars.el (mmm-never-modes): Added `forms-mode'. + +2000-08-02 Michael Abraham Shulman + + * configure.in, mmm-vars.el, version.texi: Released 0.4.5. + + * mmm-compat.el (mmm-set-font-lock-defaults): Made into a macro. + + * mmm-auto.el: Autoloaded `mmm-ensure-fboundp'. + + * mmm-region.el (mmm-update-mode-info): + Used compatibility wrapper for font-lock defaults. + + * mmm-compat.el (mmm-set-font-lock-defaults): + Added compatibility wrapper function. + +2000-08-01 Michael Abraham Shulman + + * README.Mason, mmm.texinfo: + Added comments about `sgml-parent-document'. + + * mmm-utils.el (mmm-ensure-fboundp): Created function. + + * mmm-sample.el (mmm-here-doc-get-mode): + Extended to recognize names like TEXT_EOF. + +2000-07-29 Michael Abraham Shulman + + * configure.in, mmm-vars.el, version.texi: Released 0.4.4. + + * mmm-class.el (mmm-get-class-spec): + Implemented autoloaded submode classes. + + * mmm-vars.el (mmm-add-group): Made subclasses of a group private. + + * mmm-auto.el: Added autoloading of submode classes. + + * mmm-cmds.el (mmm-ify-by-class): + Added completion on autoloaded classes. Excluded + private classes from completion. + + * mmm-vars.el (mmm-classes-alist): + Updated docstring for new offset values and + include- flags. + + * mmm-sample.el (here-doc): Updated to use new front-offset values. + + * mmm-class.el (mmm-ify, mmm-match-region, mmm-match->point): + Added new values for front- and back-offset. + + * mmm-region.el (mmm-make-region): + Made sure overlays get the delimiter and sticky + properties even if they aren't passed explicitly. + +2000-07-26 Michael Abraham Shulman + + * configure.in: Changed output name from `mmm' to `mmm-mode'. + +2000-07-24 Michael Abraham Shulman + + * mmm-sample.el: Updated file-variables class to handle prefixes. + +2000-07-23 Michael Abraham Shulman + + * mmm-sample.el: Wrote File Variables submode class for the new syntax. + +2000-07-21 Michael Abraham Shulman + + * mmm-cmds.el (mmm-ify-by-class): + Added completion on all defined classes. + + * mmm-sample.el (mmm-here-doc-get-mode): + Signaled non-fboundp here-document names. + + * mmm-univ.el (mmm-univ-get-mode): Signaled error on non-fboundp modes. + + * mmm-class.el (mmm-match-region, mmm-ify): + Caught errors from :match-submode. + + * mmm-vars.el: Added `mmm-no-matching-submode' error signal. + + * mmm-sample.el: + Allowed here-documents in any mode with :match-submode. + Added insertion syntax to here-docs, javascript, and embperl. + +2000-07-14 Michael Abraham Shulman + + * mmm.texinfo, version.texi: + Added MASON_VERSION variable to keep track of that. + + * mmm.texinfo: Wrote about changing key bindings and local variables. + Copied info from documentation of `mmm-classes-alist'. + +2000-07-13 Michael Abraham Shulman + + * mmm-vars.el (mmm-run-major-mode-hook): + Added `ignore-errors' around each call. + + * mmm-vars.el (mmm-save-local-variables): + Changed `defcustom' to `defvar'. + + * mmm.texinfo: + Wrote about global classes, highlight, mode line, and hooks. + + * mmm-univ.el: Limited matches to letter/dash strings that are fboundp. + +2000-07-12 Michael Abraham Shulman + + * README.Mason: Added comment about `mmm-global-mode'. + +2000-07-12 Michael Abraham Shulman + + * configure.in, mmm-vars.el: Released 0.4.3. + + * mmm-univ.el: Changed %[...]% to [%...%] which looks much nicer. + + * mmm.texinfo: Wrote more about Mason. + + * mmm-mason.el: Moved commentary code to README.Mason. + + * Makefile.am: Added README.Mason to EXTRA_DIST. + + * README.Mason: Created file. + +2000-07-11 Michael Abraham Shulman + + * mmm-region.el (mmm-update-mode-info): + Used `mmm-make-temp-buffer'. Put font-lock + property directly rather than setting the variable first. + + * mmm-mode.el (mmm-mode-off): Reset font-lock variables. + + * mmm-compat.el (mmm-make-temp-buffer): + Added as workaround for make-indirect-buffer. + + * mmm-region.el: + (mmm-enable-font-lock, mmm-update-font-lock-buffer, mmm-update-mode-info): + Conditioned font-lock usage on mmm-font-lock-available-p. + + * mmm-compat.el (mmm-font-lock-available-p): Added flag. + + * mmm-region.el (mmm-update-mode-info): + Killed any lingering temporary buffers. + + * mmm-cmds.el (mmm-insert-by-key): + Made inserted regions beg- and end-sticky. + + * mmm-compat.el (mmm-keywords-used): Added :classes. + +2000-06-30 Michael Abraham Shulman + + * configure.in, mmm-vars.el: Released 0.4.2a. + + * mmm-region.el: Reordered Inspection and Creation for byte compiler. + + * mmm-mode.el: Moved mmm-mode variable to mmm-vars.el. + + * mmm-auto.el: Added some autoloads. + + * Makefile.am: Added mmm-univ.el. + + * configure.in, mmm-vars.el: Released 0.4.2. + + * mmm-auto.el (mmm-mode-on-maybe): + Conditioned font-lock updating on mmm-mode. + + * mmm-region.el: + Removed use-local-map advice; no longer necessary (thank goodness!) + + * mmm-region.el, mmm-auto.el: Fixed font-lock woes (hopefully). + + * mmm-class.el: Allowed dynamically specified submodes. + + * mmm-utils.el, mmm-mode.el, mmm-cmds.el: + Fixed font-lock woes (hopefully). + + * mmm.texinfo: Added Embperl. + + * mmm-vars.el (mmm-global-classes): + Added variable controlling global classes. + + * mmm-univ.el: Created file defining `universal' submode. + + * mmm-sample.el: Added Embperl. + + * mmm-utils.el: Added def-edebug-specs. + +2000-06-29 Michael Abraham Shulman + + * mmm-region.el (mmm-fontify-region-list): + Saved local variables before moving. + + * mmm-auto.el (mmm-check-changed-buffers): Checked for live buffer. + + * mmm-utils.el (mmm-valid-buffer): + Checked against noninteractive and hidden buffers. + + * mmm-auto.el (mmm-check-changed-buffers): + Added check against minibuffers. + + * mmm-vars.el (mmm-never-modes): Added `eshell-mode'. + +2000-06-28 Michael Abraham Shulman + + * NEWS, configure.in, mmm-vars.el: Released 0.4.1. + + * mmm-region.el (mmm-overlays-in): Added DELIM parameter. + (mmm-submode-changes-in): Added strict flags calling overlays-in. + +2000-06-27 Michael Abraham Shulman + + * configure.in, mmm-vars.el: Released 0.4.0. + + * NEWS, TODO, mmm-auto.el, mmm-region.el, mmm-vars.el, mmm.texinfo: + Changed mmm-global-mode to use post-command-hook method rather than + stack-walk method. + + * mmm-region.el: + Fixed bug saving variables when creating regions; need to set them first. + + * mmm-region.el: Added creation-hook, fixed mode-name problem. + + * mmm-class.el: Added mmm-[get,set]-class-parameters and creation-hook. + + * mmm-auto.el, mmm-region.el, mmm-vars.el: + Fixed bug where font-lock-mode was set to `t' globally, causing + global-font-lock-mode to turn it off. + +2000-06-26 Michael Abraham Shulman + + * mmm-region.el: + Rewrote local variable functions, added new ones, changed updating, + fontification, and region creation functions to handle this. + + * mmm-mode.el: + Added setting and clearing local variables with mode on and off. + + * mmm-vars.el (mmm-save-local-variables): + Added extra parameters for saving type and modes, and updated documentation. + Created several variables to save buffer- and region- locals. + (mmm-temp-buffer-name): Created variable and changed references. + +2000-06-23 Michael Abraham Shulman + + * mmm-vars.el (mmm-save-local-variable): + Added comment-line-start-skip for Fortran. + +2000-06-13 Michael Abraham Shulman + + * mmm.texinfo: Added comment about (require 'mmm-mason). + +2000-06-08 Michael Abraham Shulman + + * configure.in, mmm-vars.el: Released 0.3.10 + + * mmm-region.el (mmm-overlays-in): + Added checks for point-min and point-max for XEmacs. + (use-local-map): Added the advice back in. + + * configure.in, mmm-vars.el: Released 0.3.9. + + * mmm-region.el (use-local-map): + Conditioned advice definition on not XEmacs. + +2000-05-28 Michael Abraham Shulman + + * .cvsignore: + Added info file and auxiliary compilation and texinfo files. + + * .cvsignore: Added configure auxiliary files. + + * .cvsignore: Ignored Makefile.in, Makefile, and configure. + + * COPYING, INSTALL, install-sh, mdate-sh, missing, mkinstalldirs, texinfo.tex: + Added files required by automake. + + * mmm.texinfo, elisp-comp, TODO, README, NEWS, ChangeLog, AUTHORS: + Added to CVS (formerly not under RCS). + +2000-05-24 Michael Abraham Shulman + + * mmm-auto.el: Pre-added major mode hook to text-mode-hook. + +2000-05-19 Michael Abraham Shulman + + * mmm-vars.el (mmm-version): changed to 0.3.8. + +2000-05-18 Michael Abraham Shulman + + * mmm-region.el: + Moved `require's back to top level for byte-compiling. Added dummy + definition of `mmm-real-use-local-map' to shut up byte compiler. + + * mmm-mode.el, mmm-cmds.el, mmm-class.el: + Moved `require's back to top level for byte-compiling. + + * mmm-auto.el: `require'd mmm-vars at top level for byte-compiling. + + * Makefile.am: + Added all the elisp files to EXTRA_DIST, since Automake doesn't see + them as sources for the distribution. + +2000-05-10 Michael Abraham Shulman + + * mmm-mason.el: Fixed bug: # is not allowed in symbols. + + * mmm-mason.el: + Changed insertion key of <%doc> to `d' and added insertion of %# + comment lines with insertion keys `#' and `3'. + + * mmm-mason.el: + Distinguished between Perl sections and pseudo-Perl sections. The one + inserts ; at the beginning for indentation hack, the other doesn't + because the Mason syntax doesn't allow it and indentation is generally + unnecessary anyway. + + * mmm-cmds.el: + Fixed "sub"-insertion specs like <%perl> under <%TAG> not to insert + the interactor string. + +2000-05-03 Michael Abraham Shulman + + * mmm-mason.el: Added dependencies on mmm-compat and mmm-vars. + +2000-04-30 Michael Abraham Shulman + + * configure.in, Makefile.am: New file. + + * mmm-sample.el, mmm-mode.el, mmm-region.el, mmm-auto.el, mmm-class.el, mmm-cmds.el, mmm-mason.el: + Changed (progn (require ...)) to (when t (require ...)) because the + first is still "top level" for the byte compiler. + + * mmm-region.el: + Required font-lock and mmm-auto at top level for byte compilation. + Moved local maps to come before updating hooks for byte compilation. + + * mmm-utils.el: Loaded CL at top level for byte-compile. + +2000-04-29 Michael Abraham Shulman + + * mmm-mode.el, mmm-region.el, mmm-sample.el, mmm-auto.el, mmm-class.el, mmm-cmds.el, mmm-mason.el: + Put all `require's not needed at compile-time into `progn's so the + byte-compiler doesn't load them (not at top level). Only `mmm-compat' + and `mmm-utils' need to be loaded at compile-time, since they define + macros. + +2000-04-27 Michael Abraham Shulman + + * All: Started using RCS. + +2000-04-27 Michael Abraham Shulman + + * mmm-sample.el (mmm-javascript-mode): Created customization + variable to select mode to use for javascript regions. + +2000-03-26 Michael Abraham Shulman + + * mmm-cmds.el (mmm-get-insertion-spec): Insertion keys now have + symbolic names, although they have no definition. + (mmm-insertion-help): Command added to give help on insertion + keys, the way C-h does for command keys. + + * mmm-vars.el (mmm-get-all-classes): Reversed order, so + interactive classes take precedence (for insertion, mainly) over + `mmm-classes' which overrides mode/ext classes. + +2000-03-24 Michael Abraham Shulman + + * mmm-vars.el (mmm-command-modifiers, mmm-insert-modifiers): + Switched defaults to be the way I think it should be. Users can + switch back with `mmm-use-old-command-keys'. + + * README: Created file giving information on inital installation. + + * Makefile: Created makefile to compile elisp files and make info + file from texinfo file. + + * mmm-region.el: Gave up on conditional stickiness, since it + doesn't work in XEmacs and even FSF Emacs has been being flaky + with overlay after-change functions. Detecting ends in global + `after-change-functions' will work better anyway. + + * mmm-cmds.el: Renamed from `mmm-inter.el'. + (mmm-end-current-region): Added command, with key binding. + + * mmm-vars.el (mmm-classes-alist): Documentation updated for + unified submode classes. + + * mmm-class.el (mmm-ify): BEG and END arguments removed; just use + FRONT and BACK. + + * mmm-utils.el (mmm-format-matches): Ignores non-string arguments. + + * mmm-class.el (mmm-apply-class): Faces supplied for grouping + classes now override those on included classes. Parents will do + the same thing. + + * mmm-inter.el: Bound `mmm-parse-block' to C-c % 5 as well. + (mmm-reparse-current-region): Added command, with key binding. + + * mmm-insert.el: Deleted file, merging contents (insert by + keystrokes) into `mmm-inter.el'. Auto-detection insert will + probably go elsewhere. + + * mmm-inter.el (mmm-clear-current-region): Uses `mmm-overlay-at' + with `all' inclusion type. + + * mmm-region.el (mmm-overlays-at): Added `all' inclusion type. + + * mmm-class.el (mmm-apply-class, etc.): Submode classes have been + unified--no more 'regexp, 'region, 'group, etc. + +2000-03-23 Michael Abraham Shulman + + * mmm-inter.el (mmm-parse-buffer, mmm-parse-region, mmm-parse-block): + Added "Operating...done" messages. + + * mmm-region.el (mmm-make-region): Allowed caller to add extra + keyword arguments to be stored as overlay properties, anticipating + new future submode classes. + + * mmm-update.el (use-local-map): Advised to keep track of changed + local maps. + + * mmm-region.el (mmm-overlays-at): Added inclusion of boundary + points based on endpoint stickiness. + (mmm-match-front, mmm-match-back): Front and back overlay + properties can now be functions rather than regexps, in + anticipation of new future submode classes. + +2000-03-22 Michael Abraham Shulman + + * mmm-utils.el (mmm-valid-buffer): Renamed and added checking for + "never" modes. + + * mmm-vars.el (mmm-never-modes): Added, to prevent "temporary + shell-mode buffers" and other unnecessariness. + + * mmm-region.el (mmm-overlays-in): Fixed strictness so it doesn't + try to match delimiters of non-mmm overlays. + + * mmm-update.el (mmm-local-maps-alist): Keep track of changed + local maps by buffer and major mode. + (mmm-update-submode-region): Update mode info for major mode. + + * mmm-sample.el: Created file, removing code from `mmm-mode.el'. + + * mmm-auto.el: Created file, removing code from `mmm-mode.el'. + + * mason.el: Created file, removing code from `mmm-mode.el'. + + * mmm-insert.el: Created file, removing code from `mmm-mode.el'. + +2000-03-20 Michael Abraham Shulman + + * mmm-update.el: Created file, removing code from `mmm-mode.el'. + + * mmm-inter.el: Created file, removing code from `mmm-mode.el'. + + * mmm-class.el: Created file, removing code from `mmm-mode.el'. + + * mmm-mode.el (mason): Removed highlight for %doc regions. + + * mmm-region.el: Created file, removing code from `mmm-mode.el'. + + * mmm-utils.el: Created file, removing code from `mmm-mode.el'. + + * mmm-compat.el: Created file, removing code from `mmm-mode.el'. + + * mmm-vars.el: Created file, removing code from `mmm-mode.el'. + + * TODO: Created TODO file, removing comments from `mmm-mode.el'. + + * ChangeLog: Created ChangeLog file and (more or less) ported + existing Change Log to official format. + +2000-03-19 Michael Abraham Shulman + + * mmm-mode.el (mmm-global-mode): usurps and extends the role of + `mmm-add-find-file-hook'. Other modes can piggyback on our hack by + using `mmm-major-mode-hook'. + + Added :insert class parameters. Classes can now define skeletons + to insert submode regions with delimiters based on a keypress. + + Added `mmm-insert-modifiers' and `mmm-command-modifiers' to + configure which keys do what. + +2000-03-18 Michael Abraham Shulman + + * mmm-mode.el: Did a bunch of reorganizing. MMM-ification methods + are now submode classes, and what used to be called submode + classes are now just a type called :group. User interface is + mostly unchanged however. Replaced some gratuitous keywords with + normal symbols. + + Added bells and whistles to :regexp class type, allowing custom + "plugin" functions to verify matches and get the delimiter forms, + the latter of which aren't used yet, but will be soon. Mason + class(es) are now all regexps with a plugin or two. Function class + type is not (yet?) ported to the new interface, holding back + eval-elisp and htp.p with it. + + Changed a couple of `eval-and-compile's to `eval-when-compile'. + + Added special "non-submode" regions, where the major mode holds + sway, but no submodes allowed (until parents are implemented). + Added %doc in text-mode and %text as a non-submode to Mason, and + added %flags, %attr, %method, and %shared tags for Mason classes. + These will be new in Mason version 0.82. + +2000-03-14 Michael Abraham Shulman + + * Version 0.3.7a released. + + * mmm-mode.el: Put `turn-on-font-lock-if-enabled' back in for FSF + Emacs. Don't know why I thought I could take it out. + +2000------ Michael Abraham Shulman + + * Version 0.3.7 released. + + * mmm-mode.el: Set insertion types of markers added to history to + coincide with sticky ends of overlays. It's not perfect, but it's + better. + + Renamed mode and submode hook variables to start with `mmm-'. + + Added "class hooks" run whenever a class is first used in a + buffer. + + Changes for XEmacs compatibility: + - Loaded XEmacs overlay emulation package. + - Renamed some overlay properties when in XEmacs + - Removed `global-font-lock-mode' dependencies. + - Added extra parameter to `regexp-opt' in Mason class. + + Removed "Disclaimers" comment section; I think we have enough + testing that it should work on most systems. + + Reversed order of Change Log so newer changes come first. + + Changed the default submode highlight to a more neutral gray. + + Renamed various "start" and "end" parameters to be more uniform. + + (mmm-ify-by-region): now checks if the region is in bounds. + +1999------ Michael Abraham Shulman + + * Version 0.3.6c released. + + * mmm-mode.el: Added comment about putting autohandlers and + dhandlers in html-mode. + +1999------ Michael Abraham Shulman + + * Version 0.3.6b released. + + * mmm-mode.el: Added comment about `psgml-mode' thanks to Michael + Alan Dorman. + +1999------ Michael Abraham Shulman + + * Version 0.3.6a released. + + * mmm-mode.el: Loaded CL at compile-time to prevent execution of + macro arguments. + +1999------ Michael Abraham Shulman + + * Version 0.3.6 released. + + * mmm-mode.el: Changes for Emacs 19 compatibility. + - Set keyword variables to themselves. + - Added hacks for absence of custom.el and regexp-opt. + - Added user variable to control use of Perl mode vs CPerl mode. + Thanks to Eric A. Zarko for suggestions and testing. + +1999------ Michael Abraham Shulman + + * Version 0.3.5a released. + + * mmm-mode.el (mmm-ify-by-all): no longer re-fontifies buffers + with no submodes. + +1999------ Michael Abraham Shulman + + * Version 0.3.5 released. + + * mmm-mode.el (mmm-fontify-region): now locally binds + `font-lock-beginning-of-syntax-function' to + `mmm-beginning-of-syntax' since `font-lock-fontify-block' binds it + to nil for some reason. + +1999------ Michael Abraham Shulman + + * Version 0.3.4 released. + + * mmm-mode.el (mmm-ify-by-class): now fontifies the buffer + afterward, like the other interactive MMM-ification functions. + Updated a couple doc-strings and prompts. + +1999------ Michael Abraham Shulman + + * Version 0.3.3 released. + + * mmm-mode.el (mmm-regexp-to-regions, mmm-mason-inline): Changed + recursion to iteration, since for long files the recursion runs + afoul of `max-lisp-eval-depth'. + (mason): Commented on workaround for Mason CPerl mess-ups. + Submode overlays now evaporate if they have zero width. + (mmm-parse-region): now has a key binding and doesn't refontify + the entire buffer. + +1999------ Michael Abraham Shulman + + * Version 0.3.2 released. + + * mmm-mode.el (mmm-mode-on, mmm-mode-off): are now interactive. + Fixed bug in Mason class: %def, %text, and %doc are now ignored as + they should be. + +1999-11-21 Michael Abraham Shulman + + * Version 0.3.1 released. + + * mmm-mode.el (mmm-ify-by-class) now adds to history rather than + `mmm-classes'. + Fixed :class keyword so it works correctly. + (mmm-add-mode-ext-class): Classes associated with major modes or + filenames now do The Right Thing when the major mode is changed. + However, `mmm-mode-ext-classes-alist' cannot be directly modified. + (mmm-mode): Updated documentation to cover 0.3.x changes. + +1999-11-21 Michael Abraham Shulman + + * Version 0.3.0 released. + + * mmm-mode.el (mmm-ify-by-class): Added interactive prompt. + (mmm-version): Function added to display version interactively. + Fixed and updated customization definitions. + (mmm-mode-ext-classes-alist): added, allowing the automatic + association of certain major-modes and/or file extensions with + submode classes. + Allowed submode lists to contain :class keyword, so one class can + invoke another one, if they share submode methods. + +1999-11-19 Michael Abraham Shulman + + * Version 0.2.2a released. + + * mmm-mode.el: Fixed bug. + +1999-11-18 Michael Abraham Shulman + + * Version 0.2.2 released. + + * mmm-mode.el (mmm-mason-inline): Replaces the regexps "<% " and + "%>" for HTML::Mason submode class. Inline perl regions don't have + to begin with a space, but the regexp "<%" matches "<%perl>" as + well, which it shouldn't. + Added `save-match-data' calls in all searching functions. + Removed unnecessary auxiliary functions. + +1999-11-16 Michael Abraham Shulman + + * Version 0.2.1 released. + + * mmm-mode.el: Fixed font-lock absence, with-temp-message absence, + mmm-ifying temp buffer. + +1999-11-15 Michael Abraham Shulman + + * Version 0.2.0 released to HTML::Mason mailing list. + + * Comment: Although nearly 100% of the code for mmm-mode was + written by me, the original inspiration came from mmm.el for + XEmacs by Gongquan Chen , so I have continued his + version-numbering. + +1999-01-12 Gongquan Chen + + * Version 0.11 released. + + * mmm.el: Fixed doc-strings and style. Thanks to comments from + Jari Aalto + +1999-01-11 Gongquan Chen + + * Version 0.10 released. + + * mmm.el: Initial release of mmm.el on comp.emacs.xemacs diff --git a/mmm-mode-0.4.8/FAQ b/mmm-mode-0.4.8/FAQ new file mode 100644 index 0000000..20cb8e0 --- /dev/null +++ b/mmm-mode-0.4.8/FAQ @@ -0,0 +1,181 @@ +-*-outline-*- + Frequently Asked Questions about MMM Mode + ========================================= + +* How do I write/capitalize the name of this package/mode? + +However you want. The author says `MMM Mode' (and occasionally `MMM') +when discussing the entire package, and `mmm-mode' when discussing the +emacs mode or function. He does think, however, that `Mmm' looks +rather ugly, although that is how SourceForge insists on capitalizing +the name of the mailing list. + + +* How do I get rid of that ugly gray background color? + +Put the following line in your Emacs initialization file: + + (setq mmm-submode-decoration-level 0) + +You may want to try using MMM Mode for a while with the background +highlight, however, or merely changing it to a different color. There +are two reasons it's there by default: + +1. MMM Mode isn't as smart as you might hope it would be about + recognizing new submode regions, so the presence or absence of the + highlight can let you know at a glance where it thinks they are. + +2. Just like the rest of font-lock, it helps you mentally organize the + code; you can see at a glance that THIS code is executed as Perl, + but THAT code is straight HTML (or whatever). You can get even + more help by setting the above variable to 2, in which case regions + will get a background color according to their function. + + +* I typed `<%' (or other delimiter) but I'm still in the wrong mode. + +MMM Mode isn't that smart yet. You have to tell it explicitly to +reparse (`C-c % C-5' or `C-c % C-b') when you add new submode regions, +and both delimiters have to be present. Hopefully a future version +will be able to automatically recognize new regions an you type them, +but that version is not yet here. + +However, most submode classes provide insertion commands that remove +the need to type the delimiters as well as the need to reparse the +block: type `C-c % h' for a list of available insertion commands for +current submode class(es). + + +* Why is the first character of the end delimiter in the submode region? + +It isn't. When your cursor looks like it is over that character, it +is actually *before* that character and therefore inside the submode +region. You can check that the offending character does not have the +background highlight--that is, if you haven't set the decoration level +to 0. For example, in the following text (where -!- represents the +cursor position) + + print <, there is +a link to the subscription page for the MMM Mode mailing list. When +asking a question on the list, be sure to give the versions of emacs +and MMM Mode you are using, and any other relevant information. diff --git a/mmm-mode-0.4.8/INSTALL b/mmm-mode-0.4.8/INSTALL new file mode 100644 index 0000000..b42a17a --- /dev/null +++ b/mmm-mode-0.4.8/INSTALL @@ -0,0 +1,182 @@ +Basic Installation +================== + + These are generic installation instructions. + + The `configure' shell script attempts to guess correct values for +various system-dependent variables used during compilation. It uses +those values to create a `Makefile' in each directory of the package. +It may also create one or more `.h' files containing system-dependent +definitions. Finally, it creates a shell script `config.status' that +you can run in the future to recreate the current configuration, a file +`config.cache' that saves the results of its tests to speed up +reconfiguring, and a file `config.log' containing compiler output +(useful mainly for debugging `configure'). + + If you need to do unusual things to compile the package, please try +to figure out how `configure' could check whether to do them, and mail +diffs or instructions to the address given in the `README' so they can +be considered for the next release. If at some point `config.cache' +contains results you don't want to keep, you may remove or edit it. + + The file `configure.in' is used to create `configure' by a program +called `autoconf'. You only need `configure.in' if you want to change +it or regenerate `configure' using a newer version of `autoconf'. + +The simplest way to compile this package is: + + 1. `cd' to the directory containing the package's source code and type + `./configure' to configure the package for your system. If you're + using `csh' on an old version of System V, you might need to type + `sh ./configure' instead to prevent `csh' from trying to execute + `configure' itself. + + Running `configure' takes awhile. While running, it prints some + messages telling which features it is checking for. + + 2. Type `make' to compile the package. + + 3. Optionally, type `make check' to run any self-tests that come with + the package. + + 4. Type `make install' to install the programs and any data files and + documentation. + + 5. You can remove the program binaries and object files from the + source code directory by typing `make clean'. To also remove the + files that `configure' created (so you can compile the package for + a different kind of computer), type `make distclean'. There is + also a `make maintainer-clean' target, but that is intended mainly + for the package's developers. If you use it, you may have to get + all sorts of other programs in order to regenerate files that came + with the distribution. + +Compilers and Options +===================== + + Some systems require unusual options for compilation or linking that +the `configure' script does not know about. You can give `configure' +initial values for variables by setting them in the environment. Using +a Bourne-compatible shell, you can do that on the command line like +this: + CC=c89 CFLAGS=-O2 LIBS=-lposix ./configure + +Or on systems that have the `env' program, you can do it like this: + env CPPFLAGS=-I/usr/local/include LDFLAGS=-s ./configure + +Compiling For Multiple Architectures +==================================== + + You can compile the package for more than one kind of computer at the +same time, by placing the object files for each architecture in their +own directory. To do this, you must use a version of `make' that +supports the `VPATH' variable, such as GNU `make'. `cd' to the +directory where you want the object files and executables to go and run +the `configure' script. `configure' automatically checks for the +source code in the directory that `configure' is in and in `..'. + + If you have to use a `make' that does not supports the `VPATH' +variable, you have to compile the package for one architecture at a time +in the source code directory. After you have installed the package for +one architecture, use `make distclean' before reconfiguring for another +architecture. + +Installation Names +================== + + By default, `make install' will install the package's files in +`/usr/local/bin', `/usr/local/man', etc. You can specify an +installation prefix other than `/usr/local' by giving `configure' the +option `--prefix=PATH'. + + You can specify separate installation prefixes for +architecture-specific files and architecture-independent files. If you +give `configure' the option `--exec-prefix=PATH', the package will use +PATH as the prefix for installing programs and libraries. +Documentation and other data files will still use the regular prefix. + + In addition, if you use an unusual directory layout you can give +options like `--bindir=PATH' to specify different values for particular +kinds of files. Run `configure --help' for a list of the directories +you can set and what kinds of files go in them. + + If the package supports it, you can cause programs to be installed +with an extra prefix or suffix on their names by giving `configure' the +option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. + +Optional Features +================= + + Some packages pay attention to `--enable-FEATURE' options to +`configure', where FEATURE indicates an optional part of the package. +They may also pay attention to `--with-PACKAGE' options, where PACKAGE +is something like `gnu-as' or `x' (for the X Window System). The +`README' should mention any `--enable-' and `--with-' options that the +package recognizes. + + For packages that use the X Window System, `configure' can usually +find the X include and library files automatically, but if it doesn't, +you can use the `configure' options `--x-includes=DIR' and +`--x-libraries=DIR' to specify their locations. + +Specifying the System Type +========================== + + There may be some features `configure' can not figure out +automatically, but needs to determine by the type of host the package +will run on. Usually `configure' can figure that out, but if it prints +a message saying it can not guess the host type, give it the +`--host=TYPE' option. TYPE can either be a short name for the system +type, such as `sun4', or a canonical name with three fields: + CPU-COMPANY-SYSTEM + +See the file `config.sub' for the possible values of each field. If +`config.sub' isn't included in this package, then this package doesn't +need to know the host type. + + If you are building compiler tools for cross-compiling, you can also +use the `--target=TYPE' option to select the type of system they will +produce code for and the `--build=TYPE' option to select the type of +system on which you are compiling the package. + +Sharing Defaults +================ + + If you want to set default values for `configure' scripts to share, +you can create a site shell script called `config.site' that gives +default values for variables like `CC', `cache_file', and `prefix'. +`configure' looks for `PREFIX/share/config.site' if it exists, then +`PREFIX/etc/config.site' if it exists. Or, you can set the +`CONFIG_SITE' environment variable to the location of the site script. +A warning: not all `configure' scripts look for a site script. + +Operation Controls +================== + + `configure' recognizes the following options to control how it +operates. + +`--cache-file=FILE' + Use and save the results of the tests in FILE instead of + `./config.cache'. Set FILE to `/dev/null' to disable caching, for + debugging `configure'. + +`--help' + Print a summary of the options to `configure', and exit. + +`--quiet' +`--silent' +`-q' + Do not print messages saying which checks are being made. To + suppress all normal output, redirect it to `/dev/null' (any error + messages will still be shown). + +`--srcdir=DIR' + Look for the package's source code in directory DIR. Usually + `configure' can determine that directory automatically. + +`--version' + Print the version of Autoconf used to generate the `configure' + script, and exit. + +`configure' also accepts some other, not widely useful, options. diff --git a/mmm-mode-0.4.8/Makefile.am b/mmm-mode-0.4.8/Makefile.am new file mode 100644 index 0000000..f350200 --- /dev/null +++ b/mmm-mode-0.4.8/Makefile.am @@ -0,0 +1,16 @@ +## Process this file with automake to produce Makefile.in + +## The MMM Mode distribution is `flat', so we have no SUBDIRS macro. + +lisp_LISP = mmm-compat.el mmm-vars.el mmm-utils.el mmm-auto.el \ + mmm-region.el mmm-class.el mmm-cmds.el mmm-mode.el \ + mmm-sample.el mmm-mason.el mmm-univ.el mmm-rpm.el mmm-cweb.el \ + mmm-noweb.el + +info_TEXINFOS = mmm.texinfo + +# This is a hack IMO. Automake should recognize lisp files as +# "sources" and include them in the distribution, but it doesn't. +EXTRA_DIST = $(lisp_LISP) README.Mason FAQ + +# See also `elisp-comp' for another hack. diff --git a/mmm-mode-0.4.8/Makefile.in b/mmm-mode-0.4.8/Makefile.in new file mode 100644 index 0000000..25fdd64 --- /dev/null +++ b/mmm-mode-0.4.8/Makefile.in @@ -0,0 +1,527 @@ +# Makefile.in generated by automake 1.7.9 from Makefile.am. +# @configure_input@ + +# Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +# Free Software Foundation, Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +top_builddir = . + +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +INSTALL = @INSTALL@ +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EMACS = @EMACS@ +EMACS_VERSION = @EMACS_VERSION@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LTLIBOBJS = @LTLIBOBJS@ +MAKEINFO = @MAKEINFO@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +VERSION = @VERSION@ +ac_ct_STRIP = @ac_ct_STRIP@ +am__leading_dot = @am__leading_dot@ +bindir = @bindir@ +build_alias = @build_alias@ +datadir = @datadir@ +exec_prefix = @exec_prefix@ +host_alias = @host_alias@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +lispdir = @lispdir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +oldincludedir = @oldincludedir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ + +lisp_LISP = mmm-compat.el mmm-vars.el mmm-utils.el mmm-auto.el \ + mmm-region.el mmm-class.el mmm-cmds.el mmm-mode.el \ + mmm-sample.el mmm-mason.el mmm-univ.el mmm-rpm.el mmm-cweb.el \ + mmm-noweb.el + + +info_TEXINFOS = mmm.texinfo + +# This is a hack IMO. Automake should recognize lisp files as +# "sources" and include them in the distribution, but it doesn't. +EXTRA_DIST = $(lisp_LISP) README.Mason FAQ +subdir = . +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs +CONFIG_CLEAN_FILES = +DIST_SOURCES = +am__TEXINFO_TEX_DIR = $(srcdir) +INFO_DEPS = mmm.info +DVIS = mmm.dvi +PDFS = mmm.pdf +PSS = mmm.ps +TEXINFOS = mmm.texinfo +LISP = $(lisp_LISP) + +ELCFILES = mmm-auto.elc mmm-class.elc mmm-cmds.elc mmm-compat.elc \ + mmm-cweb.elc mmm-mason.elc mmm-mode.elc mmm-noweb.elc \ + mmm-region.elc mmm-rpm.elc mmm-sample.elc mmm-univ.elc \ + mmm-utils.elc mmm-vars.elc +am__ELFILES = mmm-auto.el mmm-class.el mmm-cmds.el mmm-compat.el \ + mmm-cweb.el mmm-mason.el mmm-mode.el mmm-noweb.el mmm-region.el \ + mmm-rpm.el mmm-sample.el mmm-univ.el mmm-utils.el mmm-vars.el +elisp_comp = $(top_srcdir)/elisp-comp +DIST_COMMON = README $(srcdir)/Makefile.in $(srcdir)/configure AUTHORS \ + COPYING ChangeLog INSTALL Makefile.am NEWS TODO acinclude.m4 \ + aclocal.m4 configure configure.in elisp-comp install-sh \ + mdate-sh missing mkinstalldirs stamp-vti texinfo.tex \ + version.texi +all: all-am + +.SUFFIXES: +.SUFFIXES: .dvi .el .elc .info .pdf .ps .texinfo + +am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ + configure.lineno +$(srcdir)/Makefile.in: Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) + cd $(top_srcdir) && \ + $(AUTOMAKE) --gnu Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe) + +$(top_builddir)/config.status: $(srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + $(SHELL) ./config.status --recheck +$(srcdir)/configure: $(srcdir)/configure.in $(ACLOCAL_M4) $(CONFIGURE_DEPENDENCIES) + cd $(srcdir) && $(AUTOCONF) + +$(ACLOCAL_M4): configure.in acinclude.m4 + cd $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS) + +.texinfo.info: + @rm -f $@ $@-[0-9] $@-[0-9][0-9] $(@:.info=).i[0-9] $(@:.info=).i[0-9][0-9] + $(MAKEINFO) $(AM_MAKEINFOFLAGS) $(MAKEINFOFLAGS) -I $(srcdir) \ + -o $@ `test -f '$<' || echo '$(srcdir)/'`$< + +.texinfo.dvi: + TEXINPUTS="$(am__TEXINFO_TEX_DIR)$(PATH_SEPARATOR)$$TEXINPUTS" \ + MAKEINFO='$(MAKEINFO) $(AM_MAKEINFOFLAGS) $(MAKEINFOFLAGS) -I $(srcdir)' \ + $(TEXI2DVI) `test -f '$<' || echo '$(srcdir)/'`$< + +.texinfo.pdf: + TEXINPUTS="$(am__TEXINFO_TEX_DIR)$(PATH_SEPARATOR)$$TEXINPUTS" \ + MAKEINFO='$(MAKEINFO) $(AM_MAKEINFOFLAGS) $(MAKEINFOFLAGS) -I $(srcdir)' \ + $(TEXI2PDF) `test -f '$<' || echo '$(srcdir)/'`$< +mmm.info: mmm.texinfo version.texi +mmm.dvi: mmm.texinfo version.texi +mmm.pdf: mmm.texinfo version.texi +version.texi: stamp-vti +stamp-vti: mmm.texinfo $(top_srcdir)/configure + @(dir=.; test -f ./mmm.texinfo || dir=$(srcdir); \ + set `$(SHELL) $(srcdir)/mdate-sh $$dir/mmm.texinfo`; \ + echo "@set UPDATED $$1 $$2 $$3"; \ + echo "@set UPDATED-MONTH $$2 $$3"; \ + echo "@set EDITION $(VERSION)"; \ + echo "@set VERSION $(VERSION)") > vti.tmp + @cmp -s vti.tmp version.texi \ + || (echo "Updating version.texi"; \ + cp vti.tmp version.texi) + -@rm -f vti.tmp + @cp version.texi $@ + +mostlyclean-vti: + -rm -f vti.tmp + +maintainer-clean-vti: + -rm -f stamp-vti version.texi +TEXI2DVI = texi2dvi + +TEXI2PDF = $(TEXI2DVI) --pdf --batch +DVIPS = dvips +.dvi.ps: + $(DVIPS) -o $@ $< + +uninstall-info-am: + $(PRE_UNINSTALL) + @if (install-info --version && \ + install-info --version 2>&1 | sed 1q | grep -i -v debian) >/dev/null 2>&1; then \ + list='$(INFO_DEPS)'; \ + for file in $$list; do \ + relfile=`echo "$$file" | sed 's|^.*/||'`; \ + echo " install-info --info-dir=$(DESTDIR)$(infodir) --remove $(DESTDIR)$(infodir)/$$relfile"; \ + install-info --info-dir=$(DESTDIR)$(infodir) --remove $(DESTDIR)$(infodir)/$$relfile; \ + done; \ + else :; fi + @$(NORMAL_UNINSTALL) + @list='$(INFO_DEPS)'; \ + for file in $$list; do \ + relfile=`echo "$$file" | sed 's|^.*/||'`; \ + relfile_i=`echo "$$relfile" | sed 's|\.info$$||;s|$$|.i|'`; \ + (if cd $(DESTDIR)$(infodir); then \ + echo " rm -f $$relfile $$relfile-[0-9] $$relfile-[0-9][0-9] $$relfile_i[0-9] $$relfile_i[0-9][0-9])"; \ + rm -f $$relfile $$relfile-[0-9] $$relfile-[0-9][0-9] $$relfile_i[0-9] $$relfile_i[0-9][0-9]; \ + else :; fi); \ + done + +dist-info: $(INFO_DEPS) + list='$(INFO_DEPS)'; \ + for base in $$list; do \ + if test -f $$base; then d=.; else d=$(srcdir); fi; \ + for file in $$d/$$base*; do \ + relfile=`expr "$$file" : "$$d/\(.*\)"`; \ + test -f $(distdir)/$$relfile || \ + cp -p $$file $(distdir)/$$relfile; \ + done; \ + done + +mostlyclean-aminfo: + -rm -f mmm.aux mmm.cp mmm.cps mmm.fn mmm.fns mmm.ky mmm.kys mmm.log mmm.pg \ + mmm.pgs mmm.tmp mmm.toc mmm.tp mmm.tps mmm.vr mmm.dvi mmm.pdf \ + mmm.ps + +maintainer-clean-aminfo: + @list='$(INFO_DEPS)'; for i in $$list; do \ + i_i=`echo "$$i" | sed 's|\.info$$||;s|$$|.i|'`; \ + echo " rm -f $$i $$i-[0-9] $$i-[0-9][0-9] $$i_i[0-9] $$i_i[0-9][0-9]"; \ + rm -f $$i $$i-[0-9] $$i-[0-9][0-9] $$i_i[0-9] $$i_i[0-9][0-9]; \ + done +lispLISP_INSTALL = $(INSTALL_DATA) + +elc-stamp: $(am__ELFILES) + @echo 'WARNING: Warnings can be ignored. :-)' + if test $(EMACS) != no; then \ + set x; \ + list='$(am__ELFILES)'; for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + set x "$$@" "$$d$$p"; shift; \ + done; \ + shift; \ + EMACS=$(EMACS) $(SHELL) $(elisp_comp) "$$@" || exit 1; \ + else : ; fi + touch $@ + +.el.elc: + @if test ! -f $@; then \ + rm -f elc-stamp; \ + $(MAKE) $(AM_MAKEFLAGS) elc-stamp; \ + else : ; fi +install-lispLISP: $(lisp_LISP) $(ELCFILES) + @$(NORMAL_INSTALL) + @if test -n "$(lispdir)"; then \ + $(mkinstalldirs) $(DESTDIR)$(lispdir); \ + list='$(lisp_LISP)'; for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + f="`echo $$p | sed -e 's|^.*/||'`"; \ + echo " $(lispLISP_INSTALL) $$d$$p $(DESTDIR)$(lispdir)/$$f"; \ + $(lispLISP_INSTALL) $$d$$p $(DESTDIR)$(lispdir)/$$f; \ + if test -f $${p}c; then \ + echo " $(lispLISP_INSTALL) $${p}c $(DESTDIR)$(lispdir)/$${f}c"; \ + $(lispLISP_INSTALL) $${p}c $(DESTDIR)$(lispdir)/$${f}c; \ + else : ; fi; \ + done; \ + else : ; fi + +uninstall-lispLISP: + @$(NORMAL_UNINSTALL) + @if test -n "$(lispdir)"; then \ + list='$(lisp_LISP)'; for p in $$list; do \ + f="`echo $$p | sed -e 's|^.*/||'`"; \ + echo " rm -f $(DESTDIR)$(lispdir)/$$f $(DESTDIR)$(lispdir)/$${f}c"; \ + rm -f $(DESTDIR)$(lispdir)/$$f $(DESTDIR)$(lispdir)/$${f}c; \ + done; \ + else : ; fi + +clean-lisp: + -rm -f elc-stamp $(ELCFILES) +tags: TAGS +TAGS: + +ctags: CTAGS +CTAGS: + +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) + +top_distdir = . +distdir = $(PACKAGE)-$(VERSION) + +am__remove_distdir = \ + { test ! -d $(distdir) \ + || { find $(distdir) -type d ! -perm -200 -exec chmod u+w {} ';' \ + && rm -fr $(distdir); }; } + +GZIP_ENV = --best +distuninstallcheck_listfiles = find . -type f -print +distcleancheck_listfiles = find . -type f -print + +distdir: $(DISTFILES) + $(am__remove_distdir) + mkdir $(distdir) + @srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's|.|.|g'`; \ + list='$(DISTFILES)'; for file in $$list; do \ + case $$file in \ + $(srcdir)/*) file=`echo "$$file" | sed "s|^$$srcdirstrip/||"`;; \ + $(top_srcdir)/*) file=`echo "$$file" | sed "s|^$$topsrcdirstrip/|$(top_builddir)/|"`;; \ + esac; \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + dir=`echo "$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test "$$dir" != "$$file" && test "$$dir" != "."; then \ + dir="/$$dir"; \ + $(mkinstalldirs) "$(distdir)$$dir"; \ + else \ + dir=''; \ + fi; \ + if test -d $$d/$$file; then \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ + fi; \ + cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ + else \ + test -f $(distdir)/$$file \ + || cp -p $$d/$$file $(distdir)/$$file \ + || exit 1; \ + fi; \ + done + $(MAKE) $(AM_MAKEFLAGS) \ + top_distdir="$(top_distdir)" distdir="$(distdir)" \ + dist-info + -find $(distdir) -type d ! -perm -777 -exec chmod a+rwx {} \; -o \ + ! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \ + ! -type d ! -perm -400 -exec chmod a+r {} \; -o \ + ! -type d ! -perm -444 -exec $(SHELL) $(install_sh) -c -m a+r {} {} \; \ + || chmod -R a+r $(distdir) +dist-gzip: distdir + $(AMTAR) chof - $(distdir) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).tar.gz + $(am__remove_distdir) + +dist dist-all: distdir + $(AMTAR) chof - $(distdir) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).tar.gz + $(am__remove_distdir) + +# This target untars the dist file and tries a VPATH configuration. Then +# it guarantees that the distribution is self-contained by making another +# tarfile. +distcheck: dist + $(am__remove_distdir) + GZIP=$(GZIP_ENV) gunzip -c $(distdir).tar.gz | $(AMTAR) xf - + chmod -R a-w $(distdir); chmod a+w $(distdir) + mkdir $(distdir)/_build + mkdir $(distdir)/_inst + chmod a-w $(distdir) + dc_install_base=`$(am__cd) $(distdir)/_inst && pwd | sed -e 's,^[^:\\/]:[\\/],/,'` \ + && dc_destdir="$${TMPDIR-/tmp}/am-dc-$$$$/" \ + && cd $(distdir)/_build \ + && ../configure --srcdir=.. --prefix="$$dc_install_base" \ + $(DISTCHECK_CONFIGURE_FLAGS) \ + && $(MAKE) $(AM_MAKEFLAGS) \ + && $(MAKE) $(AM_MAKEFLAGS) dvi \ + && $(MAKE) $(AM_MAKEFLAGS) check \ + && $(MAKE) $(AM_MAKEFLAGS) install \ + && $(MAKE) $(AM_MAKEFLAGS) installcheck \ + && $(MAKE) $(AM_MAKEFLAGS) uninstall \ + && $(MAKE) $(AM_MAKEFLAGS) distuninstallcheck_dir="$$dc_install_base" \ + distuninstallcheck \ + && chmod -R a-w "$$dc_install_base" \ + && ({ \ + (cd ../.. && $(mkinstalldirs) "$$dc_destdir") \ + && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" install \ + && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" uninstall \ + && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" \ + distuninstallcheck_dir="$$dc_destdir" distuninstallcheck; \ + } || { rm -rf "$$dc_destdir"; exit 1; }) \ + && rm -rf "$$dc_destdir" \ + && $(MAKE) $(AM_MAKEFLAGS) dist-gzip \ + && rm -f $(distdir).tar.gz \ + && $(MAKE) $(AM_MAKEFLAGS) distcleancheck + $(am__remove_distdir) + @echo "$(distdir).tar.gz is ready for distribution" | \ + sed 'h;s/./=/g;p;x;p;x' +distuninstallcheck: + @cd $(distuninstallcheck_dir) \ + && test `$(distuninstallcheck_listfiles) | wc -l` -le 1 \ + || { echo "ERROR: files left after uninstall:" ; \ + if test -n "$(DESTDIR)"; then \ + echo " (check DESTDIR support)"; \ + fi ; \ + $(distuninstallcheck_listfiles) ; \ + exit 1; } >&2 +distcleancheck: distclean + @if test '$(srcdir)' = . ; then \ + echo "ERROR: distcleancheck can only run from a VPATH build" ; \ + exit 1 ; \ + fi + @test `$(distcleancheck_listfiles) | wc -l` -eq 0 \ + || { echo "ERROR: files left in build directory after distclean:" ; \ + $(distcleancheck_listfiles) ; \ + exit 1; } >&2 +check-am: all-am +check: check-am +all-am: Makefile $(INFO_DEPS) $(LISP) elc-stamp $(ELCFILES) + +installdirs: + $(mkinstalldirs) $(DESTDIR)$(infodir) $(DESTDIR)$(lispdir) +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -rm -f $(CONFIG_CLEAN_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-lisp mostlyclean-am + +distclean: distclean-am + -rm -f $(am__CONFIG_DISTCLEAN_FILES) + -rm -f Makefile +distclean-am: clean-am distclean-generic + +dvi: dvi-am + +dvi-am: $(DVIS) + +info: info-am + +info-am: $(INFO_DEPS) + +install-data-am: install-info-am install-lispLISP + +install-exec-am: + +install-info: install-info-am + +install-info-am: $(INFO_DEPS) + @$(NORMAL_INSTALL) + $(mkinstalldirs) $(DESTDIR)$(infodir) + @list='$(INFO_DEPS)'; \ + for file in $$list; do \ + if test -f $$file; then d=.; else d=$(srcdir); fi; \ + file_i=`echo "$$file" | sed 's|\.info$$||;s|$$|.i|'`; \ + for ifile in $$d/$$file $$d/$$file-[0-9] $$d/$$file-[0-9][0-9] \ + $$d/$$file_i[0-9] $$d/$$file_i[0-9][0-9] ; do \ + if test -f $$ifile; then \ + relfile=`echo "$$ifile" | sed 's|^.*/||'`; \ + echo " $(INSTALL_DATA) $$ifile $(DESTDIR)$(infodir)/$$relfile"; \ + $(INSTALL_DATA) $$ifile $(DESTDIR)$(infodir)/$$relfile; \ + else : ; fi; \ + done; \ + done + @$(POST_INSTALL) + @if (install-info --version && \ + install-info --version 2>&1 | sed 1q | grep -i -v debian) >/dev/null 2>&1; then \ + list='$(INFO_DEPS)'; \ + for file in $$list; do \ + relfile=`echo "$$file" | sed 's|^.*/||'`; \ + echo " install-info --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/$$relfile";\ + install-info --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/$$relfile || :;\ + done; \ + else : ; fi +install-man: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f $(am__CONFIG_DISTCLEAN_FILES) + -rm -rf $(top_srcdir)/autom4te.cache + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-aminfo \ + maintainer-clean-generic maintainer-clean-vti + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-aminfo mostlyclean-generic mostlyclean-vti + +pdf: pdf-am + +pdf-am: $(PDFS) + +ps: ps-am + +ps-am: $(PSS) + +uninstall-am: uninstall-info-am uninstall-lispLISP + +.PHONY: all all-am check check-am clean clean-generic clean-lisp dist \ + dist-all dist-gzip dist-info distcheck distclean \ + distclean-generic distcleancheck distdir distuninstallcheck dvi \ + dvi-am info info-am install install-am install-data \ + install-data-am install-exec install-exec-am install-info \ + install-info-am install-lispLISP install-man install-strip \ + installcheck installcheck-am installdirs maintainer-clean \ + maintainer-clean-aminfo maintainer-clean-generic \ + maintainer-clean-vti mostlyclean mostlyclean-aminfo \ + mostlyclean-generic mostlyclean-vti pdf pdf-am ps ps-am \ + uninstall uninstall-am uninstall-info-am uninstall-lispLISP + + +# See also `elisp-comp' for another hack. +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/mmm-mode-0.4.8/NEWS b/mmm-mode-0.4.8/NEWS new file mode 100644 index 0000000..41a1512 --- /dev/null +++ b/mmm-mode-0.4.8/NEWS @@ -0,0 +1,247 @@ +MMM Mode NEWS -- history of user-visible changes. -*-outline-*- +Copyright (C) 2003, 2004 Michael Abraham Shulman +See the file COPYING for copying conditions. + +Please submit bug reports at http://sourceforge.net/projects/mmm-mode/ + +* Changes in MMM Mode 0.4.8 + +** Delimiter Regions + +The delimiters which mark off submode regions now have their own +overlays. They can be highlighted if you so desire using appropriate +class arguments and/or the variable mmm-delimiter-face. They are also +in an appropriate major mode, or non-mode as the case may be. + +** Nested Submodes + +Nested submodes are now vaguely supported. + +** RPM Spec File + +An RPM spec file, contributed by , is now +included for people who wish to build their own SRPM to install from. + +** New Submode Classes + +Many thanks to Joe Kelsey for writing a very intelligent class for +editing Noweb files, and to Alan Shutko for one for CWeb files. We +also have a mode for SGML DTD definitions from Yann Dirson. + +** Numerous bugfixes and small improvements + + +* Changes in MMM Mode 0.4.7 + +** Multiple Decoration Levels + +You now have finer control over how colorful your submode regions are, +via `mmm-submode-decoration-level'. Level 0 turns coloring off--no +messing around with faces required. Level 1 (default) is the same as +in previous versions. Level 2 colors regions according to function: +initialization, cleanup, output, declaration, comment, etc. + +** Preferred Major Modes + +The variable `mmm-major-mode-preferences' lets you tell MMM what modes +you prefer for different programming languages and they will be used +by all submode classes. + +** New Submode Classes + +New submode classes for JSP and ePerl are included. A major bug in +the handling of embedded Java (and other C-type languages) was fixed, +so the JSP class should work consistently. + + +* MMM Mode 0.4.6 is a bug-fix release with one user-visible change: + +** New Submode Class for RPM Spec Files + +Contributed by Marcus Harnisch, the `rpm' submode class allows editing +appropriate parts of RPM spec files in shell-script mode. + + +* Changes in MMM Mode 0.4.5 + +** Font-Lock works again in XEmacs + +The MMM code to handle font-locking broke in XEmacs several versions +back due to differences in the font-lock implementation between Emacs +and XEmacs. It appears to be working once again. + +** Here-Document submode class improved + +Here-document names such as <', rather than `C-c % ' as +in previous versions. Key sequences of the form `C-c % ' are +now reserved for submode region insertion. The old behavior can be +restored by setting the variable `mmm-use-old-command-keys' to a +non-nil value before MMM Mode is loaded--then insertion commands are +bound to `C-c % C-' sequences. + +** New Global Mode added + +MMM Global Mode can now turn MMM Mode on automatically in all buffers, +or only in buffers that have associated submode classes. It replaces +the previous function `mmm-add-find-file-hook', which still works for +now. A side effect of this change is that it is no longer necessary +to use `mmm-add-mode-ext-class': `mmm-mode-ext-classes-alist' can be +modified directly. + +The hack used by MMM Global Mode to insinuate itself into all buffers +is different from, but vaguely similar to, the one used by FSF Emacs' +Global Font Lock Mode. In order that future writers of global modes +don't have to reinvent the wheel, MMM Global Mode provides the hook +`mmm-major-mode-hook' which is run (in theory) whenever a major mode +starts up. Perhaps in future this will be provided in a separate +package. + +** Automatic submode region insertion commands + +Submode classes can now define skeletons for automatic insertion of +submode regions with delimiters. For example, when using the Mason +class, the key sequence `C-c % %' will (by default) insert the text +`<% -!- %>' with point where indicated and submode region already +present. These commands also wrap around words as described in the +documentation of `skeleton-insert'. + +** Info Documentation File + +MMM Mode now has an (admittedly incomplete) manual in Texinfo format. +It can be found in the files `mmm.info' or `mmm.texinfo' in the +distribution. + +** Automatic Installation + +MMM Mode now uses GNU automake/autoconf for ease of installation. See +the files README and INSTALL for more information. + +** Changed submode class specification format + +This change affects only people who define their own submode classes. +The format for defining submode classes has changed; it now uses +keyword arguments for clarity and has a few more possible arguments, +including skeletons for submode region insertion. diff --git a/mmm-mode-0.4.8/README b/mmm-mode-0.4.8/README new file mode 100644 index 0000000..fdcb874 --- /dev/null +++ b/mmm-mode-0.4.8/README @@ -0,0 +1,122 @@ + + MMM Mode for Emacs + ================== + +OVERVIEW + + MMM Mode is a minor mode for Emacs that allows Multiple Major Modes + to coexist in one buffer. It is well-suited to editing: + + * Preprocessed code, such as server-side Perl or PHP embedded in HTML + * Code generating code, such as HTML output by CGI scripts + * Embedded code, such as Javascript in HTML + * Literate programming: code interspersed with documentation, e.g. Noweb + +INSTALLATION + + MMM Mode has a standard GNU configure-driven installation. (See the + file INSTALL for generic instructions, most of which don't apply.) + To install in the standard locations, unpack the archive, `cd' to + the mmm-mode-X.X.X directory created, and run these commands: + + ./configure + make + make install + + Alternately, since currently MMM Mode is written in pure Emacs Lisp, + you could just copy all the *.el files in the distribution to a + directory in your `load-path', and optionally byte-compile them + manually (see the Emacs Manual). The configure installation also + installs the MMM Mode info manual in your site info directory, so if + you're installing manually, you might want to do that too. + + If you're installing from the CVS version, you won't have the + configure script. If you have the automake/autoconf tools + installed, you can run the script `autogen.sh' first, and then + proceed as above. Otherwise, you'll have to copy the *.el files + manually as described above. + + If you have more than one version of emacs installed and want to + use MMM in a version other than /usr/bin/emacs, you must set the + environment variable EMACS before running `configure', e.g. + + EMACS=/usr/bin/xemacs ./configure + make + make install + + If you want to use MMM in more than one version of emacs, you must + either have separate site-lisp directories (such as Debian does), or + load it from source every time; byte-compiled files are not portable + between emacsen. + +CONFIGURATION + + Once MMM Mode is installed, it has to be configured correctly. This + can be done in a site-start file or in user's initialization files; + usually the latter is preferable, except possibly for autoloads. + First the package needs to be loaded, with either + + (require 'mmm-mode) + + or instead, to save time during emacs startup, + + (require 'mmm-auto) + + Then you will probably want to set something like this: + + (setq mmm-global-mode 'maybe) + (mmm-add-mode-ext-class 'html-mode "\\.php\\'" 'html-php) + + The first line tells MMM Mode to load itself whenever you open an + appropriate file, and the second is an example which says to notice + PHP regions in html-mode files having a `.php' extension. Both + lines are necessary. + + You will, of course, want to change and duplicate the second line + according to your needs. either of the first two parameters can be + `nil', meaning not to consider that criterion. For example, if all + your html files, regardless of extension, are Mason components, you + will want something like: + + (mmm-add-mode-ext-class 'html-mode nil 'mason) + + whereas if all your files with a `.nw' extension, regardless of + primary mode (some may be LaTeX, others HTML, say) are Noweb, you + will prefer + + (mmm-add-mode-ext-class nil "\\.nw\\'" 'noweb) + + See the info file for more extensive documentation, and for other + configuration options. + +DOCUMENTATION + + For further information, see (in order) the accompanying info file, + the documentation strings of functions and variables, the comments + in the source code, and the source code itself. + +UPDATES + + The latest version of MMM Mode should always be available from + http://sourceforge.net/projects/mmm-mode + +BUG REPORTS + + Bug reports and suggestions can be submitted at + , or + through email to . + +CONTACT INFO + + MMM Mode is written and maintained by Michael Shulman, + , and others; a list of some + contributors can be found on the Sourceforge project. + +MAILING LIST + + To subscribe to the MMM Mode mailing list, visit + . + The mailing list receives announcements of new releases and provides + a forum for discussion of bugs and features. + + Thanks for using MMM Mode! diff --git a/mmm-mode-0.4.8/README.Mason b/mmm-mode-0.4.8/README.Mason new file mode 100644 index 0000000..062435c --- /dev/null +++ b/mmm-mode-0.4.8/README.Mason @@ -0,0 +1,122 @@ +-*-text-*- + Using MMM Mode for Mason: An Overview + ===================================== + + Since many users of MMM Mode use it for Mason , and + since the Mason submode class is the most complex one supplied, a + few comments regarding its usage are in order. Even if you don't + use Mason, this file may be of interest to you as an example of MMM + usage and possible problems. + +INSTALLATION AND LOADING + + For general installation and information, see the README file and + the texinfo documentation. The submode class for Mason components + is called `mason' and is automatically loaded from `mmm-mason.el' + the first time it is used. + +MODES AND EXTENSIONS + + If you want to have mason submodes automatically in all Mason files, + you can use `mmm-mode-ext-classes-alist'; the details depend on what + you call your Mason components and what major mode you use. Some + example elements of `mmm-mode-ext-classes-alist' follow, with + comments on the corresponding naming scheme. + + (html-mode "\\.html\\'" mason) ;; Any .html file in html-mode + (hm--html-mode nil mason) ;; Any buffer in hm--html-mode + (sgml-mode nil mason) ;; Any buffer in sgml-mode + (nil "\\.\\(mason\\|html\\)\\'" mason) ;; All .mason and .html files + (nil "\\.m[dc]\\'" mason) ;; All .md and .mc files + (nil "\\`/var/www/mason/" mason) ;; Any file in the directory + (nil nil mason) ;; All buffers. + + In order for any of these to work, you must set `mmm-global-mode' to + a non-nil value, such as `t' or `maybe' (the two of which mean + different things; see the documentation). This can be done with a + line in .emacs such as the following: + + (setq mmm-global-mode 'maybe) + + If you use an extension for your Mason files that emacs does not + automatically place in your preferred HTML Mode (be it html-mode, + sgml-html-mode, hm--html-mode, or whatever), you will probably want + to associate that extension with your HTML Mode (this is a feature + of emacs, not MMM Mode). An example is shown below. + + (add-to-list 'auto-mode-alist '("\\.mason\\'" . html-mode)) + + This also goes for "special" Mason files such as autohandlers and + dhandlers. The code below tells emacs to use html-mode for files + named `autohandler' and `dhandler'. + + (add-to-list 'auto-mode-alist '("\\(auto\\|d\\)handler\\'" . html-mode)) + + An alternate solution is to change the names of your autohandlers + and dhandlers so that emacs recognizes them as HTML automatically. + Similar code can be used to recognize all files in a given directory + as HTML and/or Mason. + +CPERL PROBLEMS + + There are certain problems with CPerl mode in submode regions. (Not + to say that the original perl-mode would do any better--it hasn't + been much tried.) First of all, the first line of a Perl section + is usually indented as if it were a continuation line. A fix for + this is to start with a semicolon on the first line. The insertion + key commands do this whenever the Mason syntax allows it. + + <%perl>; + print $var; + + + In addition, some users have reported that the CPerl indentation + sometimes does not work. This problem has not yet been tracked + down, however, and more data about when it happens would be helpful. + +PSGML PROBLEMS + + Some people have reported problems using PSGML with Mason. Adding + the following line to a .emacs file should suffice to turn PSGML off + and cause emacs to use a simpler HTML mode: + + (autoload 'html-mode "sgml-mode" "HTML Mode" t) + + Earlier versions of PSGML may require instead the following fix: + + (delete '("\\.html$" . sgml-html-mode) auto-mode-alist) + (delete '("\\.shtml$" . sgml-html-mode) auto-mode-alist) + + Other users report using PSGML with Mason and MMM Mode without + difficulty. If you don't have problems and want to use PSGML, you + may need to replace `html-mode' in the suggested code with + `sgml-html-mode'. (Depending on your version of PSGML, this may not + be necessary.) Similarly, if you are using XEmacs and want to use + the alternate HTML mode `hm--html-mode', replace `html-mode' with + that symbol. + + One problem that crops up when using PSGML with Mason is that even + ignoring the special tags and Perl code (which, as I've said, + haven't caused me any problems), Mason components often are not a + complete SGML document. For instance, my autohandlers often say + + + <% $m->call_next %> + + + in which case the actual components contain no doctype declaration, + , , or , confusing PSGML. One solution I've found + is to use the variable `sgml-parent-document' in such incomplete + components; try, for example, these lines at the end of a component. + + %# Local Variables: + %# sgml-parent-document: ("autohandler" "body" nil ("body")) + %# sgml-doctype: "/top/level/autohandler" + %# End: + + This tells PSGML that the current file is a sub-document of the file + `autohandler' and is included inside a tag, thus alleviating + its confusion, and also instructs it where to find the doctype + declaration (assuming your top-level autohandler has one). This + alleviates most problems for me. I admit to not understanding PSGML + internals very well, so YMMV. diff --git a/mmm-mode-0.4.8/TODO b/mmm-mode-0.4.8/TODO new file mode 100644 index 0000000..e631145 --- /dev/null +++ b/mmm-mode-0.4.8/TODO @@ -0,0 +1,67 @@ +Hey Emacs, this is a -*-text-*- file! + + To Do List for MMM Mode + ======================= + +It would be nice to have a "split region" command which would insert +a _back_ delimiter followed by a _front_ delimiter at point and split +the current region into two regions. Say for PHP. + +Custom mode functions like `mason-mode'. + +Make Mason work a little better with PSGML. The fix I've found works, +but it would be nifty if MMM could do it automatically. Maybe the +custom-mode thing could set the variables, or a hook somewhere. + +Apostrophes mess up Perl parsing in XEmacs but not Emacs. I thought +it was because XEmacs sets `font-lock-beginning-of-syntax-function' +after MMM does, but changing that that didn't fix it. + +Improve re-parsing current region to use inclusion/offsets/etc. + +Support for: ASP, PHP + +DEB and/or RPM packages would be nice. + +The local-variables improvements can probably be used to set minor +modes locally to submode regions. This could replace tmmofl, +especially if we search for regions other than by regexps, say by +syntax properties. + +Trap paragraph motion commands to stop at submode boundaries? + +On text insertion (in `after-change-functions'), do two things. +First, if inside in a region, or after a hanging one, scan for its +back and adjust if necessary. Second, scan both for complete regions +and for hanging fronts. In the latter case, we may insert the back or +start a hanging region; user option. Don't just scan the inserted +text, but backwards, using `mmm-looking-back-at'. Remember to handle +delimiter inclusion and offsets as best possible. + +It would be nice if C-j ended a Mason one-liner and began a new one on +the next line. This is a rather Mason-specific thing, but other +classes might have similar single-line regions. Add a new submode +class argument, such as KEYMAP, or even ONE-LINE? + +Allow a submode class to specify its allowable "parent" submode +classes. This could also be used to implement htp.p, by first +scanning for the function calls as a major-mode submode region, then +requiring that parent type for the HTML mode class. Nested submodes +alternate highlight colors, say with `mmm-secondary-submode-face'. + +Ought %text in Mason to be a non-submode, since any Mason tags inside +it will probably be /edited/ as Perl (being, say, code examples)? +Only problem is it might confuse the programmer into thinking that +code will get executed. Maybe use a different face. Could do that +with another grouping class, say uneval-mason, that overrides the +faces of mason and has :parent mason-text, and allow a mode to specify +what about it changes depending on its parent, or a parent to specify +changes to its children, or a group to specify changes to its members. + +If font-locking needs more help, try narrowing the region before +fontifying, or even advising `parse-partial-sexp' and friends. At +present, it seems good enough, though. + +It'd be nice if submode regions could preserve the indentation of the +dominant major mode code around them. For example, Perl code embedded +in HTML where the HTML is indented such as for a table. diff --git a/mmm-mode-0.4.8/acinclude.m4 b/mmm-mode-0.4.8/acinclude.m4 new file mode 100644 index 0000000..e02262f --- /dev/null +++ b/mmm-mode-0.4.8/acinclude.m4 @@ -0,0 +1,165 @@ +dnl +dnl Execute arbitrary emacs lisp +dnl +AC_DEFUN(AC_EMACS_LISP, [ +elisp="$2" +if test -z "$3"; then + AC_MSG_CHECKING(for $1) +fi +AC_CACHE_VAL(EMACS_cv_SYS_$1,[ + OUTPUT=./conftest-$$ + echo ${EMACS} -batch -eval "(let ((x ${elisp})) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil \"${OUTPUT}\"))" >& AC_FD_CC 2>&1 + ${EMACS} -batch -eval "(let ((x ${elisp})) (write-region (if (stringp x) (princ x 'ignore) (prin1-to-string x)) nil \"${OUTPUT}\"nil 5))" >& AC_FD_CC 2>&1 + retval=`cat ${OUTPUT}` + echo "=> ${retval}" >& AC_FD_CC 2>&1 + rm -f ${OUTPUT} + EMACS_cv_SYS_$1=$retval +]) +$1=${EMACS_cv_SYS_$1} +if test -z "$3"; then + AC_MSG_RESULT($$1) +fi +]) + +AC_DEFUN(AC_XEMACS_P, [ + AC_MSG_CHECKING([if $EMACS is really XEmacs]) + AC_EMACS_LISP(xemacsp,(if (string-match \"XEmacs\" emacs-version) \"yes\" \"no\") ,"noecho") + XEMACS=${EMACS_cv_SYS_xemacsp} + EMACS_FLAVOR=emacs + if test "$XEMACS" = "yes"; then + EMACS_FLAVOR=xemacs + fi + AC_MSG_RESULT($XEMACS) + AC_SUBST(XEMACS) + AC_SUBST(EMACS_FLAVOR) +]) + +AC_DEFUN(AC_PATH_LISPDIR, [ + AC_XEMACS_P + if test "$prefix" = "NONE"; then + AC_MSG_CHECKING([prefix for your Emacs]) + AC_EMACS_LISP(prefix,(expand-file-name \"..\" invocation-directory),"noecho") + prefix=${EMACS_cv_SYS_prefix} + AC_MSG_RESULT($prefix) + fi + AC_ARG_WITH(lispdir, --with-lispdir Where to install lisp files, lispdir=${withval}) + AC_MSG_CHECKING([where .elc files should go]) + if test -z "$lispdir"; then + dnl Set default value + theprefix=$prefix + if test "x$theprefix" = "xNONE"; then + theprefix=$ac_default_prefix + fi + lispdir="\$(datadir)/${EMACS_FLAVOR}/site-lisp" + for thedir in share lib; do + potential= + if test -d ${theprefix}/${thedir}/${EMACS_FLAVOR}/site-lisp; then + lispdir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-lisp" + break + fi + done + fi + AC_MSG_RESULT($lispdir) + AC_SUBST(lispdir) +]) + +dnl +dnl Determine the emacs version we are running. +dnl Automatically substitutes @EMACS_VERSION@ with this number. +dnl +AC_DEFUN(AC_EMACS_VERSION, [ +AC_MSG_CHECKING(for emacs version) +AC_EMACS_LISP(version,(and (boundp 'emacs-major-version) (format \"%d.%d\" emacs-major-version emacs-minor-version)),"noecho") + +EMACS_VERSION=${EMACS_cv_SYS_version} +AC_SUBST(EMACS_VERSION) +AC_MSG_RESULT(${EMACS_VERSION}) +]) + +dnl +dnl Determine whether the specified version of Emacs supports packages +dnl or not. Currently, only XEmacs 20.3 does, but this is a general +dnl check. +dnl +AC_DEFUN(AC_EMACS_PACKAGES, [ +AC_ARG_WITH(package-dir, --with-package-dir Configure as a XEmacs package in directory, [ EMACS_PACKAGE_DIR="${withval}"]) +if test -n "$EMACS_PACKAGE_DIR"; then + if test "$prefix" != "NONE"; then + AC_MSG_ERROR([--with-package-dir and --prefix are mutually exclusive]) + fi + dnl Massage everything to use $(prefix) correctly. + prefix=$EMACS_PACKAGE_DIR + datadir='$(prefix)/etc/w3' + infodir='$(prefix)/info' + lispdir='$(prefix)/lisp/w3' +fi +AC_SUBST(EMACS_PACKAGE_DIR) +]) + +dnl +dnl Check whether a function exists in a library +dnl All '_' characters in the first argument are converted to '-' +dnl +AC_DEFUN(AC_EMACS_CHECK_LIB, [ +if test -z "$3"; then + AC_MSG_CHECKING(for $2 in $1) +fi +library=`echo $1 | tr _ -` +AC_EMACS_LISP($1,(progn (fmakunbound '$2) (condition-case nil (progn (require '$library) (fboundp '$2)) (error (prog1 nil (message \"$library not found\"))))),"noecho") +if test "${EMACS_cv_SYS_$1}" = "nil"; then + EMACS_cv_SYS_$1=no +fi +if test "${EMACS_cv_SYS_$1}" = "t"; then + EMACS_cv_SYS_$1=yes +fi +HAVE_$1=${EMACS_cv_SYS_$1} +AC_SUBST(HAVE_$1) +if test -z "$3"; then + AC_MSG_RESULT($HAVE_$1) +fi +]) + +dnl +dnl Check whether a variable exists in a library +dnl All '_' characters in the first argument are converted to '-' +dnl +AC_DEFUN(AC_EMACS_CHECK_VAR, [ +AC_MSG_CHECKING(for $2 in $1) +library=`echo $1 | tr _ -` +AC_EMACS_LISP($1,(progn (makunbound '$2) (condition-case nil (progn (require '$library) (boundp '$2)) (error nil))),"noecho") +if test "${EMACS_cv_SYS_$1}" = "nil"; then + EMACS_cv_SYS_$1=no +fi +HAVE_$1=${EMACS_cv_SYS_$1} +AC_SUBST(HAVE_$1) +AC_MSG_RESULT($HAVE_$1) +]) + +dnl +dnl Perform sanity checking and try to locate the custom and widget packages +dnl +AC_DEFUN(AC_CHECK_CUSTOM, [ +AC_MSG_CHECKING(for acceptable custom library) +AC_CACHE_VAL(EMACS_cv_ACCEPTABLE_CUSTOM,[ +AC_EMACS_CHECK_LIB(widget,widget-convert-text,"noecho") +AC_EMACS_CHECK_LIB(wid_edit,widget-convert-text,"noecho") +if test "${HAVE_widget}" = "yes"; then + EMACS_cv_ACCEPTABLE_CUSTOM=yes +else + if test "${HAVE_wid_edit}" != "no"; then + EMACS_cv_ACCEPTABLE_CUSTOM=yes + else + EMACS_cv_ACCEPTABLE_CUSTOM=no + fi +fi +if test "${EMACS_cv_ACCEPTABLE_CUSTOM}" = "yes"; then + AC_EMACS_LISP(widget_dir,(file-name-directory (locate-library \"widget\")),"noecho") + EMACS_cv_ACCEPTABLE_CUSTOM=$EMACS_cv_SYS_widget_dir +fi +]) + AC_ARG_WITH(custom, --with-custom Specify where to find the custom package, [ EMACS_cv_ACCEPTABLE_CUSTOM=`( cd $withval && pwd || echo "$withval" ) 2> /dev/null` ]) + CUSTOM=${EMACS_cv_ACCEPTABLE_CUSTOM} + AC_SUBST(CUSTOM) + AC_MSG_RESULT("${CUSTOM}") +]) + diff --git a/mmm-mode-0.4.8/aclocal.m4 b/mmm-mode-0.4.8/aclocal.m4 new file mode 100644 index 0000000..d9736d2 --- /dev/null +++ b/mmm-mode-0.4.8/aclocal.m4 @@ -0,0 +1,1063 @@ +# generated automatically by aclocal 1.7.9 -*- Autoconf -*- + +# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +# Free Software Foundation, Inc. +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +dnl +dnl Execute arbitrary emacs lisp +dnl +AC_DEFUN(AC_EMACS_LISP, [ +elisp="$2" +if test -z "$3"; then + AC_MSG_CHECKING(for $1) +fi +AC_CACHE_VAL(EMACS_cv_SYS_$1,[ + OUTPUT=./conftest-$$ + echo ${EMACS} -batch -eval "(let ((x ${elisp})) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil \"${OUTPUT}\"))" >& AC_FD_CC 2>&1 + ${EMACS} -batch -eval "(let ((x ${elisp})) (write-region (if (stringp x) (princ x 'ignore) (prin1-to-string x)) nil \"${OUTPUT}\"nil 5))" >& AC_FD_CC 2>&1 + retval=`cat ${OUTPUT}` + echo "=> ${retval}" >& AC_FD_CC 2>&1 + rm -f ${OUTPUT} + EMACS_cv_SYS_$1=$retval +]) +$1=${EMACS_cv_SYS_$1} +if test -z "$3"; then + AC_MSG_RESULT($$1) +fi +]) + +AC_DEFUN(AC_XEMACS_P, [ + AC_MSG_CHECKING([if $EMACS is really XEmacs]) + AC_EMACS_LISP(xemacsp,(if (string-match \"XEmacs\" emacs-version) \"yes\" \"no\") ,"noecho") + XEMACS=${EMACS_cv_SYS_xemacsp} + EMACS_FLAVOR=emacs + if test "$XEMACS" = "yes"; then + EMACS_FLAVOR=xemacs + fi + AC_MSG_RESULT($XEMACS) + AC_SUBST(XEMACS) + AC_SUBST(EMACS_FLAVOR) +]) + +AC_DEFUN(AC_PATH_LISPDIR, [ + AC_XEMACS_P + if test "$prefix" = "NONE"; then + AC_MSG_CHECKING([prefix for your Emacs]) + AC_EMACS_LISP(prefix,(expand-file-name \"..\" invocation-directory),"noecho") + prefix=${EMACS_cv_SYS_prefix} + AC_MSG_RESULT($prefix) + fi + AC_ARG_WITH(lispdir, --with-lispdir Where to install lisp files, lispdir=${withval}) + AC_MSG_CHECKING([where .elc files should go]) + if test -z "$lispdir"; then + dnl Set default value + theprefix=$prefix + if test "x$theprefix" = "xNONE"; then + theprefix=$ac_default_prefix + fi + lispdir="\$(datadir)/${EMACS_FLAVOR}/site-lisp" + for thedir in share lib; do + potential= + if test -d ${theprefix}/${thedir}/${EMACS_FLAVOR}/site-lisp; then + lispdir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-lisp" + break + fi + done + fi + AC_MSG_RESULT($lispdir) + AC_SUBST(lispdir) +]) + +dnl +dnl Determine the emacs version we are running. +dnl Automatically substitutes @EMACS_VERSION@ with this number. +dnl +AC_DEFUN(AC_EMACS_VERSION, [ +AC_MSG_CHECKING(for emacs version) +AC_EMACS_LISP(version,(and (boundp 'emacs-major-version) (format \"%d.%d\" emacs-major-version emacs-minor-version)),"noecho") + +EMACS_VERSION=${EMACS_cv_SYS_version} +AC_SUBST(EMACS_VERSION) +AC_MSG_RESULT(${EMACS_VERSION}) +]) + +dnl +dnl Determine whether the specified version of Emacs supports packages +dnl or not. Currently, only XEmacs 20.3 does, but this is a general +dnl check. +dnl +AC_DEFUN(AC_EMACS_PACKAGES, [ +AC_ARG_WITH(package-dir, --with-package-dir Configure as a XEmacs package in directory, [ EMACS_PACKAGE_DIR="${withval}"]) +if test -n "$EMACS_PACKAGE_DIR"; then + if test "$prefix" != "NONE"; then + AC_MSG_ERROR([--with-package-dir and --prefix are mutually exclusive]) + fi + dnl Massage everything to use $(prefix) correctly. + prefix=$EMACS_PACKAGE_DIR + datadir='$(prefix)/etc/w3' + infodir='$(prefix)/info' + lispdir='$(prefix)/lisp/w3' +fi +AC_SUBST(EMACS_PACKAGE_DIR) +]) + +dnl +dnl Check whether a function exists in a library +dnl All '_' characters in the first argument are converted to '-' +dnl +AC_DEFUN(AC_EMACS_CHECK_LIB, [ +if test -z "$3"; then + AC_MSG_CHECKING(for $2 in $1) +fi +library=`echo $1 | tr _ -` +AC_EMACS_LISP($1,(progn (fmakunbound '$2) (condition-case nil (progn (require '$library) (fboundp '$2)) (error (prog1 nil (message \"$library not found\"))))),"noecho") +if test "${EMACS_cv_SYS_$1}" = "nil"; then + EMACS_cv_SYS_$1=no +fi +if test "${EMACS_cv_SYS_$1}" = "t"; then + EMACS_cv_SYS_$1=yes +fi +HAVE_$1=${EMACS_cv_SYS_$1} +AC_SUBST(HAVE_$1) +if test -z "$3"; then + AC_MSG_RESULT($HAVE_$1) +fi +]) + +dnl +dnl Check whether a variable exists in a library +dnl All '_' characters in the first argument are converted to '-' +dnl +AC_DEFUN(AC_EMACS_CHECK_VAR, [ +AC_MSG_CHECKING(for $2 in $1) +library=`echo $1 | tr _ -` +AC_EMACS_LISP($1,(progn (makunbound '$2) (condition-case nil (progn (require '$library) (boundp '$2)) (error nil))),"noecho") +if test "${EMACS_cv_SYS_$1}" = "nil"; then + EMACS_cv_SYS_$1=no +fi +HAVE_$1=${EMACS_cv_SYS_$1} +AC_SUBST(HAVE_$1) +AC_MSG_RESULT($HAVE_$1) +]) + +dnl +dnl Perform sanity checking and try to locate the custom and widget packages +dnl +AC_DEFUN(AC_CHECK_CUSTOM, [ +AC_MSG_CHECKING(for acceptable custom library) +AC_CACHE_VAL(EMACS_cv_ACCEPTABLE_CUSTOM,[ +AC_EMACS_CHECK_LIB(widget,widget-convert-text,"noecho") +AC_EMACS_CHECK_LIB(wid_edit,widget-convert-text,"noecho") +if test "${HAVE_widget}" = "yes"; then + EMACS_cv_ACCEPTABLE_CUSTOM=yes +else + if test "${HAVE_wid_edit}" != "no"; then + EMACS_cv_ACCEPTABLE_CUSTOM=yes + else + EMACS_cv_ACCEPTABLE_CUSTOM=no + fi +fi +if test "${EMACS_cv_ACCEPTABLE_CUSTOM}" = "yes"; then + AC_EMACS_LISP(widget_dir,(file-name-directory (locate-library \"widget\")),"noecho") + EMACS_cv_ACCEPTABLE_CUSTOM=$EMACS_cv_SYS_widget_dir +fi +]) + AC_ARG_WITH(custom, --with-custom Specify where to find the custom package, [ EMACS_cv_ACCEPTABLE_CUSTOM=`( cd $withval && pwd || echo "$withval" ) 2> /dev/null` ]) + CUSTOM=${EMACS_cv_ACCEPTABLE_CUSTOM} + AC_SUBST(CUSTOM) + AC_MSG_RESULT("${CUSTOM}") +]) + + +# Do all the work for Automake. -*- Autoconf -*- + +# This macro actually does too much some checks are only needed if +# your package does certain things. But this isn't really a big deal. + +# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +# Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# serial 10 + +AC_PREREQ([2.54]) + +# Autoconf 2.50 wants to disallow AM_ names. We explicitly allow +# the ones we care about. +m4_pattern_allow([^AM_[A-Z]+FLAGS$])dnl + +# AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE]) +# AM_INIT_AUTOMAKE([OPTIONS]) +# ----------------------------------------------- +# The call with PACKAGE and VERSION arguments is the old style +# call (pre autoconf-2.50), which is being phased out. PACKAGE +# and VERSION should now be passed to AC_INIT and removed from +# the call to AM_INIT_AUTOMAKE. +# We support both call styles for the transition. After +# the next Automake release, Autoconf can make the AC_INIT +# arguments mandatory, and then we can depend on a new Autoconf +# release and drop the old call support. +AC_DEFUN([AM_INIT_AUTOMAKE], +[AC_REQUIRE([AM_SET_CURRENT_AUTOMAKE_VERSION])dnl + AC_REQUIRE([AC_PROG_INSTALL])dnl +# test to see if srcdir already configured +if test "`cd $srcdir && pwd`" != "`pwd`" && + test -f $srcdir/config.status; then + AC_MSG_ERROR([source directory already configured; run "make distclean" there first]) +fi + +# test whether we have cygpath +if test -z "$CYGPATH_W"; then + if (cygpath --version) >/dev/null 2>/dev/null; then + CYGPATH_W='cygpath -w' + else + CYGPATH_W=echo + fi +fi +AC_SUBST([CYGPATH_W]) + +# Define the identity of the package. +dnl Distinguish between old-style and new-style calls. +m4_ifval([$2], +[m4_ifval([$3], [_AM_SET_OPTION([no-define])])dnl + AC_SUBST([PACKAGE], [$1])dnl + AC_SUBST([VERSION], [$2])], +[_AM_SET_OPTIONS([$1])dnl + AC_SUBST([PACKAGE], ['AC_PACKAGE_TARNAME'])dnl + AC_SUBST([VERSION], ['AC_PACKAGE_VERSION'])])dnl + +_AM_IF_OPTION([no-define],, +[AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE", [Name of package]) + AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package])])dnl + +# Some tools Automake needs. +AC_REQUIRE([AM_SANITY_CHECK])dnl +AC_REQUIRE([AC_ARG_PROGRAM])dnl +AM_MISSING_PROG(ACLOCAL, aclocal-${am__api_version}) +AM_MISSING_PROG(AUTOCONF, autoconf) +AM_MISSING_PROG(AUTOMAKE, automake-${am__api_version}) +AM_MISSING_PROG(AUTOHEADER, autoheader) +AM_MISSING_PROG(MAKEINFO, makeinfo) +AM_MISSING_PROG(AMTAR, tar) +AM_PROG_INSTALL_SH +AM_PROG_INSTALL_STRIP +# We need awk for the "check" target. The system "awk" is bad on +# some platforms. +AC_REQUIRE([AC_PROG_AWK])dnl +AC_REQUIRE([AC_PROG_MAKE_SET])dnl +AC_REQUIRE([AM_SET_LEADING_DOT])dnl + +_AM_IF_OPTION([no-dependencies],, +[AC_PROVIDE_IFELSE([AC_PROG_CC], + [_AM_DEPENDENCIES(CC)], + [define([AC_PROG_CC], + defn([AC_PROG_CC])[_AM_DEPENDENCIES(CC)])])dnl +AC_PROVIDE_IFELSE([AC_PROG_CXX], + [_AM_DEPENDENCIES(CXX)], + [define([AC_PROG_CXX], + defn([AC_PROG_CXX])[_AM_DEPENDENCIES(CXX)])])dnl +]) +]) + + +# When config.status generates a header, we must update the stamp-h file. +# This file resides in the same directory as the config header +# that is generated. The stamp files are numbered to have different names. + +# Autoconf calls _AC_AM_CONFIG_HEADER_HOOK (when defined) in the +# loop where config.status creates the headers, so we can generate +# our stamp files there. +AC_DEFUN([_AC_AM_CONFIG_HEADER_HOOK], +[# Compute $1's index in $config_headers. +_am_stamp_count=1 +for _am_header in $config_headers :; do + case $_am_header in + $1 | $1:* ) + break ;; + * ) + _am_stamp_count=`expr $_am_stamp_count + 1` ;; + esac +done +echo "timestamp for $1" >`AS_DIRNAME([$1])`/stamp-h[]$_am_stamp_count]) + +# Copyright 2002 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA + +# AM_AUTOMAKE_VERSION(VERSION) +# ---------------------------- +# Automake X.Y traces this macro to ensure aclocal.m4 has been +# generated from the m4 files accompanying Automake X.Y. +AC_DEFUN([AM_AUTOMAKE_VERSION],[am__api_version="1.7"]) + +# AM_SET_CURRENT_AUTOMAKE_VERSION +# ------------------------------- +# Call AM_AUTOMAKE_VERSION so it can be traced. +# This function is AC_REQUIREd by AC_INIT_AUTOMAKE. +AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION], + [AM_AUTOMAKE_VERSION([1.7.9])]) + +# Helper functions for option handling. -*- Autoconf -*- + +# Copyright 2001, 2002 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# serial 2 + +# _AM_MANGLE_OPTION(NAME) +# ----------------------- +AC_DEFUN([_AM_MANGLE_OPTION], +[[_AM_OPTION_]m4_bpatsubst($1, [[^a-zA-Z0-9_]], [_])]) + +# _AM_SET_OPTION(NAME) +# ------------------------------ +# Set option NAME. Presently that only means defining a flag for this option. +AC_DEFUN([_AM_SET_OPTION], +[m4_define(_AM_MANGLE_OPTION([$1]), 1)]) + +# _AM_SET_OPTIONS(OPTIONS) +# ---------------------------------- +# OPTIONS is a space-separated list of Automake options. +AC_DEFUN([_AM_SET_OPTIONS], +[AC_FOREACH([_AM_Option], [$1], [_AM_SET_OPTION(_AM_Option)])]) + +# _AM_IF_OPTION(OPTION, IF-SET, [IF-NOT-SET]) +# ------------------------------------------- +# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise. +AC_DEFUN([_AM_IF_OPTION], +[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])]) + +# +# Check to make sure that the build environment is sane. +# + +# Copyright 1996, 1997, 2000, 2001 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# serial 3 + +# AM_SANITY_CHECK +# --------------- +AC_DEFUN([AM_SANITY_CHECK], +[AC_MSG_CHECKING([whether build environment is sane]) +# Just in case +sleep 1 +echo timestamp > conftest.file +# Do `set' in a subshell so we don't clobber the current shell's +# arguments. Must try -L first in case configure is actually a +# symlink; some systems play weird games with the mod time of symlinks +# (eg FreeBSD returns the mod time of the symlink's containing +# directory). +if ( + set X `ls -Lt $srcdir/configure conftest.file 2> /dev/null` + if test "$[*]" = "X"; then + # -L didn't work. + set X `ls -t $srcdir/configure conftest.file` + fi + rm -f conftest.file + if test "$[*]" != "X $srcdir/configure conftest.file" \ + && test "$[*]" != "X conftest.file $srcdir/configure"; then + + # If neither matched, then we have a broken ls. This can happen + # if, for instance, CONFIG_SHELL is bash and it inherits a + # broken ls alias from the environment. This has actually + # happened. Such a system could not be considered "sane". + AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken +alias in your environment]) + fi + + test "$[2]" = conftest.file + ) +then + # Ok. + : +else + AC_MSG_ERROR([newly created file is older than distributed files! +Check your system clock]) +fi +AC_MSG_RESULT(yes)]) + +# -*- Autoconf -*- + + +# Copyright 1997, 1999, 2000, 2001 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# serial 3 + +# AM_MISSING_PROG(NAME, PROGRAM) +# ------------------------------ +AC_DEFUN([AM_MISSING_PROG], +[AC_REQUIRE([AM_MISSING_HAS_RUN]) +$1=${$1-"${am_missing_run}$2"} +AC_SUBST($1)]) + + +# AM_MISSING_HAS_RUN +# ------------------ +# Define MISSING if not defined so far and test if it supports --run. +# If it does, set am_missing_run to use it, otherwise, to nothing. +AC_DEFUN([AM_MISSING_HAS_RUN], +[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl +test x"${MISSING+set}" = xset || MISSING="\${SHELL} $am_aux_dir/missing" +# Use eval to expand $SHELL +if eval "$MISSING --run true"; then + am_missing_run="$MISSING --run " +else + am_missing_run= + AC_MSG_WARN([`missing' script is too old or missing]) +fi +]) + +# AM_AUX_DIR_EXPAND + +# Copyright 2001 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets +# $ac_aux_dir to `$srcdir/foo'. In other projects, it is set to +# `$srcdir', `$srcdir/..', or `$srcdir/../..'. +# +# Of course, Automake must honor this variable whenever it calls a +# tool from the auxiliary directory. The problem is that $srcdir (and +# therefore $ac_aux_dir as well) can be either absolute or relative, +# depending on how configure is run. This is pretty annoying, since +# it makes $ac_aux_dir quite unusable in subdirectories: in the top +# source directory, any form will work fine, but in subdirectories a +# relative path needs to be adjusted first. +# +# $ac_aux_dir/missing +# fails when called from a subdirectory if $ac_aux_dir is relative +# $top_srcdir/$ac_aux_dir/missing +# fails if $ac_aux_dir is absolute, +# fails when called from a subdirectory in a VPATH build with +# a relative $ac_aux_dir +# +# The reason of the latter failure is that $top_srcdir and $ac_aux_dir +# are both prefixed by $srcdir. In an in-source build this is usually +# harmless because $srcdir is `.', but things will broke when you +# start a VPATH build or use an absolute $srcdir. +# +# So we could use something similar to $top_srcdir/$ac_aux_dir/missing, +# iff we strip the leading $srcdir from $ac_aux_dir. That would be: +# am_aux_dir='\$(top_srcdir)/'`expr "$ac_aux_dir" : "$srcdir//*\(.*\)"` +# and then we would define $MISSING as +# MISSING="\${SHELL} $am_aux_dir/missing" +# This will work as long as MISSING is not called from configure, because +# unfortunately $(top_srcdir) has no meaning in configure. +# However there are other variables, like CC, which are often used in +# configure, and could therefore not use this "fixed" $ac_aux_dir. +# +# Another solution, used here, is to always expand $ac_aux_dir to an +# absolute PATH. The drawback is that using absolute paths prevent a +# configured tree to be moved without reconfiguration. + +# Rely on autoconf to set up CDPATH properly. +AC_PREREQ([2.50]) + +AC_DEFUN([AM_AUX_DIR_EXPAND], [ +# expand $ac_aux_dir to an absolute path +am_aux_dir=`cd $ac_aux_dir && pwd` +]) + +# AM_PROG_INSTALL_SH +# ------------------ +# Define $install_sh. + +# Copyright 2001 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +AC_DEFUN([AM_PROG_INSTALL_SH], +[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl +install_sh=${install_sh-"$am_aux_dir/install-sh"} +AC_SUBST(install_sh)]) + +# AM_PROG_INSTALL_STRIP + +# Copyright 2001 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# One issue with vendor `install' (even GNU) is that you can't +# specify the program used to strip binaries. This is especially +# annoying in cross-compiling environments, where the build's strip +# is unlikely to handle the host's binaries. +# Fortunately install-sh will honor a STRIPPROG variable, so we +# always use install-sh in `make install-strip', and initialize +# STRIPPROG with the value of the STRIP variable (set by the user). +AC_DEFUN([AM_PROG_INSTALL_STRIP], +[AC_REQUIRE([AM_PROG_INSTALL_SH])dnl +# Installed binaries are usually stripped using `strip' when the user +# run `make install-strip'. However `strip' might not be the right +# tool to use in cross-compilation environments, therefore Automake +# will honor the `STRIP' environment variable to overrule this program. +dnl Don't test for $cross_compiling = yes, because it might be `maybe'. +if test "$cross_compiling" != no; then + AC_CHECK_TOOL([STRIP], [strip], :) +fi +INSTALL_STRIP_PROGRAM="\${SHELL} \$(install_sh) -c -s" +AC_SUBST([INSTALL_STRIP_PROGRAM])]) + +# -*- Autoconf -*- +# Copyright (C) 2003 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# serial 1 + +# Check whether the underlying file-system supports filenames +# with a leading dot. For instance MS-DOS doesn't. +AC_DEFUN([AM_SET_LEADING_DOT], +[rm -rf .tst 2>/dev/null +mkdir .tst 2>/dev/null +if test -d .tst; then + am__leading_dot=. +else + am__leading_dot=_ +fi +rmdir .tst 2>/dev/null +AC_SUBST([am__leading_dot])]) + +# serial 5 -*- Autoconf -*- + +# Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + + +# There are a few dirty hacks below to avoid letting `AC_PROG_CC' be +# written in clear, in which case automake, when reading aclocal.m4, +# will think it sees a *use*, and therefore will trigger all it's +# C support machinery. Also note that it means that autoscan, seeing +# CC etc. in the Makefile, will ask for an AC_PROG_CC use... + + + +# _AM_DEPENDENCIES(NAME) +# ---------------------- +# See how the compiler implements dependency checking. +# NAME is "CC", "CXX", "GCJ", or "OBJC". +# We try a few techniques and use that to set a single cache variable. +# +# We don't AC_REQUIRE the corresponding AC_PROG_CC since the latter was +# modified to invoke _AM_DEPENDENCIES(CC); we would have a circular +# dependency, and given that the user is not expected to run this macro, +# just rely on AC_PROG_CC. +AC_DEFUN([_AM_DEPENDENCIES], +[AC_REQUIRE([AM_SET_DEPDIR])dnl +AC_REQUIRE([AM_OUTPUT_DEPENDENCY_COMMANDS])dnl +AC_REQUIRE([AM_MAKE_INCLUDE])dnl +AC_REQUIRE([AM_DEP_TRACK])dnl + +ifelse([$1], CC, [depcc="$CC" am_compiler_list=], + [$1], CXX, [depcc="$CXX" am_compiler_list=], + [$1], OBJC, [depcc="$OBJC" am_compiler_list='gcc3 gcc'], + [$1], GCJ, [depcc="$GCJ" am_compiler_list='gcc3 gcc'], + [depcc="$$1" am_compiler_list=]) + +AC_CACHE_CHECK([dependency style of $depcc], + [am_cv_$1_dependencies_compiler_type], +[if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named `D' -- because `-MD' means `put the output + # in D'. + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_$1_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n ['s/^#*\([a-zA-Z0-9]*\))$/\1/p'] < ./depcomp` + fi + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + : > sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + case $depmode in + nosideeffect) + # after this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + none) break ;; + esac + # We check with `-c' and `-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle `-M -o', and we need to detect this. + if depmode=$depmode \ + source=sub/conftest.c object=sub/conftest.${OBJEXT-o} \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c -o sub/conftest.${OBJEXT-o} sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftest.${OBJEXT-o} sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # (even with -Werror). So we grep stderr for any message + # that says an option was ignored. + if grep 'ignoring option' conftest.err >/dev/null 2>&1; then :; else + am_cv_$1_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_$1_dependencies_compiler_type=none +fi +]) +AC_SUBST([$1DEPMODE], [depmode=$am_cv_$1_dependencies_compiler_type]) +AM_CONDITIONAL([am__fastdep$1], [ + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_$1_dependencies_compiler_type" = gcc3]) +]) + + +# AM_SET_DEPDIR +# ------------- +# Choose a directory name for dependency files. +# This macro is AC_REQUIREd in _AM_DEPENDENCIES +AC_DEFUN([AM_SET_DEPDIR], +[AC_REQUIRE([AM_SET_LEADING_DOT])dnl +AC_SUBST([DEPDIR], ["${am__leading_dot}deps"])dnl +]) + + +# AM_DEP_TRACK +# ------------ +AC_DEFUN([AM_DEP_TRACK], +[AC_ARG_ENABLE(dependency-tracking, +[ --disable-dependency-tracking Speeds up one-time builds + --enable-dependency-tracking Do not reject slow dependency extractors]) +if test "x$enable_dependency_tracking" != xno; then + am_depcomp="$ac_aux_dir/depcomp" + AMDEPBACKSLASH='\' +fi +AM_CONDITIONAL([AMDEP], [test "x$enable_dependency_tracking" != xno]) +AC_SUBST([AMDEPBACKSLASH]) +]) + +# Generate code to set up dependency tracking. -*- Autoconf -*- + +# Copyright 1999, 2000, 2001, 2002 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +#serial 2 + +# _AM_OUTPUT_DEPENDENCY_COMMANDS +# ------------------------------ +AC_DEFUN([_AM_OUTPUT_DEPENDENCY_COMMANDS], +[for mf in $CONFIG_FILES; do + # Strip MF so we end up with the name of the file. + mf=`echo "$mf" | sed -e 's/:.*$//'` + # Check whether this is an Automake generated Makefile or not. + # We used to match only the files named `Makefile.in', but + # some people rename them; so instead we look at the file content. + # Grep'ing the first line is not enough: some people post-process + # each Makefile.in and add a new line on top of each file to say so. + # So let's grep whole file. + if grep '^#.*generated by automake' $mf > /dev/null 2>&1; then + dirpart=`AS_DIRNAME("$mf")` + else + continue + fi + grep '^DEP_FILES *= *[[^ @%:@]]' < "$mf" > /dev/null || continue + # Extract the definition of DEP_FILES from the Makefile without + # running `make'. + DEPDIR=`sed -n -e '/^DEPDIR = / s///p' < "$mf"` + test -z "$DEPDIR" && continue + # When using ansi2knr, U may be empty or an underscore; expand it + U=`sed -n -e '/^U = / s///p' < "$mf"` + test -d "$dirpart/$DEPDIR" || mkdir "$dirpart/$DEPDIR" + # We invoke sed twice because it is the simplest approach to + # changing $(DEPDIR) to its actual value in the expansion. + for file in `sed -n -e ' + /^DEP_FILES = .*\\\\$/ { + s/^DEP_FILES = // + :loop + s/\\\\$// + p + n + /\\\\$/ b loop + p + } + /^DEP_FILES = / s/^DEP_FILES = //p' < "$mf" | \ + sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g' -e 's/\$U/'"$U"'/g'`; do + # Make sure the directory exists. + test -f "$dirpart/$file" && continue + fdir=`AS_DIRNAME(["$file"])` + AS_MKDIR_P([$dirpart/$fdir]) + # echo "creating $dirpart/$file" + echo '# dummy' > "$dirpart/$file" + done +done +])# _AM_OUTPUT_DEPENDENCY_COMMANDS + + +# AM_OUTPUT_DEPENDENCY_COMMANDS +# ----------------------------- +# This macro should only be invoked once -- use via AC_REQUIRE. +# +# This code is only required when automatic dependency tracking +# is enabled. FIXME. This creates each `.P' file that we will +# need in order to bootstrap the dependency handling code. +AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS], +[AC_CONFIG_COMMANDS([depfiles], + [test x"$AMDEP_TRUE" != x"" || _AM_OUTPUT_DEPENDENCY_COMMANDS], + [AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"]) +]) + +# Check to see how 'make' treats includes. -*- Autoconf -*- + +# Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# serial 2 + +# AM_MAKE_INCLUDE() +# ----------------- +# Check to see how make treats includes. +AC_DEFUN([AM_MAKE_INCLUDE], +[am_make=${MAKE-make} +cat > confinc << 'END' +am__doit: + @echo done +.PHONY: am__doit +END +# If we don't find an include directive, just comment out the code. +AC_MSG_CHECKING([for style of include used by $am_make]) +am__include="#" +am__quote= +_am_result=none +# First try GNU make style include. +echo "include confinc" > confmf +# We grep out `Entering directory' and `Leaving directory' +# messages which can occur if `w' ends up in MAKEFLAGS. +# In particular we don't look at `^make:' because GNU make might +# be invoked under some other name (usually "gmake"), in which +# case it prints its new name instead of `make'. +if test "`$am_make -s -f confmf 2> /dev/null | grep -v 'ing directory'`" = "done"; then + am__include=include + am__quote= + _am_result=GNU +fi +# Now try BSD make style include. +if test "$am__include" = "#"; then + echo '.include "confinc"' > confmf + if test "`$am_make -s -f confmf 2> /dev/null`" = "done"; then + am__include=.include + am__quote="\"" + _am_result=BSD + fi +fi +AC_SUBST([am__include]) +AC_SUBST([am__quote]) +AC_MSG_RESULT([$_am_result]) +rm -f confinc confmf +]) + +# AM_CONDITIONAL -*- Autoconf -*- + +# Copyright 1997, 2000, 2001 Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# serial 5 + +AC_PREREQ(2.52) + +# AM_CONDITIONAL(NAME, SHELL-CONDITION) +# ------------------------------------- +# Define a conditional. +AC_DEFUN([AM_CONDITIONAL], +[ifelse([$1], [TRUE], [AC_FATAL([$0: invalid condition: $1])], + [$1], [FALSE], [AC_FATAL([$0: invalid condition: $1])])dnl +AC_SUBST([$1_TRUE]) +AC_SUBST([$1_FALSE]) +if $2; then + $1_TRUE= + $1_FALSE='#' +else + $1_TRUE='#' + $1_FALSE= +fi +AC_CONFIG_COMMANDS_PRE( +[if test -z "${$1_TRUE}" && test -z "${$1_FALSE}"; then + AC_MSG_ERROR([conditional "$1" was never defined. +Usually this means the macro was only invoked conditionally.]) +fi])]) + + +# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +# Free Software Foundation, Inc. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# serial 7 + +# AM_PATH_LISPDIR +# --------------- +AC_DEFUN([AM_PATH_LISPDIR], +[AC_ARG_WITH(lispdir, + [ --with-lispdir Override the default lisp directory ], + [ lispdir="$withval" + AC_MSG_CHECKING([where .elc files should go]) + AC_MSG_RESULT([$lispdir])], + [ + # If set to t, that means we are running in a shell under Emacs. + # If you have an Emacs named "t", then use the full path. + test x"$EMACS" = xt && EMACS= + AC_CHECK_PROGS(EMACS, emacs xemacs, no) + if test $EMACS != "no"; then + if test x${lispdir+set} != xset; then + AC_CACHE_CHECK([where .elc files should go], [am_cv_lispdir], + [# If $EMACS isn't GNU Emacs or XEmacs, this can blow up pretty badly + # Some emacsen will start up in interactive mode, requiring C-x C-c to exit, + # which is non-obvious for non-emacs users. + # Redirecting /dev/null should help a bit; pity we can't detect "broken" + # emacsen earlier and avoid running this altogether. + AC_RUN_LOG([$EMACS -batch -q -eval '(while load-path (princ (concat (car load-path) "\n")) (setq load-path (cdr load-path)))' conftest.out]) + am_cv_lispdir=`sed -n \ + -e 's,/$,,' \ + -e '/.*\/lib\/x\?emacs\/site-lisp$/{s,.*/lib/\(x\?emacs/site-lisp\)$,${libdir}/\1,;p;q;}' \ + -e '/.*\/share\/x\?emacs\/site-lisp$/{s,.*/share/\(x\?emacs/site-lisp\),${datadir}/\1,;p;q;}' \ + conftest.out` + rm conftest.out + if test -z "$am_cv_lispdir"; then + am_cv_lispdir='${datadir}/emacs/site-lisp' + fi + ]) + lispdir="$am_cv_lispdir" + fi + fi +]) +AC_SUBST(lispdir) +])# AM_PATH_LISPDIR + +AU_DEFUN([ud_PATH_LISPDIR], [AM_PATH_LISPDIR]) + diff --git a/mmm-mode-0.4.8/configure b/mmm-mode-0.4.8/configure new file mode 100644 index 0000000..b0b42b1 --- /dev/null +++ b/mmm-mode-0.4.8/configure @@ -0,0 +1,2751 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.59. +# +# Copyright (C) 2003 Free Software Foundation, Inc. +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi +DUALCASE=1; export DUALCASE # for MKS sh + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' + else + as_ln_s='ln -s' + fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_executable_p="test -f" + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + + +# Name of the host. +# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +exec 6>&1 + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_config_libobj_dir=. +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} + +# Maximum number of lines to put in a shell here document. +# This variable seems obsolete. It should probably be removed, and +# only ac_max_sed_lines should be used. +: ${ac_max_here_lines=38} + +# Identity of this package. +PACKAGE_NAME= +PACKAGE_TARNAME= +PACKAGE_VERSION= +PACKAGE_STRING= +PACKAGE_BUGREPORT= + +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO AMTAR install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM AWK SET_MAKE am__leading_dot EMACS lispdir EMACS_VERSION LIBOBJS LTLIBOBJS' +ac_subst_files='' + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datadir='${prefix}/share' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +libdir='${exec_prefix}/lib' +includedir='${prefix}/include' +oldincludedir='/usr/include' +infodir='${prefix}/info' +mandir='${prefix}/man' + +ac_prev= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval "$ac_prev=\$ac_option" + ac_prev= + continue + fi + + ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_option in + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad | --data | --dat | --da) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ + | --da=*) + datadir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + eval "enable_$ac_feature=no" ;; + + -enable-* | --enable-*) + ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; + *) ac_optarg=yes ;; + esac + eval "enable_$ac_feature='$ac_optarg'" ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst \ + | --locals | --local | --loca | --loc | --lo) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* \ + | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package| sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; + *) ac_optarg=yes ;; + esac + eval "with_$ac_package='$ac_optarg'" ;; + + -without-* | --without-*) + ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package | sed 's/-/_/g'` + eval "with_$ac_package=no" ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) { echo "$as_me: error: unrecognized option: $ac_option +Try \`$0 --help' for more information." >&2 + { (exit 1); exit 1; }; } + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 + { (exit 1); exit 1; }; } + ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` + eval "$ac_envvar='$ac_optarg'" + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + { echo "$as_me: error: missing argument to $ac_option" >&2 + { (exit 1); exit 1; }; } +fi + +# Be sure to have absolute paths. +for ac_var in exec_prefix prefix +do + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* | NONE | '' ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; + esac +done + +# Be sure to have absolute paths. +for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ + localstatedir libdir includedir oldincludedir infodir mandir +do + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; + esac +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used." >&2 + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then its parent. + ac_confdir=`(dirname "$0") 2>/dev/null || +$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$0" : 'X\(//\)[^/]' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$0" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r $srcdir/$ac_unique_file; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r $srcdir/$ac_unique_file; then + if test "$ac_srcdir_defaulted" = yes; then + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 + { (exit 1); exit 1; }; } + else + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { (exit 1); exit 1; }; } + fi +fi +(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || + { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 + { (exit 1); exit 1; }; } +srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` +ac_env_build_alias_set=${build_alias+set} +ac_env_build_alias_value=$build_alias +ac_cv_env_build_alias_set=${build_alias+set} +ac_cv_env_build_alias_value=$build_alias +ac_env_host_alias_set=${host_alias+set} +ac_env_host_alias_value=$host_alias +ac_cv_env_host_alias_set=${host_alias+set} +ac_cv_env_host_alias_value=$host_alias +ac_env_target_alias_set=${target_alias+set} +ac_env_target_alias_value=$target_alias +ac_cv_env_target_alias_set=${target_alias+set} +ac_cv_env_target_alias_value=$target_alias + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures this package to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +_ACEOF + + cat <<_ACEOF +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data [PREFIX/share] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --infodir=DIR info documentation [PREFIX/info] + --mandir=DIR man documentation [PREFIX/man] +_ACEOF + + cat <<\_ACEOF + +Program names: + --program-prefix=PREFIX prepend PREFIX to installed program names + --program-suffix=SUFFIX append SUFFIX to installed program names + --program-transform-name=PROGRAM run sed PROGRAM on installed program names +_ACEOF +fi + +if test -n "$ac_init_help"; then + + cat <<\_ACEOF + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) +--with-xemacs Use XEmacs to build +--with-emacs Use Emacs to build + --with-lispdir Override the default lisp directory + +_ACEOF +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + ac_popdir=`pwd` + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d $ac_dir || continue + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi + +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac + + cd $ac_dir + # Check for guested configure; otherwise get Cygnus style configure. + if test -f $ac_srcdir/configure.gnu; then + echo + $SHELL $ac_srcdir/configure.gnu --help=recursive + elif test -f $ac_srcdir/configure; then + echo + $SHELL $ac_srcdir/configure --help=recursive + elif test -f $ac_srcdir/configure.ac || + test -f $ac_srcdir/configure.in; then + echo + $ac_configure --help + else + echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi + cd "$ac_popdir" + done +fi + +test -n "$ac_init_help" && exit 0 +if $ac_init_version; then + cat <<\_ACEOF + +Copyright (C) 2003 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit 0 +fi +exec 5>config.log +cat >&5 <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by $as_me, which was +generated by GNU Autoconf 2.59. Invocation command line was + + $ $0 $@ + +_ACEOF +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +hostinfo = `(hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + echo "PATH: $as_dir" +done + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_sep= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; + 2) + ac_configure_args1="$ac_configure_args1 '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" + # Get rid of the leading space. + ac_sep=" " + ;; + esac + done +done +$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } +$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Be sure not to use single quotes in there, as some shells, +# such as our DU 5.0 friend, will then `close' the trap. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + cat <<\_ASBOX +## ---------------- ## +## Cache variables. ## +## ---------------- ## +_ASBOX + echo + # The following way of writing the cache mishandles newlines in values, +{ + (set) 2>&1 | + case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in + *ac_space=\ *) + sed -n \ + "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" + ;; + *) + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------- ## +## Output files. ## +## ------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + sed "/^$/d" confdefs.h | sort + echo + fi + test "$ac_signal" != 0 && + echo "$as_me: caught signal $ac_signal" + echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core && + rm -rf conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status + ' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo >confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer explicitly selected file to automatically selected ones. +if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi +fi +for ac_site_file in $CONFIG_SITE; do + if test -r "$ac_site_file"; then + { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 +echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special + # files actually), so we avoid doing that. + if test -f "$cache_file"; then + { echo "$as_me:$LINENO: loading cache $cache_file" >&5 +echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . $cache_file;; + *) . ./$cache_file;; + esac + fi +else + { echo "$as_me:$LINENO: creating cache $cache_file" >&5 +echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in `(set) 2>&1 | + sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val="\$ac_cv_env_${ac_var}_value" + eval ac_new_val="\$ac_env_${ac_var}_value" + case $ac_old_set,$ac_new_set in + set,) + { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 +echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 +echo "$as_me: former value: $ac_old_val" >&2;} + { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 +echo "$as_me: current value: $ac_new_val" >&2;} + ac_cache_corrupted=: + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 +echo "$as_me: error: changes in the environment can compromise the build" >&2;} + { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 +echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} + { (exit 1); exit 1; }; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + + + + + + + + + + + + + + + +am__api_version="1.7" +ac_aux_dir= +for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do + if test -f $ac_dir/install-sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f $ac_dir/install.sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f $ac_dir/shtool; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5 +echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;} + { (exit 1); exit 1; }; } +fi +ac_config_guess="$SHELL $ac_aux_dir/config.guess" +ac_config_sub="$SHELL $ac_aux_dir/config.sub" +ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure. + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 +echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6 +if test -z "$INSTALL"; then +if test "${ac_cv_path_install+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in + ./ | .// | /cC/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + done + done + ;; +esac +done + + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. We don't cache a + # path for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the path is relative. + INSTALL=$ac_install_sh + fi +fi +echo "$as_me:$LINENO: result: $INSTALL" >&5 +echo "${ECHO_T}$INSTALL" >&6 + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + +echo "$as_me:$LINENO: checking whether build environment is sane" >&5 +echo $ECHO_N "checking whether build environment is sane... $ECHO_C" >&6 +# Just in case +sleep 1 +echo timestamp > conftest.file +# Do `set' in a subshell so we don't clobber the current shell's +# arguments. Must try -L first in case configure is actually a +# symlink; some systems play weird games with the mod time of symlinks +# (eg FreeBSD returns the mod time of the symlink's containing +# directory). +if ( + set X `ls -Lt $srcdir/configure conftest.file 2> /dev/null` + if test "$*" = "X"; then + # -L didn't work. + set X `ls -t $srcdir/configure conftest.file` + fi + rm -f conftest.file + if test "$*" != "X $srcdir/configure conftest.file" \ + && test "$*" != "X conftest.file $srcdir/configure"; then + + # If neither matched, then we have a broken ls. This can happen + # if, for instance, CONFIG_SHELL is bash and it inherits a + # broken ls alias from the environment. This has actually + # happened. Such a system could not be considered "sane". + { { echo "$as_me:$LINENO: error: ls -t appears to fail. Make sure there is not a broken +alias in your environment" >&5 +echo "$as_me: error: ls -t appears to fail. Make sure there is not a broken +alias in your environment" >&2;} + { (exit 1); exit 1; }; } + fi + + test "$2" = conftest.file + ) +then + # Ok. + : +else + { { echo "$as_me:$LINENO: error: newly created file is older than distributed files! +Check your system clock" >&5 +echo "$as_me: error: newly created file is older than distributed files! +Check your system clock" >&2;} + { (exit 1); exit 1; }; } +fi +echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 +test "$program_prefix" != NONE && + program_transform_name="s,^,$program_prefix,;$program_transform_name" +# Use a double $ so make ignores it. +test "$program_suffix" != NONE && + program_transform_name="s,\$,$program_suffix,;$program_transform_name" +# Double any \ or $. echo might interpret backslashes. +# By default was `s,x,x', remove it if useless. +cat <<\_ACEOF >conftest.sed +s/[\\$]/&&/g;s/;s,x,x,$// +_ACEOF +program_transform_name=`echo $program_transform_name | sed -f conftest.sed` +rm conftest.sed + + +# expand $ac_aux_dir to an absolute path +am_aux_dir=`cd $ac_aux_dir && pwd` + +test x"${MISSING+set}" = xset || MISSING="\${SHELL} $am_aux_dir/missing" +# Use eval to expand $SHELL +if eval "$MISSING --run true"; then + am_missing_run="$MISSING --run " +else + am_missing_run= + { echo "$as_me:$LINENO: WARNING: \`missing' script is too old or missing" >&5 +echo "$as_me: WARNING: \`missing' script is too old or missing" >&2;} +fi + +for ac_prog in gawk mawk nawk awk +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_AWK+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$AWK"; then + ac_cv_prog_AWK="$AWK" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AWK="$ac_prog" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +AWK=$ac_cv_prog_AWK +if test -n "$AWK"; then + echo "$as_me:$LINENO: result: $AWK" >&5 +echo "${ECHO_T}$AWK" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + test -n "$AWK" && break +done + +echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 +set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'` +if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.make <<\_ACEOF +all: + @echo 'ac_maketemp="$(MAKE)"' +_ACEOF +# GNU make sometimes prints "make[1]: Entering...", which would confuse us. +eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` +if test -n "$ac_maketemp"; then + eval ac_cv_prog_make_${ac_make}_set=yes +else + eval ac_cv_prog_make_${ac_make}_set=no +fi +rm -f conftest.make +fi +if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + SET_MAKE= +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 + SET_MAKE="MAKE=${MAKE-make}" +fi + +rm -rf .tst 2>/dev/null +mkdir .tst 2>/dev/null +if test -d .tst; then + am__leading_dot=. +else + am__leading_dot=_ +fi +rmdir .tst 2>/dev/null + + # test to see if srcdir already configured +if test "`cd $srcdir && pwd`" != "`pwd`" && + test -f $srcdir/config.status; then + { { echo "$as_me:$LINENO: error: source directory already configured; run \"make distclean\" there first" >&5 +echo "$as_me: error: source directory already configured; run \"make distclean\" there first" >&2;} + { (exit 1); exit 1; }; } +fi + +# test whether we have cygpath +if test -z "$CYGPATH_W"; then + if (cygpath --version) >/dev/null 2>/dev/null; then + CYGPATH_W='cygpath -w' + else + CYGPATH_W=echo + fi +fi + + +# Define the identity of the package. + PACKAGE=mmm-mode + VERSION=0.4.8 + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE "$PACKAGE" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define VERSION "$VERSION" +_ACEOF + +# Some tools Automake needs. + +ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"} + + +AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"} + + +AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"} + + +AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"} + + +MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"} + + +AMTAR=${AMTAR-"${am_missing_run}tar"} + +install_sh=${install_sh-"$am_aux_dir/install-sh"} + +# Installed binaries are usually stripped using `strip' when the user +# run `make install-strip'. However `strip' might not be the right +# tool to use in cross-compilation environments, therefore Automake +# will honor the `STRIP' environment variable to overrule this program. +if test "$cross_compiling" != no; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. +set dummy ${ac_tool_prefix}strip; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_STRIP+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$STRIP"; then + ac_cv_prog_STRIP="$STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_STRIP="${ac_tool_prefix}strip" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +STRIP=$ac_cv_prog_STRIP +if test -n "$STRIP"; then + echo "$as_me:$LINENO: result: $STRIP" >&5 +echo "${ECHO_T}$STRIP" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + +fi +if test -z "$ac_cv_prog_STRIP"; then + ac_ct_STRIP=$STRIP + # Extract the first word of "strip", so it can be a program name with args. +set dummy strip; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_STRIP+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_STRIP"; then + ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_STRIP="strip" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + + test -z "$ac_cv_prog_ac_ct_STRIP" && ac_cv_prog_ac_ct_STRIP=":" +fi +fi +ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP +if test -n "$ac_ct_STRIP"; then + echo "$as_me:$LINENO: result: $ac_ct_STRIP" >&5 +echo "${ECHO_T}$ac_ct_STRIP" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + STRIP=$ac_ct_STRIP +else + STRIP="$ac_cv_prog_STRIP" +fi + +fi +INSTALL_STRIP_PROGRAM="\${SHELL} \$(install_sh) -c -s" + +# We need awk for the "check" target. The system "awk" is bad on +# some platforms. + + + + +if test "${EMACS}" = "t"; then + EMACS="" +fi + + +# Check whether --with-xemacs or --without-xemacs was given. +if test "${with_xemacs+set}" = set; then + withval="$with_xemacs" + if test "${withval}" = "yes"; then EMACS=xemacs; else EMACS=${withval}; fi +fi; + +# Check whether --with-emacs or --without-emacs was given. +if test "${with_emacs+set}" = set; then + withval="$with_emacs" + if test "${withval}" = "yes"; then EMACS=emacs; else EMACS=${withval}; fi +fi; + +# Extract the first word of "xemacs", so it can be a program name with args. +set dummy xemacs; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_EMACS+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$EMACS"; then + ac_cv_prog_EMACS="$EMACS" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_EMACS="xemacs" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + + test -z "$ac_cv_prog_EMACS" && ac_cv_prog_EMACS="emacs" +fi +fi +EMACS=$ac_cv_prog_EMACS +if test -n "$EMACS"; then + echo "$as_me:$LINENO: result: $EMACS" >&5 +echo "${ECHO_T}$EMACS" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + + +# Check whether --with-lispdir or --without-lispdir was given. +if test "${with_lispdir+set}" = set; then + withval="$with_lispdir" + lispdir="$withval" + echo "$as_me:$LINENO: checking where .elc files should go" >&5 +echo $ECHO_N "checking where .elc files should go... $ECHO_C" >&6 + echo "$as_me:$LINENO: result: $lispdir" >&5 +echo "${ECHO_T}$lispdir" >&6 +else + + # If set to t, that means we are running in a shell under Emacs. + # If you have an Emacs named "t", then use the full path. + test x"$EMACS" = xt && EMACS= + for ac_prog in emacs xemacs +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_EMACS+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$EMACS"; then + ac_cv_prog_EMACS="$EMACS" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_EMACS="$ac_prog" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +EMACS=$ac_cv_prog_EMACS +if test -n "$EMACS"; then + echo "$as_me:$LINENO: result: $EMACS" >&5 +echo "${ECHO_T}$EMACS" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + test -n "$EMACS" && break +done +test -n "$EMACS" || EMACS="no" + + if test $EMACS != "no"; then + if test x${lispdir+set} != xset; then + echo "$as_me:$LINENO: checking where .elc files should go" >&5 +echo $ECHO_N "checking where .elc files should go... $ECHO_C" >&6 +if test "${am_cv_lispdir+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + # If $EMACS isn't GNU Emacs or XEmacs, this can blow up pretty badly + # Some emacsen will start up in interactive mode, requiring C-x C-c to exit, + # which is non-obvious for non-emacs users. + # Redirecting /dev/null should help a bit; pity we can't detect "broken" + # emacsen earlier and avoid running this altogether. + { (echo "$as_me:$LINENO: \$EMACS -batch -q -eval '(while load-path (princ (concat (car load-path) \"\\n\")) (setq load-path (cdr load-path)))' conftest.out") >&5 + ($EMACS -batch -q -eval '(while load-path (princ (concat (car load-path) "\n")) (setq load-path (cdr load-path)))' conftest.out) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + am_cv_lispdir=`sed -n \ + -e 's,/$,,' \ + -e '/.*\/lib\/x\?emacs\/site-lisp$/{s,.*/lib/\(x\?emacs/site-lisp\)$,${libdir}/\1,;p;q;}' \ + -e '/.*\/share\/x\?emacs\/site-lisp$/{s,.*/share/\(x\?emacs/site-lisp\),${datadir}/\1,;p;q;}' \ + conftest.out` + rm conftest.out + if test -z "$am_cv_lispdir"; then + am_cv_lispdir='${datadir}/emacs/site-lisp' + fi + +fi +echo "$as_me:$LINENO: result: $am_cv_lispdir" >&5 +echo "${ECHO_T}$am_cv_lispdir" >&6 + lispdir="$am_cv_lispdir" + fi + fi + +fi; + + + + +echo "$as_me:$LINENO: checking for emacs version" >&5 +echo $ECHO_N "checking for emacs version... $ECHO_C" >&6 + +elisp="(and (boundp 'emacs-major-version) (format \"%d.%d\" emacs-major-version emacs-minor-version))" +if test -z ""noecho""; then + echo "$as_me:$LINENO: checking for version" >&5 +echo $ECHO_N "checking for version... $ECHO_C" >&6 +fi +if test "${EMACS_cv_SYS_version+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + OUTPUT=./conftest-$$ + echo ${EMACS} -batch -eval "(let ((x ${elisp})) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil \"${OUTPUT}\"))" >& 5 2>&1 + ${EMACS} -batch -eval "(let ((x ${elisp})) (write-region (if (stringp x) (princ x 'ignore) (prin1-to-string x)) nil \"${OUTPUT}\"nil 5))" >& 5 2>&1 + retval=`cat ${OUTPUT}` + echo "=> ${retval}" >& 5 2>&1 + rm -f ${OUTPUT} + EMACS_cv_SYS_version=$retval + +fi + +version=${EMACS_cv_SYS_version} +if test -z ""noecho""; then + echo "$as_me:$LINENO: result: $version" >&5 +echo "${ECHO_T}$version" >&6 +fi + + +EMACS_VERSION=${EMACS_cv_SYS_version} + +echo "$as_me:$LINENO: result: ${EMACS_VERSION}" >&5 +echo "${ECHO_T}${EMACS_VERSION}" >&6 + + + + + + + + + + + ac_config_files="$ac_config_files Makefile" +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, don't put newlines in cache variables' values. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +{ + (set) 2>&1 | + case `(ac_space=' '; set | grep ac_space) 2>&1` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} | + sed ' + t clear + : clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + : end' >>confcache +if diff $cache_file confcache >/dev/null 2>&1; then :; else + if test -w $cache_file; then + test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" + cat confcache >$cache_file + else + echo "not updating unwritable cache $cache_file" + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# VPATH may cause trouble with some makes, so we remove $(srcdir), +# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=/{ +s/:*\$(srcdir):*/:/; +s/:*\${srcdir}:*/:/; +s/:*@srcdir@:*/:/; +s/^\([^=]*=[ ]*\):*/\1/; +s/:*$//; +s/^[^=]*=[ ]*$//; +}' +fi + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then we branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +cat >confdef2opt.sed <<\_ACEOF +t clear +: clear +s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g +t quote +s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g +t quote +d +: quote +s,[ `~#$^&*(){}\\|;'"<>?],\\&,g +s,\[,\\&,g +s,\],\\&,g +s,\$,$$,g +p +_ACEOF +# We use echo to avoid assuming a particular line-breaking character. +# The extra dot is to prevent the shell from consuming trailing +# line-breaks from the sub-command output. A line-break within +# single-quotes doesn't work because, if this script is created in a +# platform that uses two characters for line-breaks (e.g., DOS), tr +# would break. +ac_LF_and_DOT=`echo; echo .` +DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` +rm -f confdef2opt.sed + + +ac_libobjs= +ac_ltlibobjs= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_i=`echo "$ac_i" | + sed 's/\$U\././;s/\.o$//;s/\.obj$//'` + # 2. Add them. + ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" + ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: ${CONFIG_STATUS=./config.status} +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 +echo "$as_me: creating $CONFIG_STATUS" >&6;} +cat >$CONFIG_STATUS <<_ACEOF +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false +SHELL=\${CONFIG_SHELL-$SHELL} +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi +DUALCASE=1; export DUALCASE # for MKS sh + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 +echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 +echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' + else + as_ln_s='ln -s' + fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_executable_p="test -f" + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + +exec 6>&1 + +# Open the log real soon, to keep \$[0] and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. Logging --version etc. is OK. +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX +} >&5 +cat >&5 <<_CSEOF + +This file was extended by $as_me, which was +generated by GNU Autoconf 2.59. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +_CSEOF +echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 +echo >&5 +_ACEOF + +# Files that config.status was made for. +if test -n "$ac_config_files"; then + echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_headers"; then + echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_links"; then + echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_commands"; then + echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS +fi + +cat >>$CONFIG_STATUS <<\_ACEOF + +ac_cs_usage="\ +\`$as_me' instantiates files from templates according to the +current configuration. + +Usage: $0 [OPTIONS] [FILE]... + + -h, --help print this help, then exit + -V, --version print version number, then exit + -q, --quiet do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to ." +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.59, + with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" + +Copyright (C) 2003 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." +srcdir=$srcdir +INSTALL="$INSTALL" +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +# If no file are specified by the user, then we need to provide default +# value. By we need to know if files were specified by the user. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=*) + ac_option=`expr "x$1" : 'x\([^=]*\)='` + ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` + ac_shift=: + ;; + -*) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + *) # This is not an option, so the user has probably given explicit + # arguments. + ac_option=$1 + ac_need_defaults=false;; + esac + + case $ac_option in + # Handling of the options. +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --vers* | -V ) + echo "$ac_cs_version"; exit 0 ;; + --he | --h) + # Conflict between --help and --header + { { echo "$as_me:$LINENO: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; };; + --help | --hel | -h ) + echo "$ac_cs_usage"; exit 0 ;; + --debug | --d* | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + CONFIG_FILES="$CONFIG_FILES $ac_optarg" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" + ac_need_defaults=false;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; } ;; + + *) ac_config_targets="$ac_config_targets $1" ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF +if \$ac_cs_recheck; then + echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 + exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion +fi + +_ACEOF + + + + + +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_config_target in $ac_config_targets +do + case "$ac_config_target" in + # Handling of arguments. + "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; + *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 +echo "$as_me: error: invalid argument: $ac_config_target" >&2;} + { (exit 1); exit 1; }; };; + esac +done + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason to put it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Create a temporary directory, and hook for its removal unless debugging. +$debug || +{ + trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 + trap '{ (exit 1); exit 1; }' 1 2 13 15 +} + +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./confstat$$-$RANDOM + (umask 077 && mkdir $tmp) +} || +{ + echo "$me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } +} + +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF + +# +# CONFIG_FILES section. +# + +# No need to generate the scripts if there are no CONFIG_FILES. +# This happens for instance when ./config.status config.h +if test -n "\$CONFIG_FILES"; then + # Protect against being on the right side of a sed subst in config.status. + sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; + s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF +s,@SHELL@,$SHELL,;t t +s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t +s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t +s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t +s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t +s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t +s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t +s,@exec_prefix@,$exec_prefix,;t t +s,@prefix@,$prefix,;t t +s,@program_transform_name@,$program_transform_name,;t t +s,@bindir@,$bindir,;t t +s,@sbindir@,$sbindir,;t t +s,@libexecdir@,$libexecdir,;t t +s,@datadir@,$datadir,;t t +s,@sysconfdir@,$sysconfdir,;t t +s,@sharedstatedir@,$sharedstatedir,;t t +s,@localstatedir@,$localstatedir,;t t +s,@libdir@,$libdir,;t t +s,@includedir@,$includedir,;t t +s,@oldincludedir@,$oldincludedir,;t t +s,@infodir@,$infodir,;t t +s,@mandir@,$mandir,;t t +s,@build_alias@,$build_alias,;t t +s,@host_alias@,$host_alias,;t t +s,@target_alias@,$target_alias,;t t +s,@DEFS@,$DEFS,;t t +s,@ECHO_C@,$ECHO_C,;t t +s,@ECHO_N@,$ECHO_N,;t t +s,@ECHO_T@,$ECHO_T,;t t +s,@LIBS@,$LIBS,;t t +s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t +s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t +s,@INSTALL_DATA@,$INSTALL_DATA,;t t +s,@CYGPATH_W@,$CYGPATH_W,;t t +s,@PACKAGE@,$PACKAGE,;t t +s,@VERSION@,$VERSION,;t t +s,@ACLOCAL@,$ACLOCAL,;t t +s,@AUTOCONF@,$AUTOCONF,;t t +s,@AUTOMAKE@,$AUTOMAKE,;t t +s,@AUTOHEADER@,$AUTOHEADER,;t t +s,@MAKEINFO@,$MAKEINFO,;t t +s,@AMTAR@,$AMTAR,;t t +s,@install_sh@,$install_sh,;t t +s,@STRIP@,$STRIP,;t t +s,@ac_ct_STRIP@,$ac_ct_STRIP,;t t +s,@INSTALL_STRIP_PROGRAM@,$INSTALL_STRIP_PROGRAM,;t t +s,@AWK@,$AWK,;t t +s,@SET_MAKE@,$SET_MAKE,;t t +s,@am__leading_dot@,$am__leading_dot,;t t +s,@EMACS@,$EMACS,;t t +s,@lispdir@,$lispdir,;t t +s,@EMACS_VERSION@,$EMACS_VERSION,;t t +s,@LIBOBJS@,$LIBOBJS,;t t +s,@LTLIBOBJS@,$LTLIBOBJS,;t t +CEOF + +_ACEOF + + cat >>$CONFIG_STATUS <<\_ACEOF + # Split the substitutions into bite-sized pieces for seds with + # small command number limits, like on Digital OSF/1 and HP-UX. + ac_max_sed_lines=48 + ac_sed_frag=1 # Number of current file. + ac_beg=1 # First line for current file. + ac_end=$ac_max_sed_lines # Line after last line for current file. + ac_more_lines=: + ac_sed_cmds= + while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + else + sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + fi + if test ! -s $tmp/subs.frag; then + ac_more_lines=false + else + # The purpose of the label and of the branching condition is to + # speed up the sed processing (if there are no `@' at all, there + # is no need to browse any of the substitutions). + # These are the two extra sed commands mentioned above. + (echo ':t + /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" + else + ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" + fi + ac_sed_frag=`expr $ac_sed_frag + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_lines` + fi + done + if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat + fi +fi # test -n "$CONFIG_FILES" + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case $ac_file in + - | *:- | *:-:* ) # input from stdin + cat >$tmp/stdin + ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + * ) ac_file_in=$ac_file.in ;; + esac + + # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. + ac_dir=`(dirname "$ac_file") 2>/dev/null || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + { if $as_mkdir_p; then + mkdir -p "$ac_dir" + else + as_dir="$ac_dir" + as_dirs= + while test ! -d "$as_dir"; do + as_dirs="$as_dir $as_dirs" + as_dir=`(dirname "$as_dir") 2>/dev/null || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + done + test ! -n "$as_dirs" || mkdir $as_dirs + fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 +echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} + { (exit 1); exit 1; }; }; } + + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi + +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac + + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_builddir$INSTALL ;; + esac + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + if test x"$ac_file" = x-; then + configure_input= + else + configure_input="$ac_file. " + fi + configure_input=$configure_input"Generated from `echo $ac_file_in | + sed 's,.*/,,'` by configure." + + # First look for the input files in the build tree, otherwise in the + # src tree. + ac_file_inputs=`IFS=: + for f in $ac_file_in; do + case $f in + -) echo $tmp/stdin ;; + [\\/$]*) + # Absolute (can't be DOS-style, as IFS=:) + test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + echo "$f";; + *) # Relative + if test -f "$f"; then + # Build tree + echo "$f" + elif test -f "$srcdir/$f"; then + # Source tree + echo "$srcdir/$f" + else + # /dev/null tree + { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + fi;; + esac + done` || { (exit 1); exit 1; } + + if test x"$ac_file" != x-; then + { echo "$as_me:$LINENO: creating $ac_file" >&5 +echo "$as_me: creating $ac_file" >&6;} + rm -f "$ac_file" + fi +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF + sed "$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s,@configure_input@,$configure_input,;t t +s,@srcdir@,$ac_srcdir,;t t +s,@abs_srcdir@,$ac_abs_srcdir,;t t +s,@top_srcdir@,$ac_top_srcdir,;t t +s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t +s,@builddir@,$ac_builddir,;t t +s,@abs_builddir@,$ac_abs_builddir,;t t +s,@top_builddir@,$ac_top_builddir,;t t +s,@abs_top_builddir@,$ac_abs_top_builddir,;t t +s,@INSTALL@,$ac_INSTALL,;t t +" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out + rm -f $tmp/stdin + if test x"$ac_file" != x-; then + mv $tmp/out $ac_file + else + cat $tmp/out + rm -f $tmp/out + fi + +done +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF + +{ (exit 0); exit 0; } +_ACEOF +chmod +x $CONFIG_STATUS +ac_clean_files=$ac_clean_files_save + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || { (exit 1); exit 1; } +fi + diff --git a/mmm-mode-0.4.8/configure.in b/mmm-mode-0.4.8/configure.in new file mode 100644 index 0000000..9663648 --- /dev/null +++ b/mmm-mode-0.4.8/configure.in @@ -0,0 +1,36 @@ +dnl Process this file with autoconf to produce a configure script. +AC_INIT() + +AM_INIT_AUTOMAKE(mmm-mode, 0.4.8) + +dnl +dnl Apparently, if you run a shell window in Emacs, it sets the EMACS +dnl environment variable to 't'. Lets undo the damage. +dnl +if test "${EMACS}" = "t"; then + EMACS="" +fi + +AC_ARG_WITH(xemacs, --with-xemacs Use XEmacs to build, [ if test "${withval}" = "yes"; then EMACS=xemacs; else EMACS=${withval}; fi ]) +AC_ARG_WITH(emacs, --with-emacs Use Emacs to build, [ if test "${withval}" = "yes"; then EMACS=emacs; else EMACS=${withval}; fi ]) + +AC_CHECK_PROG(EMACS, xemacs, xemacs, emacs) + +AM_PATH_LISPDIR + +AC_EMACS_VERSION + + +dnl Checks for programs. + +dnl Checks for libraries. + +dnl Checks for header files. + +dnl Checks for typedefs, structures, and compiler characteristics. + +dnl Checks for library functions. + +AC_SUBST(EMACS) + +AC_OUTPUT(Makefile) diff --git a/mmm-mode-0.4.8/elisp-comp b/mmm-mode-0.4.8/elisp-comp new file mode 100644 index 0000000..76f5d60 --- /dev/null +++ b/mmm-mode-0.4.8/elisp-comp @@ -0,0 +1,55 @@ +#!/bin/sh +# Copyright (C) 1995 Free Software Foundation, Inc. +# François Pinard , 1995. +# +# This program 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 2, or (at your option) +# any later version. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# This script byte-compiles all `.el' files which are part of its +# arguments, using GNU Emacs, and put the resulting `.elc' files into +# the current directory, so disregarding the original directories used +# in `.el' arguments. +# +# This script manages in such a way that all Emacs LISP files to +# be compiled are made visible between themselves, in the event +# they require or load-library one another. + +# This script was modified by Michael Abraham Shulman +# not to create a temporary directory, so +# that elisp files not given on the command line at the same time, +# the way Automake *actually* uses this script, can load each other. + +if test $# = 0; then + echo 1>&2 "No files given to $0" + exit 1 +else + if test -z "$EMACS" || test "$EMACS" = "t"; then + # Value of "t" means we are running in a shell under Emacs. + # Just assume Emacs is called "emacs". + EMACS=emacs + fi + +# tempdir=elc.$$ +# mkdir $tempdir +# cp $* $tempdir +# cd $tempdir + +# echo "elisp-comp called on $*" + echo "(setq load-path (cons nil load-path))" > script + $EMACS -q -batch -l script -f batch-byte-compile $* +# mv *.elc .. + +# cd .. +# rm -fr $tempdir +fi diff --git a/mmm-mode-0.4.8/install-sh b/mmm-mode-0.4.8/install-sh new file mode 100644 index 0000000..e9de238 --- /dev/null +++ b/mmm-mode-0.4.8/install-sh @@ -0,0 +1,251 @@ +#!/bin/sh +# +# install - install a program, script, or datafile +# This comes from X11R5 (mit/util/scripts/install.sh). +# +# Copyright 1991 by the Massachusetts Institute of Technology +# +# Permission to use, copy, modify, distribute, and sell this software and its +# documentation for any purpose is hereby granted without fee, provided that +# the above copyright notice appear in all copies and that both that +# copyright notice and this permission notice appear in supporting +# documentation, and that the name of M.I.T. not be used in advertising or +# publicity pertaining to distribution of the software without specific, +# written prior permission. M.I.T. makes no representations about the +# suitability of this software for any purpose. It is provided "as is" +# without express or implied warranty. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# `make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. It can only install one file at a time, a restriction +# shared with many OS's install programs. + + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit="${DOITPROG-}" + + +# put in absolute paths if you don't have them in your path; or use env. vars. + +mvprog="${MVPROG-mv}" +cpprog="${CPPROG-cp}" +chmodprog="${CHMODPROG-chmod}" +chownprog="${CHOWNPROG-chown}" +chgrpprog="${CHGRPPROG-chgrp}" +stripprog="${STRIPPROG-strip}" +rmprog="${RMPROG-rm}" +mkdirprog="${MKDIRPROG-mkdir}" + +transformbasename="" +transform_arg="" +instcmd="$mvprog" +chmodcmd="$chmodprog 0755" +chowncmd="" +chgrpcmd="" +stripcmd="" +rmcmd="$rmprog -f" +mvcmd="$mvprog" +src="" +dst="" +dir_arg="" + +while [ x"$1" != x ]; do + case $1 in + -c) instcmd="$cpprog" + shift + continue;; + + -d) dir_arg=true + shift + continue;; + + -m) chmodcmd="$chmodprog $2" + shift + shift + continue;; + + -o) chowncmd="$chownprog $2" + shift + shift + continue;; + + -g) chgrpcmd="$chgrpprog $2" + shift + shift + continue;; + + -s) stripcmd="$stripprog" + shift + continue;; + + -t=*) transformarg=`echo $1 | sed 's/-t=//'` + shift + continue;; + + -b=*) transformbasename=`echo $1 | sed 's/-b=//'` + shift + continue;; + + *) if [ x"$src" = x ] + then + src=$1 + else + # this colon is to work around a 386BSD /bin/sh bug + : + dst=$1 + fi + shift + continue;; + esac +done + +if [ x"$src" = x ] +then + echo "install: no input file specified" + exit 1 +else + true +fi + +if [ x"$dir_arg" != x ]; then + dst=$src + src="" + + if [ -d $dst ]; then + instcmd=: + chmodcmd="" + else + instcmd=mkdir + fi +else + +# Waiting for this to be detected by the "$instcmd $src $dsttmp" command +# might cause directories to be created, which would be especially bad +# if $src (and thus $dsttmp) contains '*'. + + if [ -f $src -o -d $src ] + then + true + else + echo "install: $src does not exist" + exit 1 + fi + + if [ x"$dst" = x ] + then + echo "install: no destination specified" + exit 1 + else + true + fi + +# If destination is a directory, append the input filename; if your system +# does not like double slashes in filenames, you may need to add some logic + + if [ -d $dst ] + then + dst="$dst"/`basename $src` + else + true + fi +fi + +## this sed command emulates the dirname command +dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` + +# Make sure that the destination directory exists. +# this part is taken from Noah Friedman's mkinstalldirs script + +# Skip lots of stat calls in the usual case. +if [ ! -d "$dstdir" ]; then +defaultIFS=' +' +IFS="${IFS-${defaultIFS}}" + +oIFS="${IFS}" +# Some sh's can't handle IFS=/ for some reason. +IFS='%' +set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` +IFS="${oIFS}" + +pathcomp='' + +while [ $# -ne 0 ] ; do + pathcomp="${pathcomp}${1}" + shift + + if [ ! -d "${pathcomp}" ] ; + then + $mkdirprog "${pathcomp}" + else + true + fi + + pathcomp="${pathcomp}/" +done +fi + +if [ x"$dir_arg" != x ] +then + $doit $instcmd $dst && + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi +else + +# If we're going to rename the final executable, determine the name now. + + if [ x"$transformarg" = x ] + then + dstfile=`basename $dst` + else + dstfile=`basename $dst $transformbasename | + sed $transformarg`$transformbasename + fi + +# don't allow the sed command to completely eliminate the filename + + if [ x"$dstfile" = x ] + then + dstfile=`basename $dst` + else + true + fi + +# Make a temp file name in the proper directory. + + dsttmp=$dstdir/#inst.$$# + +# Move or copy the file name to the temp name + + $doit $instcmd $src $dsttmp && + + trap "rm -f ${dsttmp}" 0 && + +# and set any options; do chmod last to preserve setuid bits + +# If any of these fail, we abort the whole thing. If we want to +# ignore errors from any of these, just make sure not to ignore +# errors from the above "$doit $instcmd $src $dsttmp" command. + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && + +# Now rename the file to the real destination. + + $doit $rmcmd -f $dstdir/$dstfile && + $doit $mvcmd $dsttmp $dstdir/$dstfile + +fi && + + +exit 0 diff --git a/mmm-mode-0.4.8/mdate-sh b/mmm-mode-0.4.8/mdate-sh new file mode 100644 index 0000000..37171f2 --- /dev/null +++ b/mmm-mode-0.4.8/mdate-sh @@ -0,0 +1,92 @@ +#!/bin/sh +# Get modification time of a file or directory and pretty-print it. +# Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. +# written by Ulrich Drepper , June 1995 +# +# This program 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 2, or (at your option) +# any later version. +# +# This program 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 this program; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# Prevent date giving response in another language. +LANG=C +export LANG +LC_ALL=C +export LC_ALL +LC_TIME=C +export LC_TIME + +# Get the extended ls output of the file or directory. +# On HPUX /bin/sh, "set" interprets "-rw-r--r--" as options, so the "x" below. +if ls -L /dev/null 1>/dev/null 2>&1; then + set - x`ls -L -l -d $1` +else + set - x`ls -l -d $1` +fi +# The month is at least the fourth argument +# (3 shifts here, the next inside the loop). +shift +shift +shift + +# Find the month. Next argument is day, followed by the year or time. +month= +until test $month +do + shift + case $1 in + Jan) month=January; nummonth=1;; + Feb) month=February; nummonth=2;; + Mar) month=March; nummonth=3;; + Apr) month=April; nummonth=4;; + May) month=May; nummonth=5;; + Jun) month=June; nummonth=6;; + Jul) month=July; nummonth=7;; + Aug) month=August; nummonth=8;; + Sep) month=September; nummonth=9;; + Oct) month=October; nummonth=10;; + Nov) month=November; nummonth=11;; + Dec) month=December; nummonth=12;; + esac +done + +day=$2 + +# Here we have to deal with the problem that the ls output gives either +# the time of day or the year. +case $3 in + *:*) set `date`; eval year=\$$# + case $2 in + Jan) nummonthtod=1;; + Feb) nummonthtod=2;; + Mar) nummonthtod=3;; + Apr) nummonthtod=4;; + May) nummonthtod=5;; + Jun) nummonthtod=6;; + Jul) nummonthtod=7;; + Aug) nummonthtod=8;; + Sep) nummonthtod=9;; + Oct) nummonthtod=10;; + Nov) nummonthtod=11;; + Dec) nummonthtod=12;; + esac + # For the first six month of the year the time notation can also + # be used for files modified in the last year. + if (expr $nummonth \> $nummonthtod) > /dev/null; + then + year=`expr $year - 1` + fi;; + *) year=$3;; +esac + +# The result. +echo $day $month $year diff --git a/mmm-mode-0.4.8/missing b/mmm-mode-0.4.8/missing new file mode 100644 index 0000000..fc54c64 --- /dev/null +++ b/mmm-mode-0.4.8/missing @@ -0,0 +1,336 @@ +#! /bin/sh +# Common stub for a few missing GNU programs while installing. +# Copyright (C) 1996, 1997, 1999, 2000, 2002, 2003 Free Software Foundation, Inc. +# Originally by Fran,cois Pinard , 1996. + +# This program 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 2, or (at your option) +# any later version. + +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + +if test $# -eq 0; then + echo 1>&2 "Try \`$0 --help' for more information" + exit 1 +fi + +run=: + +# In the cases where this matters, `missing' is being run in the +# srcdir already. +if test -f configure.ac; then + configure_ac=configure.ac +else + configure_ac=configure.in +fi + +case "$1" in +--run) + # Try to run requested program, and just exit if it succeeds. + run= + shift + "$@" && exit 0 + ;; +esac + +# If it does not exist, or fails to run (possibly an outdated version), +# try to emulate it. +case "$1" in + + -h|--h|--he|--hel|--help) + echo "\ +$0 [OPTION]... PROGRAM [ARGUMENT]... + +Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an +error status if there is no known handling for PROGRAM. + +Options: + -h, --help display this help and exit + -v, --version output version information and exit + --run try to run the given command, and emulate it if it fails + +Supported PROGRAM values: + aclocal touch file \`aclocal.m4' + autoconf touch file \`configure' + autoheader touch file \`config.h.in' + automake touch all \`Makefile.in' files + bison create \`y.tab.[ch]', if possible, from existing .[ch] + flex create \`lex.yy.c', if possible, from existing .c + help2man touch the output file + lex create \`lex.yy.c', if possible, from existing .c + makeinfo touch the output file + tar try tar, gnutar, gtar, then tar without non-portable flags + yacc create \`y.tab.[ch]', if possible, from existing .[ch]" + ;; + + -v|--v|--ve|--ver|--vers|--versi|--versio|--version) + echo "missing 0.4 - GNU automake" + ;; + + -*) + echo 1>&2 "$0: Unknown \`$1' option" + echo 1>&2 "Try \`$0 --help' for more information" + exit 1 + ;; + + aclocal*) + if test -z "$run" && ($1 --version) > /dev/null 2>&1; then + # We have it, but it failed. + exit 1 + fi + + echo 1>&2 "\ +WARNING: \`$1' is missing on your system. You should only need it if + you modified \`acinclude.m4' or \`${configure_ac}'. You might want + to install the \`Automake' and \`Perl' packages. Grab them from + any GNU archive site." + touch aclocal.m4 + ;; + + autoconf) + if test -z "$run" && ($1 --version) > /dev/null 2>&1; then + # We have it, but it failed. + exit 1 + fi + + echo 1>&2 "\ +WARNING: \`$1' is missing on your system. You should only need it if + you modified \`${configure_ac}'. You might want to install the + \`Autoconf' and \`GNU m4' packages. Grab them from any GNU + archive site." + touch configure + ;; + + autoheader) + if test -z "$run" && ($1 --version) > /dev/null 2>&1; then + # We have it, but it failed. + exit 1 + fi + + echo 1>&2 "\ +WARNING: \`$1' is missing on your system. You should only need it if + you modified \`acconfig.h' or \`${configure_ac}'. You might want + to install the \`Autoconf' and \`GNU m4' packages. Grab them + from any GNU archive site." + files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' ${configure_ac}` + test -z "$files" && files="config.h" + touch_files= + for f in $files; do + case "$f" in + *:*) touch_files="$touch_files "`echo "$f" | + sed -e 's/^[^:]*://' -e 's/:.*//'`;; + *) touch_files="$touch_files $f.in";; + esac + done + touch $touch_files + ;; + + automake*) + if test -z "$run" && ($1 --version) > /dev/null 2>&1; then + # We have it, but it failed. + exit 1 + fi + + echo 1>&2 "\ +WARNING: \`$1' is missing on your system. You should only need it if + you modified \`Makefile.am', \`acinclude.m4' or \`${configure_ac}'. + You might want to install the \`Automake' and \`Perl' packages. + Grab them from any GNU archive site." + find . -type f -name Makefile.am -print | + sed 's/\.am$/.in/' | + while read f; do touch "$f"; done + ;; + + autom4te) + if test -z "$run" && ($1 --version) > /dev/null 2>&1; then + # We have it, but it failed. + exit 1 + fi + + echo 1>&2 "\ +WARNING: \`$1' is needed, and you do not seem to have it handy on your + system. You might have modified some files without having the + proper tools for further handling them. + You can get \`$1' as part of \`Autoconf' from any GNU + archive site." + + file=`echo "$*" | sed -n 's/.*--output[ =]*\([^ ]*\).*/\1/p'` + test -z "$file" && file=`echo "$*" | sed -n 's/.*-o[ ]*\([^ ]*\).*/\1/p'` + if test -f "$file"; then + touch $file + else + test -z "$file" || exec >$file + echo "#! /bin/sh" + echo "# Created by GNU Automake missing as a replacement of" + echo "# $ $@" + echo "exit 0" + chmod +x $file + exit 1 + fi + ;; + + bison|yacc) + echo 1>&2 "\ +WARNING: \`$1' is missing on your system. You should only need it if + you modified a \`.y' file. You may need the \`Bison' package + in order for those modifications to take effect. You can get + \`Bison' from any GNU archive site." + rm -f y.tab.c y.tab.h + if [ $# -ne 1 ]; then + eval LASTARG="\${$#}" + case "$LASTARG" in + *.y) + SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'` + if [ -f "$SRCFILE" ]; then + cp "$SRCFILE" y.tab.c + fi + SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'` + if [ -f "$SRCFILE" ]; then + cp "$SRCFILE" y.tab.h + fi + ;; + esac + fi + if [ ! -f y.tab.h ]; then + echo >y.tab.h + fi + if [ ! -f y.tab.c ]; then + echo 'main() { return 0; }' >y.tab.c + fi + ;; + + lex|flex) + echo 1>&2 "\ +WARNING: \`$1' is missing on your system. You should only need it if + you modified a \`.l' file. You may need the \`Flex' package + in order for those modifications to take effect. You can get + \`Flex' from any GNU archive site." + rm -f lex.yy.c + if [ $# -ne 1 ]; then + eval LASTARG="\${$#}" + case "$LASTARG" in + *.l) + SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'` + if [ -f "$SRCFILE" ]; then + cp "$SRCFILE" lex.yy.c + fi + ;; + esac + fi + if [ ! -f lex.yy.c ]; then + echo 'main() { return 0; }' >lex.yy.c + fi + ;; + + help2man) + if test -z "$run" && ($1 --version) > /dev/null 2>&1; then + # We have it, but it failed. + exit 1 + fi + + echo 1>&2 "\ +WARNING: \`$1' is missing on your system. You should only need it if + you modified a dependency of a manual page. You may need the + \`Help2man' package in order for those modifications to take + effect. You can get \`Help2man' from any GNU archive site." + + file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'` + if test -z "$file"; then + file=`echo "$*" | sed -n 's/.*--output=\([^ ]*\).*/\1/p'` + fi + if [ -f "$file" ]; then + touch $file + else + test -z "$file" || exec >$file + echo ".ab help2man is required to generate this page" + exit 1 + fi + ;; + + makeinfo) + if test -z "$run" && (makeinfo --version) > /dev/null 2>&1; then + # We have makeinfo, but it failed. + exit 1 + fi + + echo 1>&2 "\ +WARNING: \`$1' is missing on your system. You should only need it if + you modified a \`.texi' or \`.texinfo' file, or any other file + indirectly affecting the aspect of the manual. The spurious + call might also be the consequence of using a buggy \`make' (AIX, + DU, IRIX). You might want to install the \`Texinfo' package or + the \`GNU make' package. Grab either from any GNU archive site." + file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'` + if test -z "$file"; then + file=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'` + file=`sed -n '/^@setfilename/ { s/.* \([^ ]*\) *$/\1/; p; q; }' $file` + fi + touch $file + ;; + + tar) + shift + if test -n "$run"; then + echo 1>&2 "ERROR: \`tar' requires --run" + exit 1 + fi + + # We have already tried tar in the generic part. + # Look for gnutar/gtar before invocation to avoid ugly error + # messages. + if (gnutar --version > /dev/null 2>&1); then + gnutar "$@" && exit 0 + fi + if (gtar --version > /dev/null 2>&1); then + gtar "$@" && exit 0 + fi + firstarg="$1" + if shift; then + case "$firstarg" in + *o*) + firstarg=`echo "$firstarg" | sed s/o//` + tar "$firstarg" "$@" && exit 0 + ;; + esac + case "$firstarg" in + *h*) + firstarg=`echo "$firstarg" | sed s/h//` + tar "$firstarg" "$@" && exit 0 + ;; + esac + fi + + echo 1>&2 "\ +WARNING: I can't seem to be able to run \`tar' with the given arguments. + You may want to install GNU tar or Free paxutils, or check the + command line arguments." + exit 1 + ;; + + *) + echo 1>&2 "\ +WARNING: \`$1' is needed, and you do not seem to have it handy on your + system. You might have modified some files without having the + proper tools for further handling them. Check the \`README' file, + it often tells you about the needed prerequisites for installing + this package. You may also peek at any GNU archive site, in case + some other package would contain this missing \`$1' program." + exit 1 + ;; +esac + +exit 0 diff --git a/mmm-mode-0.4.8/mkinstalldirs b/mmm-mode-0.4.8/mkinstalldirs new file mode 100644 index 0000000..46487b4 --- /dev/null +++ b/mmm-mode-0.4.8/mkinstalldirs @@ -0,0 +1,40 @@ +#! /bin/sh +# mkinstalldirs --- make directory hierarchy +# Author: Noah Friedman +# Created: 1993-05-16 +# Public domain + +# $Id: mkinstalldirs,v 1.1 2000/05/28 08:55:55 mas Exp $ + +errstatus=0 + +for file +do + set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` + shift + + pathcomp= + for d + do + pathcomp="$pathcomp$d" + case "$pathcomp" in + -* ) pathcomp=./$pathcomp ;; + esac + + if test ! -d "$pathcomp"; then + echo "mkdir $pathcomp" + + mkdir "$pathcomp" || lasterr=$? + + if test ! -d "$pathcomp"; then + errstatus=$lasterr + fi + fi + + pathcomp="$pathcomp/" + done +done + +exit $errstatus + +# mkinstalldirs ends here diff --git a/mmm-mode-0.4.8/mmm-auto.el b/mmm-mode-0.4.8/mmm-auto.el new file mode 100644 index 0000000..8c8aa2c --- /dev/null +++ b/mmm-mode-0.4.8/mmm-auto.el @@ -0,0 +1,178 @@ +;;; mmm-auto.el --- loading and enabling MMM Mode automatically + +;; Copyright (C) 2000 by Michael Abraham Shulman + +;; Author: Michael Abraham Shulman +;; Version: $Id: mmm-auto.el,v 1.21 2003/03/25 21:49:26 viritrilbia Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file contains functions and hooks to load and enable MMM Mode +;; automatically. It sets up autoloads for the main MMM Mode functions +;; and interactive commands, and also sets up MMM Global Mode. + +;;{{{ Comments on MMM Global Mode + +;; This is a kludge borrowed from `global-font-lock-mode'. The idea +;; is the same: we have a function (here `mmm-mode-on-maybe') that we +;; want to be run whenever a major mode starts. Unfortunately, there +;; is no hook (like, say `major-mode-hook') that all major modes run +;; when they are finished. `post-command-hook', however, is run after +;; *every* command, so we do our work in there. (Actually, using +;; `post-command-hook' is even better than being run by major mode +;; functions, since it is run after all local variables and text are +;; loaded, which may not be true in certain cases for the other.) + +;; In order to do this magic, we rely on the fact that there *is* a +;; hook that all major modes run when *beginning* their work. They +;; call `kill-all-local-variables' (unless they are broken), which in +;; turn runs `change-major-mode-hook'. So we add a function to *that* +;; hook which saves the current buffer and temporarily adds a function +;; to `post-command-hook' which processes that buffer. + +;; Actually, in the interests of generality, what that function does +;; is run the hook `mmm-major-mode-hook'. Our desired function +;; `mmm-mode-on-maybe' is then added to that hook. This way, if the +;; user wants to run something else on every major mode, they can just +;; add it to `mmm-major-mode-hook' and take advantage of this hack. + +;;}}} + +;;; Code: + +(require 'cl) +(require 'mmm-vars) + +;;{{{ Autoload Submode Classes + +(defvar mmm-autoloaded-classes + '((mason "mmm-mason" nil) + (embedded-css "mmm-sample" nil) + (html-js "mmm-sample" nil) + (here-doc "mmm-sample" nil) + (embperl "mmm-sample" nil) + (eperl "mmm-sample" nil) + (jsp "mmm-sample" nil) + (file-variables "mmm-sample" nil) + (rpm-sh "mmm-rpm" t) + (rpm "mmm-rpm" nil) + (cweb "mmm-cweb" nil) + (sgml-dtd "mmm-sample" nil) + (noweb "mmm-noweb" nil) + (html-php "mmm-sample" nil) + ) + "Alist of submode classes autoloaded from files. +Elements look like \(CLASS FILE PRIVATE) where CLASS is a submode +class symbol, FILE is a string suitable for passing to `load', and +PRIVATE is non-nil if the class is invisible to the user. Classes can +be added to this list with `mmm-autoload-class'.") + +(defun mmm-autoload-class (class file &optional private) + "Autoload submode class CLASS from file FILE. +PRIVATE, if non-nil, means the class is user-invisible. In general, +private classes need not be autoloaded, since they will usually be +invoked by a public class in the same file." + ;; Don't autoload already defined classes + (unless (assq class mmm-classes-alist) + (add-to-list 'mmm-autoloaded-classes + (list class file private)))) + +;;}}} +;;{{{ Autoload Functions + +;; To shut up the byte compiler. +(eval-and-compile + (autoload 'mmm-mode-on "mmm-mode" "Turn on MMM Mode. See `mmm-mode'.") + (autoload 'mmm-mode-off "mmm-mode" "Turn off MMM Mode. See `mmm-mode'.") + (autoload 'mmm-update-font-lock-buffer "mmm-region") + (autoload 'mmm-ensure-fboundp "mmm-utils") + (autoload 'mmm-mode "mmm-mode" + "Minor mode to allow multiple major modes in one buffer. +Without ARG, toggle MMM Mode. With ARG, turn MMM Mode on iff ARG is +positive and off otherwise." t)) + +;; These may actually be used. +(autoload 'mmm-ify-by-class "mmm-cmds" "" t) +(autoload 'mmm-ify-by-regexp "mmm-cmds" "" t) +(autoload 'mmm-ify-region "mmm-cmds" "" t) +(autoload 'mmm-parse-buffer "mmm-cmds" "" t) +(autoload 'mmm-parse-region "mmm-cmds" "" t) +(autoload 'mmm-parse-block "mmm-cmds" "" t) +(autoload 'mmm-clear-current-region "mmm-cmds" "" t) +(autoload 'mmm-reparse-current-region "mmm-cmds" "" t) +(autoload 'mmm-end-current-region "mmm-cmds" "" t) +(autoload 'mmm-insertion-help "mmm-cmds" "" t) +(autoload 'mmm-insert-region "mmm-cmds" "" t) + +;;}}} +;;{{{ MMM Global Mode + +(defvar mmm-changed-buffers-list () + "Buffers that need to be checked for running the major mode hook.") + +(defun mmm-major-mode-change () + "Add this buffer to `mmm-changed-buffers-list' for checking. +When the current command is over, MMM Mode will be turned on in this +buffer depending on the value of `mmm-global-mode'. Actually, +everything in `mmm-major-mode-hook' will be run." + (and (boundp 'mmm-mode) + mmm-mode + (mmm-mode-off)) + (add-to-list 'mmm-changed-buffers-list (current-buffer)) + (add-hook 'post-command-hook 'mmm-check-changed-buffers)) + +(add-hook 'change-major-mode-hook 'mmm-major-mode-change) + +(defun mmm-check-changed-buffers () + "Run major mode hook for the buffers in `mmm-changed-buffers-list'." + (remove-hook 'post-command-hook 'mmm-check-changed-buffers) + (dolist (buffer mmm-changed-buffers-list) + (when (buffer-live-p buffer) + (save-excursion + (set-buffer buffer) + (mmm-run-major-mode-hook)))) + (setq mmm-changed-buffers-list '())) + +(defun mmm-mode-on-maybe () + "Conditionally turn on MMM Mode. +Turn on MMM Mode if `global-mmm-mode' is non-nil and there are classes +to apply, or always if `global-mmm-mode' is t." + (cond ((eq mmm-global-mode t) (mmm-mode-on)) + ((not mmm-global-mode)) + ((mmm-get-all-classes nil) (mmm-mode-on))) + (when mmm-mode + (mmm-update-font-lock-buffer))) + +(add-hook 'mmm-major-mode-hook 'mmm-mode-on-maybe) + +(defalias 'mmm-add-find-file-hooks 'mmm-add-find-file-hook) +(defun mmm-add-find-file-hook () + "Equivalent to \(setq mmm-global-mode 'maybe). +This function is deprecated and may be removed in future." + (message "Warning: `mmm-add-find-file-hook' is deprecated.") + (setq mmm-global-mode 'maybe)) + +;;}}} + +(provide 'mmm-auto) + +;;; mmm-auto.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-class.el b/mmm-mode-0.4.8/mmm-class.el new file mode 100644 index 0000000..9e51e79 --- /dev/null +++ b/mmm-mode-0.4.8/mmm-class.el @@ -0,0 +1,325 @@ +;;; mmm-class.el --- MMM submode class variables and functions + +;; Copyright (C) 2000, 2004 by Michael Abraham Shulman + +;; Author: Michael Abraham Shulman +;; Version: $Id: mmm-class.el,v 1.19 2004/06/11 00:31:07 alanshutko Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file contains variable and function definitions for +;; manipulating and applying MMM submode classes. See `mmm-vars.el' +;; for variables that list classes. + +;;; Code: + +(require 'cl) +(require 'mmm-vars) +(require 'mmm-region) + +;;; CLASS SPECIFICATIONS +;;{{{ Get Class Specifications + +(defun mmm-get-class-spec (class) + "Get the class specification for CLASS. +CLASS can be either a symbol to look up in `mmm-classes-alist' or a +class specifier itself." + (cond ((symbolp class) ; A symbol must be looked up + (or (cdr (assq class mmm-classes-alist)) + (and (cadr (assq class mmm-autoloaded-classes)) + (load (cadr (assq class mmm-autoloaded-classes))) + (cdr (assq class mmm-classes-alist))) + (signal 'mmm-invalid-submode-class (list class)))) + ((listp class) ; A list must be a class spec + class) + (t (signal 'mmm-invalid-submode-class (list class))))) + +;;}}} +;;{{{ Get and Set Class Parameters + +(defun mmm-get-class-parameter (class param) + "Get the value of the parameter PARAM for CLASS, or nil if none." + (cadr (member param (mmm-get-class-spec class)))) + +(defun mmm-set-class-parameter (class param value) + "Set the value of the parameter PARAM for CLASS to VALUE. +Creates a new parameter if one is not present." + (let* ((spec (mmm-get-class-spec class)) + (current (member param spec))) + (if current + (setcar (cdr current) value) + (nconc spec (list param value))))) + +;;}}} +;;{{{ Apply Classes + +(defun* mmm-apply-class + (class &optional (start (point-min)) (stop (point-max)) face) + "Apply the submode class CLASS from START to STOP in FACE. +If FACE is nil, the face for CLASS is used, or the default face if +none is specified by CLASS." + ;; The "special" class t means do nothing. It is used to turn on + ;; MMM Mode without applying any classes. + (unless (eq class t) + (apply #'mmm-ify :start start :stop stop + (append (mmm-get-class-spec class) + (list :face face))) + (mmm-run-class-hook class) + ;; Hack in case class hook sets mmm-buffer-mode-display-name etc. + (mmm-set-mode-line))) + +(defun* mmm-apply-classes + (classes &key (start (point-min)) (stop (point-max)) face) + "Apply all submode classes in CLASSES, in order. +All classes are applied regardless of any errors that may occur in +other classes. If any errors occur, `mmm-apply-classes' exits with an +error once all classes have been applied." + (let (invalid-classes) + (dolist (class classes) + (condition-case err + (mmm-apply-class class start stop face) + (mmm-invalid-submode-class + ;; Save the name of the invalid class, so we can report them + ;; all together at the end. + (add-to-list 'invalid-classes (second err))))) + (when invalid-classes + (signal 'mmm-invalid-submode-class invalid-classes)))) + +;;}}} +;;{{{ Apply All Classes + +(defun* mmm-apply-all (&key (start (point-min)) (stop (point-max))) + "MMM-ify from START to STOP by all submode classes. +The classes come from mode/ext, `mmm-classes', `mmm-global-classes', +and interactive history." + (mmm-clear-overlays start stop 'strict) + (mmm-apply-classes (mmm-get-all-classes t) :start start :stop stop) + (mmm-update-submode-region) + (mmm-refontify-maybe start stop)) + +;;}}} + +;;; BUFFER SCANNING +;;{{{ Scan for Regions + +(defun* mmm-ify + (&rest all &key classes handler + submode match-submode + (start (point-min)) (stop (point-max)) + front back save-matches (case-fold-search t) + (beg-sticky (not (number-or-marker-p front))) + (end-sticky (not (number-or-marker-p back))) + include-front include-back + (front-offset 0) (back-offset 0) + (front-delim nil) (back-delim nil) + (delimiter-mode mmm-delimiter-mode) + front-face back-face + front-verify back-verify + front-form back-form + creation-hook + face match-face + save-name match-name + (front-match 0) (back-match 0) + end-not-begin + ;insert private + &allow-other-keys + ) + "Create submode regions from START to STOP according to arguments. +If CLASSES is supplied, it must be a list of valid CLASSes. Otherwise, +the rest of the arguments are for an actual class being applied. See +`mmm-classes-alist' for information on what they all mean." + ;; Make sure we get the default values in the `all' list. + (setq all (append + all + (list :start start :stop stop + :beg-sticky beg-sticky :end-sticky end-sticky + :front-offset front-offset :back-offset back-offset + :front-delim front-delim :back-delim back-delim + :front-match 0 :back-match 0 + ))) + (cond + ;; If we have a class list, apply them all. + (classes + (mmm-apply-classes classes :start start :stop stop :face face)) + ;; Otherwise, apply this class. + ;; If we have a handler, call it. + (handler + (apply handler all)) + ;; Otherwise, we search from START to STOP for submode regions, + ;; continuining over errors, until we don't find any more. If FRONT + ;; and BACK are number-or-markers, this should only execute once. + (t + (mmm-save-all + (goto-char start) + (loop for (beg end front-pos back-pos matched-front matched-back + matched-submode matched-face matched-name + invalid-resume ok-resume) = + (apply #'mmm-match-region :start (point) all) + while beg + if end ; match-submode, if present, succeeded. + do + (condition-case nil + (progn + (mmm-make-region + (or matched-submode submode) beg end + :face (or matched-face face) + :front front-pos :back back-pos + :evaporation 'front + :match-front matched-front :match-back matched-back + :beg-sticky beg-sticky :end-sticky end-sticky + :name matched-name + :delimiter-mode delimiter-mode + :front-face front-face :back-face back-face + :creation-hook creation-hook + ) + (goto-char ok-resume)) + ;; If our region is invalid, go back to the end of the + ;; front match and continue on. + (mmm-error (goto-char invalid-resume))) + ;; If match-submode was unable to find a match, go back to + ;; the end of the front match and continue on. + else do (goto-char invalid-resume) + ))))) + +;;}}} +;;{{{ Match Regions + +(defun* mmm-match-region + (&key start stop front back front-verify back-verify + include-front include-back front-offset back-offset + front-form back-form save-matches match-submode match-face + front-match back-match end-not-begin + save-name match-name + &allow-other-keys) + "Find the first valid region between point and STOP. +Return \(BEG END FRONT-POS BACK-POS FRONT-FORM BACK-FORM SUBMODE FACE +NAME INVALID-RESUME OK-RESUME) specifying the region. See +`mmm-match-and-verify' for the valid values of FRONT and BACK +\(markers, regexps, or functions). A nil value for END means that +MATCH-SUBMODE failed to find a valid submode. INVALID-RESUME is the +point at which the search should continue if the region is invalid, +and OK-RESUME if the region is valid." + (when (mmm-match-and-verify front start stop front-verify) + (let ((beg (mmm-match->point include-front front-offset front-match)) + (front-pos (if front-delim + (mmm-match->point t front-delim front-match) + nil)) + (invalid-resume (match-end front-match)) + (front-form (mmm-get-form front-form))) + (let ((submode (if match-submode + (condition-case nil + (mmm-save-all + (funcall match-submode front-form)) + (mmm-no-matching-submode + (return-from + mmm-match-region + (values beg nil nil nil nil nil nil nil nil + invalid-resume nil)))) + nil)) + (name (cond ((functionp match-name) + (mmm-save-all (funcall match-name front-form))) + ((stringp match-name) + (if save-name + (mmm-format-matches match-name) + match-name)))) + (face (cond ((functionp match-face) + (mmm-save-all + (funcall match-face front-form))) + (match-face + (cdr (assoc front-form match-face)))))) + (when (mmm-match-and-verify + (if save-matches + (mmm-format-matches back) + back) + beg stop back-verify) + (let* ((end (mmm-match->point (not include-back) + back-offset back-match)) + (back-pos (if back-delim + (mmm-match->point nil back-delim back-match) + nil)) + (back-form (mmm-get-form back-form)) + (ok-resume (if end-not-begin + (match-end back-match) + end))) + (values beg end front-pos back-pos front-form back-form + submode face name + invalid-resume ok-resume))))))) + +(defun mmm-match->point (beginp offset match) + "Find a point of starting or stopping from the match data. If +BEGINP, start at \(match-beginning MATCH), else \(match-end MATCH), +and move OFFSET. Handles all values of OFFSET--see `mmm-classes-alist'." + (save-excursion + (goto-char (if beginp + (match-beginning front-match) + (match-end back-match))) + (dolist (spec (if (listp offset) offset (list offset))) + (if (numberp spec) + (forward-char (or spec 0)) + (funcall spec))) + (point))) + +(defun mmm-match-and-verify (pos start stop &optional verify) + "Find first match for POS between point and STOP satisfying VERIFY. +Return non-nil if a match was found, and set match data. POS can be a +number-or-marker, a regexp, or a function. + +If POS is a number-or-marker, it is used as-is. If it is a string, it +is searched for as a regexp until VERIFY returns non-nil. If it is a +function, it is called with argument STOP and must return non-nil iff +a match is found, and set the match data. Note that VERIFY is ignored +unless POS is a regexp." + (cond + ;; A marker can be used as-is, but only if it's in bounds. + ((and (number-or-marker-p pos) (>= pos start) (<= pos stop)) + (goto-char pos) + (looking-at "")) ; Set the match data + ;; Strings are searched for as regexps. + ((stringp pos) + (loop always (re-search-forward pos stop 'limit) + until (or (not verify) (mmm-save-all (funcall verify))))) + ;; Otherwise it must be a function. + ((functionp pos) + (funcall pos stop)))) + +;;}}} +;;{{{ Get Delimiter Forms + +(defun mmm-get-form (form) + "Return the delimiter form specified by FORM. +If FORM is nil, call `mmm-default-get-form'. If FORM is a string, +return it. If FORM is a function, call it. If FORM is a list, return +its `car' \(usually in this case, FORM is a one-element list +containing a function to be used as the delimiter form." + (cond ((stringp form) form) + ((not form) (mmm-default-get-form)) + ((functionp form) (mmm-save-all (funcall form))) + ((listp form) (car form)))) + +(defun mmm-default-get-form () + (regexp-quote (match-string 0))) + +;;}}} + +(provide 'mmm-class) + +;;; mmm-class.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-cmds.el b/mmm-mode-0.4.8/mmm-cmds.el new file mode 100644 index 0000000..893214a --- /dev/null +++ b/mmm-mode-0.4.8/mmm-cmds.el @@ -0,0 +1,446 @@ +;;; mmm-cmds.el --- MMM Mode interactive commands and keymap + +;; Copyright (C) 2000 by Michael Abraham Shulman + +;; Author: Michael Abraham Shulman +;; Version: $Id: mmm-cmds.el,v 1.18 2003/03/25 21:48:33 viritrilbia Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file contains the interactive commands for MMM Mode. + +;;; Code: + +(require 'font-lock) +(require 'mmm-compat) +(require 'mmm-vars) +(require 'mmm-class) + +;; APPLYING CLASSES +;;{{{ Applying Predefined Classes + +(defun mmm-ify-by-class (class) + "Add submode regions according to an existing submode class." + (interactive + (list (intern + (completing-read + "Submode Class: " + (remove-duplicates + (mapcar #'(lambda (spec) (list (symbol-name (car spec)))) + (append + (remove-if #'(lambda (spec) (plist-get (cdr spec) :private)) + mmm-classes-alist) + (remove-if #'caddr mmm-autoloaded-classes))) + :test #'equal) + nil t)))) + (unless (eq class (intern "")) + (mmm-apply-class class) + (mmm-add-to-history class) + (mmm-update-font-lock-buffer))) + +;;}}} +;;{{{ Applying by the Region + +(defun mmm-ify-region (submode front back) + "Add a submode region for SUBMODE coinciding with current region." + (interactive "aSubmode: \nr") + (mmm-ify :submode submode :front front :back back) + (setq front (mmm-make-marker front t nil) + back (mmm-make-marker back nil nil)) + (mmm-add-to-history `(:submode ,submode :front ,front :back ,back)) + (mmm-enable-font-lock submode)) + +;;}}} +;;{{{ Applying Simple Regexps + +(defun mmm-ify-by-regexp + (submode front front-offset back back-offset save-matches) + "Add SUBMODE regions to the buffer delimited by FRONT and BACK. +With prefix argument, prompts for all additional keywords arguments. +See `mmm-classes-alist'." + (interactive "aSubmode: +sFront Regexp: +nOffset from Front Regexp: +sBack Regexp: +nOffset from Back Regexp: +nNumber of matched substrings to save: ") + (let ((args (mmm-save-keywords submode front back front-offset + back-offset save-matches))) + (apply #'mmm-ify args) + (mmm-add-to-history args)) + (mmm-enable-font-lock submode)) + +;;}}} + +;; EDITING WITH REGIONS +;;{{{ Re-parsing Areas + +(defun mmm-parse-buffer () + "Re-apply all applicable submode classes to current buffer. +Clears all current submode regions, reapplies all past interactive +mmm-ification, and applies `mmm-classes' and mode-extension classes." + (interactive) + (message "MMM-ifying buffer...") + (mmm-apply-all) + (message "MMM-ifying buffer...done")) + +(defun mmm-parse-region (start stop) + "Re-apply all applicable submode classes between START and STOP. +Clears all current submode regions, reapplies all past interactive +mmm-ification, and applies `mmm-classes' and mode-extension classes." + (interactive "r") + (message "MMM-ifying region...") + (mmm-apply-all :start start :stop stop) + (message "MMM-ifying region...done")) + +(defun mmm-parse-block (&optional lines) + "Re-parse LINES lines before and after point \(default 1). +Clears all current submode regions, reapplies all past interactive +mmm-ification, and applies `mmm-classes' and mode-extension classes. + +This command is intended for use when you have just typed what should +be the delimiters of a submode region and you want to create the +region. However, you may want to look into the various types of +delimiter auto-insertion that MMM Mode provides. See, for example, +`mmm-insert-region'." + (interactive "p") + (message "MMM-ifying block...") + (destructuring-bind (start stop) (mmm-get-block lines) + (when (< start stop) + (mmm-apply-all :start start :stop stop))) + (message "MMM-ifying block...done")) + +(defun mmm-get-block (lines) + (let ((inhibit-point-motion-hooks t)) + (list (save-excursion + (forward-line (- lines)) + (beginning-of-line) + (point)) + (save-excursion + (forward-line lines) + (end-of-line) + (point))))) + +;;}}} +;;{{{ Reparse Current Region + +(defun mmm-reparse-current-region () + "Clear and reparse the area of the current submode region. +Use this command if a submode region's boundaries have become wrong." + (interactive) + (let ((ovl (mmm-overlay-at (point) 'all))) + (when ovl + (let ((beg (save-excursion + (goto-char (mmm-front-start ovl)) + (forward-line -1) + (point))) + (end (save-excursion + (goto-char (mmm-back-end ovl)) + (forward-line 1) + (point)))) + (mmm-parse-region beg end))))) + +;;}}} +;;{{{ Clear Submode Regions + +;; See also `mmm-clear-history' which is interactive. + +(defun mmm-clear-current-region () + "Deletes the submode region point is currently in, if any." + (interactive) + (delete-overlay (mmm-overlay-at (point) 'all))) + +(defun mmm-clear-regions (start stop) + "Deletes all submode regions from START to STOP." + (interactive "r") + (mmm-clear-overlays start stop)) + +(defun mmm-clear-all-regions () + "Deletes all submode regions in the current buffer." + (interactive) + (mmm-clear-overlays)) + +;;}}} +;;{{{ End Current Region + +(defun* mmm-end-current-region (&optional arg) + "End current submode region. +If ARG is nil, end it at the most appropriate place, usually its +current back boundary. If ARG is non-nil, end it at point. If the +current region is correctly bounded, the first does nothing, but the +second deletes that delimiter as well. + +If the region's BACK property is a string, it is inserted as above and +the overlay moved if necessary. If it is a function, it is called with +two arguments--the overlay, and \(if ARG 'middle t)--and must do the +entire job of this function." + (interactive "P") + (let ((ovl (mmm-overlay-at))) + (when ovl + (combine-after-change-calls + (save-match-data + (save-excursion + (when (mmm-match-back ovl) + (if arg + (replace-match "") + (return-from mmm-end-current-region))))) + (let ((back (overlay-get ovl 'back))) + (cond ((stringp back) + (save-excursion + (unless arg (goto-char (overlay-end ovl))) + (save-excursion (insert back)) + (move-overlay ovl (overlay-start ovl) (point)))) + ((functionp back) + (funcall back ovl (if arg 'middle t)))))) + (mmm-refontify-maybe (save-excursion (forward-line -1) (point)) + (save-excursion (forward-line 1) (point)))))) + +;;}}} +;;{{{ Narrow to Region + +(defun mmm-narrow-to-submode-region (&optional pos) + "Narrow to the submode region at point." + (interactive) + ;; Probably don't use mmm-current-overlay here, because this is + ;; sometimes called from inside messy functions. + (let ((ovl (mmm-overlay-at pos))) + (when ovl + (narrow-to-region (overlay-start ovl) (overlay-end ovl))))) + +;; The inverse command is `widen', usually on `C-x n w' + +;;}}} + +;; INSERTING REGIONS +;;{{{ Insert regions by keystroke + +;; This is the "default" binding in the MMM Mode keymap. Keys defined +;; by classes should be control keys, to avoid conflicts with MMM +;; commands. +(defun mmm-insert-region (arg) + "Insert a submode region based on last character in invoking keys. +Keystrokes after `mmm-mode-prefix-key' which are not bound to an MMM +Mode command \(see `mmm-command-modifiers') are passed on to this +function. If they have the modifiers `mmm-insert-modifiers', then they +are looked up, sans those modifiers, in all current submode classes to +find an insert skeleton. For example, in Mason, `p' \(with appropriate +prefix and modifiers) will insert a <%perl>... region." + (interactive "P") + (let* ((seq (this-command-keys)) + (event (aref seq (1- (length seq)))) + (mods (event-modifiers event)) + (key (mmm-event-key event))) + (if (subsetp mmm-insert-modifiers mods) + (mmm-insert-by-key + (append (set-difference mods mmm-insert-modifiers) + key) + arg)))) + +(defun mmm-insert-by-key (key &optional arg) + "Insert a submode region based on event KEY. +Inspects all the classes of the current buffer to find a matching +:insert key sequence. See `mmm-classes-alist'. ARG, if present, is +passed on to `skeleton-proxy-new' to control wrapping. + +KEY must be a list \(MODIFIERS... . BASIC-KEY) where MODIFIERS are +symbols such as shift, control, etc. and BASIC-KEY is a character code +or a symbol such as tab, return, etc. Note that if there are no +MODIFIERS, the dotted list becomes simply BASIC-KEY." + (multiple-value-bind (class skel str) (mmm-get-insertion-spec key) + (when skel + (let ((after-change-functions nil) + (old-undo buffer-undo-list) undo) + ;; XEmacs' skeleton doesn't manage positions by itself, so we + ;; have to do it. + (if mmm-xemacs (setq skeleton-positions nil)) + (skeleton-proxy-new skel str arg) + (destructuring-bind (back end beg front) skeleton-positions + ;; TODO: Find a way to trap invalid-parent signals from + ;; make-region and undo the skeleton insertion. + (let ((match-submode (plist-get class :match-submode)) + (match-face (plist-get class :match-face)) + (match-name (plist-get class :match-name)) + (front-form (regexp-quote (buffer-substring front beg))) + (back-form (regexp-quote (buffer-substring end back))) + submode face name) + (setq submode + (mmm-modename->function + (if match-submode + (mmm-save-all (funcall match-submode front-form)) + (plist-get class :submode)))) + (setq face + (cond ((functionp match-face) + (mmm-save-all + (funcall match-face front-form))) + (match-face + (cdr (assoc front-form match-face))) + (t + (plist-get class :face)))) + (setq name + (cond ((plist-get class :skel-name) + ;; Optimize the name to the user-supplied str + ;; if we are so instructed. + str) + ;; Call it if it is a function + ((functionp match-name) + (mmm-save-all (funcall match-name front-form))) + ;; Now we know it's a string, does it need to + ;; be formatted? + ((plist-get class :save-name) + ;; Yes. Haven't done a match before, so + ;; match the front regexp against the given + ;; form to format the string + (string-match (plist-get class :front) + front-form) + (mmm-format-matches match-name front-form)) + (t + ;; No, just use it as-is + match-name))) + (mmm-make-region + submode beg end + :face face + :name name + :front front :back back + :match-front front-form :match-back back-form + :evaporation 'front +;;; :beg-sticky (plist-get class :beg-sticky) +;;; :end-sticky (plist-get class :end-sticky) + :beg-sticky t :end-sticky t + :creation-hook (plist-get class :creation-hook)) + (mmm-enable-font-lock submode))) + ;; Now get rid of intermediate undo boundaries, so that the entire + ;; insertion can be undone as one action. This should really be + ;; skeleton's job, but it doesn't do it. + (setq undo buffer-undo-list) + (while (not (eq (cdr undo) old-undo)) + (when (eq (cadr undo) nil) + (setcdr undo (cddr undo))) + (setq undo (cdr undo))))))) + +(defun mmm-get-insertion-spec (key &optional classlist) + "Get the insertion info for KEY from all classes in CLASSLIST. +Return \(CLASS SKEL STR) where CLASS is the class spec a match was +found in, SKEL is the skeleton to insert, and STR is the argument. +CLASSLIST defaults to the return value of `mmm-get-all-classes', +including global classes." + (loop for classname in (or classlist (mmm-get-all-classes t)) + for class = (mmm-get-class-spec classname) + for inserts = (plist-get class :insert) + for skel = (cddr (assoc key inserts)) + with str + ;; If SKEL is a dotted pair, it means call another key's + ;; insertion spec with an argument. + unless (consp (cdr skel)) + do (setq str (cdr skel) + skel (cddr (assoc (car skel) inserts))) + if skel return (list class skel str) + ;; If we have a group class, recurse. + if (plist-get class :classes) + if (mmm-get-insertion-spec key it) + return it + else + return nil)) + +;;}}} +;;{{{ Help on Insertion + +(defun mmm-insertion-help () + "Display help on currently available MMM insertion commands." + (interactive) + (with-output-to-temp-buffer "*Help*" + (princ "Available MMM Mode Insertion Commands:\n") + (princ "Key Inserts\n") + (princ "--- -------\n\n") + (mapcar #'mmm-display-insertion-key + (mmm-get-all-insertion-keys)))) + +(defun mmm-display-insertion-key (spec) + "Print an insertion binding to standard output. +SPEC should be \(KEY NAME ...) where KEY is an insertion key and NAME +is a symbol naming the insertion." + (let* ((str (make-string 16 ?\ )) + ;; This gets us a dotted list, because of the way insertion + ;; keys are specified. + (key (append mmm-insert-modifiers (car spec))) + (lastkey (nthcdr (max (1- (safe-length key)) 0) key))) + ;; Now we make it a true list + (if (consp key) + (setcdr lastkey (list (cdr lastkey))) + (setq key (list key))) + ;; Get the spacing right + (store-substring str 0 + (key-description + (apply #'vector (append mmm-mode-prefix-key (list key))))) + (princ str) + ;; Now print the binding symbol + (princ (cadr spec)) + (princ "\n"))) + +(defun mmm-get-all-insertion-keys (&optional classlist) + "Return an alist of all currently available insertion keys. +Elements look like \(KEY NAME ...) where KEY is an insertion key and +NAME is a symbol naming the insertion." + (remove-duplicates + (loop for classname in (or classlist (mmm-get-all-classes t)) + for class = (mmm-get-class-spec classname) + append (plist-get class :insert) into keys + ;; If we have a group class, recurse. + if (plist-get class :classes) + do (setq keys (append keys (mmm-get-all-insertion-keys it))) + finally return keys) + :test #'equal + :key #'(lambda (x) (cons (car x) (cadr x))) + :from-end t)) + +;;}}} + +;;{{{ Auto Insertion (copied from interactive session);-COM- +;-COM- +;-COM-;; Don't use `mmm-ify-region' of course. And rather than having +;-COM-;; classes define their own functions, we should have them pass a +;-COM-;; skeleton as an attribute. Then our insert function can turn off +;-COM-;; after-change hooks and add the submode region afterward. +;-COM- +;-COM-(define-skeleton mmm-see-inline +;-COM- "" nil +;-COM- -1 @ " " _ " " @ "%>" +;-COM- '(apply #'mmm-ify-region 'cperl-mode (reverse skeleton-positions))) +;-COM- +;-COM-(define-skeleton mmm-see-other +;-COM- "" nil +;-COM- @ ";\n" _ "\n" @ "<%/" str ">" +;-COM- '(apply #'mmm-ify-region 'cperl-mode (reverse skeleton-positions))) +;-COM- +;-COM-(make-local-hook 'after-change-functions) +;-COM-(add-hook 'after-change-functions 'mmm-detect t) +;-COM- +;-COM-(defun mmm-detect (beg end length) +;-COM- (when (mmm-looking-back-at "<% ") +;-COM- (mmm-see-inline)) +;-COM- (when (mmm-looking-back-at "<%\\(\\w+\\)>") +;-COM- (mmm-see-other (match-string 1)))) +;-COM- +;;}}} + +(provide 'mmm-cmds) + +;;; mmm-cmds.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-compat.el b/mmm-mode-0.4.8/mmm-compat.el new file mode 100644 index 0000000..0794d8b --- /dev/null +++ b/mmm-mode-0.4.8/mmm-compat.el @@ -0,0 +1,193 @@ +;;; mmm-compat.el --- MMM Hacks for compatibility with other Emacsen + +;; Copyright (C) 2000 by Michael Abraham Shulman + +;; Author: Michael Abraham Shulman +;; Version: $Id: mmm-compat.el,v 1.9 2003/03/09 17:04:03 viritrilbia Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file provides a number of hacks that are necessary for MMM +;; Mode to function in different Emacsen. MMM Mode is designed for +;; FSF Emacs 20 and 21, but these hacks usually enable it to work +;; almost perfectly in Emacs 19 and XEmacs 20 or 21. + +;;; Code: + +(require 'cl) + +;;{{{ Emacsen Detection + +(defvar mmm-xemacs (featurep 'xemacs) + "Whether we are running XEmacs.") + +;;}}} +;;{{{ Keywords (Emacs 19) + +;; Emacs 19 doesn't automatically set keyword variables to themselves. +;; We shouldn't have to do any more than these, since CL automatically +;; defines all keywords used for function arguments. +(defvar mmm-keywords-used + '(:group :regexp :region :function :insert :classes :private) + "List of extra keywords used by MMM Mode.") + +(dolist (keyword mmm-keywords-used) + (set keyword keyword)) + +;;}}} +;;{{{ Customization (Emacs 19) + +(condition-case () + (require 'custom) + (error nil)) + +(unless (and (featurep 'custom) + (fboundp 'custom-declare-variable)) + (defmacro defgroup (&rest args) + nil) + (defmacro defface (var values doc &rest args) + (` (make-face (quote (, var))))) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc))))) + +;;}}} +;;{{{ Regexp-Opt (Emacs 19) + +(condition-case () + (require 'regexp-opt) + (error nil)) + +(unless (and (featurep 'regexp-opt) + (fboundp 'regexp-opt)) + ;; No regexp-opt; create one + (defun regexp-opt (strings &optional paren) + (concat (if paren "\\(" "") + (mapconcat 'regexp-quote strings "\\|") + (if paren "\\)" "")))) + +;;}}} +;;{{{ Regexp-Opt (XEmacs) + +(defmacro mmm-regexp-opt (strings paren) + "Act like FSF Emacs' `regexp-opt', whichever Emacs we're in. +XEmacs' `regexp-opt' requires an extra parameter to do grouping." + (if (featurep 'xemacs) + `(regexp-opt ,strings ,paren t) + `(regexp-opt ,strings ,paren))) + +;;}}} +;;{{{ Overlays (XEmacs) + +;; The main thing we use from FSF Emacs that XEmacs doesn't support +;; are overlays. XEmacs uses extents instead, but comes with a package +;; to emulate overlays. +(when mmm-xemacs + ;; This does almost everything we need. + (require 'overlay)) + +;; We also use a couple "special" overlay properties which have +;; different names for XEmacs extents. +(defvar mmm-evaporate-property + (if (featurep 'xemacs) 'detachable 'evaporate) + "The name of the overlay property controlling evaporation.") + +;; We don't use this any more, since its behavior is different in FSF +;; and XEmacs: in the one it replaces the buffer's local map, but in +;; the other it gets stacked on top of it. Instead we just set the +;; buffer's local map temporarily. +;;;(defvar mmm-keymap-property +;;; (if (featurep 'xemacs) 'keymap 'local-map) +;;; "The name of the overlay property controlling keymaps.") + +;;}}} +;;{{{ Keymaps and Events (XEmacs) + +;; In XEmacs, keymaps are a primitive type, while in FSF Emacs, they +;; are a list whose car is the symbol `keymap'. Among other things, +;; this means that they handle default bindings differently. +(defmacro mmm-set-keymap-default (keymap binding) + (if (featurep 'xemacs) + `(set-keymap-default-binding ,keymap ,binding) + `(define-key ,keymap [t] ,binding))) + +;; In XEmacs, events are a primitive type, while in FSF Emacs, they +;; are represented by characters or vectors. We treat them as vectors. +;; We can use `event-modifiers' in both Emacsen to extract the +;; modifiers, but the function to extract the basic key is different. +(defmacro mmm-event-key (event) + (if (featurep 'xemacs) + `(event-key ,event) + `(event-basic-type ,event))) + +;;}}} +;;{{{ Skeleton (XEmacs) + +;; XEmacs' `skeleton' package doesn't provide `@' to record positions. +(defvar skeleton-positions ()) +(defun mmm-fixup-skeleton () + "Add `@' to `skeleton-further-elements' if XEmacs and not there. +This makes `@' in skeletons act approximately like it does in FSF." + (and (featurep 'xemacs) + (defvar skeleton-further-elements ()) + (not (assoc '@ skeleton-further-elements)) + (add-to-list 'skeleton-further-elements + '(@ ''(push (point) skeleton-positions))))) + +;;}}} +;;{{{ Make Temp Buffers (XEmacs) + +(defmacro mmm-make-temp-buffer (buffer name) + "Return a buffer called NAME including the text of BUFFER. +This text should not be modified." + (if (fboundp 'make-indirect-buffer) + `(make-indirect-buffer ,buffer ,name) + `(save-excursion + (set-buffer (get-buffer-create ,name)) + (insert-buffer ,buffer) + (current-buffer)))) + +;;}}} +;;{{{ Font Lock Available (Emacs w/o X) + +(defvar mmm-font-lock-available-p (or window-system mmm-xemacs) + "Whether font-locking is available. +Emacs 19 and 20 only provide font-lock with a window system in use.") + +;;}}} +;;{{{ Font Lock Defaults (XEmacs) + +(defmacro mmm-set-font-lock-defaults () + "Set font-lock defaults without trying to turn font-lock on. +In XEmacs, `font-lock-set-defaults' calls `font-lock-set-defaults-1' +to do the real work but then `turn-on-font-lock', which in turn calls +`font-lock-mode', which unsets the defaults if running in a hidden +buffer \(name begins with a space). So in XEmacs, we just call +`font-lock-set-defaults-1' directly." + (if mmm-xemacs + `(font-lock-set-defaults-1) + `(font-lock-set-defaults))) + +;;}}} + +(provide 'mmm-compat) + +;;; mmm-compat.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-cweb.el b/mmm-mode-0.4.8/mmm-cweb.el new file mode 100644 index 0000000..08974a7 --- /dev/null +++ b/mmm-mode-0.4.8/mmm-cweb.el @@ -0,0 +1,101 @@ +;;; mmm-cweb.el --- MMM submode class for CWeb programs + +;; Copyright (C) 2001 by Alan Shutko + +;; Author: Alan Shutko +;; Version: $Id: mmm-cweb.el,v 1.3 2002/11/12 02:44:06 alanshutko Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file contains the definition of an MMM Mode submode class for +;; editing CWeb programs. + +;;; Code: + +(require 'mmm-compat) +(require 'mmm-vars) +(require 'mmm-auto) + +(defvar mmm-cweb-section-tags + '("@ " "@*")) + +(defvar mmm-cweb-section-regexp + (concat "^" (mmm-regexp-opt mmm-cweb-section-tags t))) + +(defvar mmm-cweb-c-part-tags + '("@c" "@>=" "@>+=" "@p")) + +(defvar mmm-cweb-c-part-regexp + (concat (mmm-regexp-opt mmm-cweb-c-part-tags t))) + +(defun mmm-cweb-in-limbo (pos) + "Check to see if POS is in limbo, ie before any cweb sections." + (save-match-data + (save-excursion + (goto-char pos) + (not (re-search-backward mmm-cweb-section-regexp nil t))))) + +(defun mmm-cweb-verify-brief-c () + "Verify function for cweb-brief-c class. +Checks whether the match is in limbo." + (not (mmm-cweb-in-limbo (match-beginning 0)))) + +(mmm-add-group + 'cweb + `( + (cweb-c-part + :submode c-mode + :front ,mmm-cweb-c-part-regexp + :back ,mmm-cweb-section-regexp) + (cweb-label + :submode tex-mode + :front "@<" + :back "@>" + :face mmm-comment-submode-face + :insert ((?l cweb-label nil @ "@<" @ "@>"))) + (cweb-brief-c + :submode c-mode + :front "[^\\|]\\(|\\)[^|]" + :front-match 1 + :front-verify mmm-cweb-verify-brief-c +; :front-offset -1 + :back "[^\\|]\\(|\\)" + :back-match 1 +; :back-offset 1 + :end-not-begin t + :insert ((?| cweb-c-in-tex nil "|" @ "|"))) + (cweb-comment + :submode tex-mode + :front "/[*]" + :back "[*]/" + :face mmm-comment-submode-face) +)) + +;; (add-to-list 'mmm-mode-ext-classes-alist +;; '(plain-tex-mode "\\.w\\'" cweb)) +;; (add-to-list 'mmm-mode-ext-classes-alist +;; '(latex-mode "\\.w\\'" cweb)) +;; (add-to-list 'auto-mode-alist '("\\.w\\'" . tex-mode)) + +(provide 'mmm-cweb) + +;;; mmm-cweb.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-mason.el b/mmm-mode-0.4.8/mmm-mason.el new file mode 100644 index 0000000..5d76c90 --- /dev/null +++ b/mmm-mode-0.4.8/mmm-mason.el @@ -0,0 +1,176 @@ +;;; mmm-mason.el --- MMM submode class for Mason components + +;; Copyright (C) 2000 by Michael Abraham Shulman + +;; Author: Michael Abraham Shulman +;; Version: $Id: mmm-mason.el,v 1.13 2003/03/09 17:04:03 viritrilbia Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file contains the definition of an MMM Mode submode class for +;; editing Mason components. See the file README.Mason for more +;; details. + +;;; Code: + +(require 'mmm-compat) +(require 'mmm-vars) +(require 'mmm-auto) + +;;{{{ Perl Tags + +(defvar mmm-mason-perl-tags + '("perl" "init" "cleanup" "once" "filter" "shared" + "perl_init" "perl_cleanup" "perl_once" "perl_filter")) + +(defvar mmm-mason-pseudo-perl-tags + '("args" "perl_args" "attr" "flags")) + +(defvar mmm-mason-non-perl-tags + '("doc" "perl_doc" "text" "perl_text" "def" "perl_def" "method")) + +(defvar mmm-mason-perl-tags-regexp + (concat "<%" (mmm-regexp-opt mmm-mason-perl-tags t) ">") + "Matches tags beginning Mason sections containing Perl code. +Saves the name of the tag matched.") + +(defvar mmm-mason-pseudo-perl-tags-regexp + (concat "<%" (mmm-regexp-opt mmm-mason-pseudo-perl-tags t) ">") + "Match tags beginning Mason sections that look like Perl but aren't. +Saves the name of the tag matched.") + +(defvar mmm-mason-tag-names-regexp + (regexp-opt (append mmm-mason-perl-tags mmm-mason-non-perl-tags) t) + "Matches any Mason tag name after the \"<%\". Used to verify that a +\"<%\" sequence starts an inline section.") + +(defun mmm-mason-verify-inline () + (not (looking-at mmm-mason-tag-names-regexp))) + +;;}}} +;;{{{ Add Classes + +(mmm-add-group + 'mason + `((mason-text + :submode nil + :front "<%text>" + :back "" + :insert ((?t mason-<%text> nil @ "<%text>" @ "\n" + _ "\n" @ "" @))) + (mason-doc + :submode text-mode + :face mmm-comment-submode-face + :front "<%doc>" + :back "" + :face nil + :insert ((?d mason-<%doc> nil @ "<%doc>" @ "\n" + _ "\n" @ "" @))) + (mason-perl + :submode perl + :match-face (("<%perl>" . mmm-code-submode-face) + ("<%init>" . mmm-init-submode-face) + ("<%cleanup>" . mmm-cleanup-submode-face) + ("<%once>" . mmm-init-submode-face) + ("<%filter>" . mmm-special-submode-face) + ("<%shared>" . mmm-init-submode-face)) + :front ,mmm-mason-perl-tags-regexp + :back "" + :save-matches 1 + :match-name "~1" + :save-name 1 + :insert ((?, mason-<%TAG> "Perl section: " @ "<%" str ">" @ + ";\n" _ "\n" @ "" @) + (?< mason-<%TAG> ?, . nil) + (?p mason-<%perl> ?, . "perl") + (?i mason-<%init> ?, . "init") + (?c mason-<%cleanup> ?, . "cleanup") + (?o mason-<%once> ?, . "once") + (?l mason-<%filter> ?, . "filter") + (?s mason-<%shared> ?, . "shared"))) + (mason-pseudo-perl + :submode perl + :face mmm-declaration-submode-face + :front ,mmm-mason-pseudo-perl-tags-regexp + :back "" + :save-matches 1 + :insert ((?. mason-pseudo-<%TAG> "Pseudo-perl section: " @ "<%" str ">" @ + "\n" _ "\n" @ "" @) + (?> mason-pseudo-<%TAG> ?, . nil) + (?a mason-<%args> ?. . "args") + (?f mason-<%flags> ?. . "flags") + (?r mason-<%attr> ?. . "attr"))) + (mason-inline + :submode perl + :face mmm-output-submode-face + :front "<%" + :front-verify mmm-mason-verify-inline + :back "%>" + :insert ((?% mason-<%-%> nil @ "<%" @ " " _ " " @ "%>" @) + (?5 mason-<%-%> ?% . nil))) + (mason-call + :submode perl + :face mmm-special-submode-face + :front "<&" + :back "&>" + :insert ((?& mason-<&-&> nil @ "<&" @ " " _ " " @ "&>" @) + (?7 mason-<&-&> ?% . nil))) + (mason-one-line-comment + :submode text-mode + :face mmm-comment-submode-face + :front "^%#" + :back "\n" + :insert ((?# mason-%-comment nil (mmm-mason-start-line) + @ "%" @ "# " _ @ '(mmm-mason-end-line) "\n" @) + (?3 mason-%-comment ?# . nil))) + (mason-one-line + :submode perl + :face mmm-code-submode-face + :front "^%" + :back "\n" + :insert ((return mason-%-line nil (mmm-mason-start-line) + @ "%" @ " " _ @ '(mmm-mason-end-line) "\n" @))))) + +;;}}} +;;{{{ One-line Sections + +(defun mmm-mason-start-line () + (if (bolp) + "" + "\n")) + +(defun mmm-mason-end-line () + (if (eolp) + (delete-char 1))) + +;;}}} +;;{{{ Set Mode Line + +(defun mmm-mason-set-mode-line () + (setq mmm-buffer-mode-display-name "Mason")) +(add-hook 'mmm-mason-class-hook 'mmm-mason-set-mode-line) + +;;}}} + +(provide 'mmm-mason) + +;;; mmm-mason.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-mode.el b/mmm-mode-0.4.8/mmm-mode.el new file mode 100644 index 0000000..4564294 --- /dev/null +++ b/mmm-mode-0.4.8/mmm-mode.el @@ -0,0 +1,296 @@ +;;; mmm-mode.el --- Allow Multiple Major Modes in a buffer + +;; Copyright (C) 1999, 2004 by Michael Abraham Shulman + +;; Emacs Lisp Archive Entry +;; Package: mmm-mode +;; Author: Michael Abraham Shulman +;; Keywords: convenience, faces, languages, tools +;; Version: 0.4.8 + +;; Revision: $Id: mmm-mode.el,v 1.17 2004/06/16 14:14:18 alanshutko Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your +;; option) any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;;; MMM Mode is a minor mode that allows multiple major modes to +;;; coexist in a single buffer. Refer to the documentation of the +;;; function `mmm-mode' for more detailed information. This file +;;; contains mode on/off functions and the mode keymap, but mostly +;;; just loads all the subsidiary files. + +;;{{{ Parameter Naming + +;;; Since version 0.3.7, I've tried to use a uniform scheme for naming +;;; parameters. Here's a brief summary. + +;;; BEG and END refer to the beginning and end of a region. +;;; FRONT and BACK refer to the respective delimiters of a region. +;;; FRONT- and BACK-OFFSET are the offsets from delimiter matches. +;;; FRONT-BEG through BACK-END are the endings of the delimiters. +;;; START and STOP bound actions, like searching, fontification, etc. + +;;}}} +;;{{{ CL and Parameters + +;;; Keyword parameters can be nice because it makes it easier to see +;;; what's getting passed as what. But I try not to use them in user +;;; functions, because CL doesn't make good documentation strings. +;;; Similarly, any hook or callback function can't take keywords, +;;; since Emacs as a whole doesn't use them. And for small parameter +;;; lists, they are overkill. So I use them only for a large number of +;;; optional parameters, such as `mmm-make-region'. + +;;; An exception is the various submode class application functions, +;;; which all take all their arguments as keywords, for consistency +;;; and so the classes alist looks nice. + +;;; When using keyword arguments, defaults should *always* be supplied +;;; in all arglists. (This pertains mostly to :start and :stop +;;; arguments, usually defaulting to (point-min) and (point-max) +;;; respectively.) `mmm-save-keywords' should only be used for lists +;;; with more than four arguments, such as in `mmm-ify-by-regexp'. + +;;; In general, while I have no qualms about using things from CL like +;;; `mapl', `loop' and `destructuring-bind', I try not to use `defun*' +;;; more than I have to. For one, it sometimes makes bad documentation +;;; strings. Furthermore, to a `defun'ned function, a nil argument is +;;; the same as no argument, so it will use its (manual) default, but +;;; to a `defun*'ned function, a nil argument *is* the argument, so +;;; any default specified in the arglist will be ignored. Confusion of +;;; this type should be avoided when at all possible. + +;;}}} + +;;; Code: + +(require 'cl) +;; If we don't load font-lock now, but it is loaded later, the +;; necessary mmm-font-lock-* properties may not be there. +(require 'font-lock) +(require 'mmm-compat) +(require 'mmm-utils) +(require 'mmm-vars) +(require 'mmm-auto) +(require 'mmm-region) +(require 'mmm-class) +;; This file is set up to autoload by `mmm-auto.el'. +;; (require 'mmm-cmds) +(require 'mmm-univ) + +;;{{{ Toggle Function + +(defun mmm-mode (&optional arg) + "Minor mode to allow multiple major modes in one buffer. +Without ARG, toggle MMM Mode. With ARG, turn MMM Mode on iff ARG is +positive and off otherwise. + +Commands Available: +\\ +\\{mmm-mode-map} + +BASIC CONCEPTS + +The idea of MMM Mode is to allow multiple major modes to coexist in +the same buffer. There is one \"primary\" major mode that controls +most of the buffer, and a number of \"submodes\" that each hold sway +over certain regions. The submode regions are usually highlighted by +a background color for ease of recognition. While the point is in a +submode region, the following changes \(are supposed to) occur: + +1. The local keymap is that of the submode. +2. The mode line changes to show what submode region is active. +3. The major mode menu and mouse popup menu are that of the submode. +4. Some local variables of the submode shadow the default mode's. +5. The syntax table and indentation are those of the submode. +6. Font-lock fontifies correctly for the submode. + +For further information, including installation and configuration +instructions, see the Info file mmm.info which is included with the +distribution of MMM Mode. Many of MMM's configuration variables are +available through M-x customize under Programming | Tools | Mmm." + (interactive "P") + (if (if arg (> (prefix-numeric-value arg) 0) (not mmm-mode)) + (mmm-mode-on) + (mmm-mode-off))) + +(add-to-list 'minor-mode-alist (list 'mmm-mode mmm-mode-string)) + +;;}}} +;;{{{ Mode On + +(defun mmm-mode-on () + "Turn on MMM Mode. See `mmm-mode'." + (interactive) + ;; This function is called from mode hooks, so we need to make sure + ;; we're not in a temporary buffer. We don't need to worry about + ;; recursively ending up in ourself, however, since by that time the + ;; variable `mmm-mode' will already be set. + (mmm-valid-buffer + (unless mmm-mode + (setq mmm-primary-mode major-mode) + (when (fboundp 'c-make-styles-buffer-local) + (c-make-styles-buffer-local t)) + (mmm-update-mode-info major-mode) + (setq mmm-region-saved-locals-for-dominant + (list* (list 'font-lock-cache-state nil) + (list 'font-lock-cache-position (make-marker)) + (copy-tree (cdr (assq major-mode mmm-region-saved-locals-defaults))))) + ;; Without the next line, the (make-marker) above gets replaced + ;; with the starting value of nil, and all comes to naught. + (mmm-set-local-variables major-mode) + (mmm-add-hooks) + (mmm-fixup-skeleton) + (make-local-variable 'font-lock-fontify-region-function) + (make-local-variable 'font-lock-beginning-of-syntax-function) + (setq font-lock-fontify-region-function 'mmm-fontify-region + font-lock-beginning-of-syntax-function 'mmm-beginning-of-syntax) + (setq mmm-mode t) + (condition-case err + (mmm-apply-all) + (mmm-error + ;; Complain, but don't die, since we want files to go ahead + ;; and be opened anyway, and the mode to go ahead and be + ;; turned on. Should we delete all previously made submode + ;; regions when we find an invalid one? + (message "%s" (error-message-string err)))) + (run-hooks 'mmm-mode-hook) + (mmm-run-major-hook)))) + +;;}}} +;;{{{ Mode Off + +(defun mmm-mode-off () + "Turn off MMM Mode. See `mmm-mode'." + (interactive) + (when mmm-mode + (mmm-remove-hooks) + (mmm-clear-overlays) + (mmm-clear-history) + (mmm-clear-mode-ext-classes) + (mmm-clear-local-variables) + (mmm-update-submode-region) + (setq font-lock-fontify-region-function + (get mmm-primary-mode 'mmm-fontify-region-function) + font-lock-beginning-of-syntax-function + (get mmm-primary-mode 'mmm-beginning-of-syntax-function)) + (mmm-update-font-lock-buffer) + (mmm-refontify-maybe) + (setq mmm-mode nil) + ;; Restore the mode line + (setq mmm-primary-mode-display-name nil + mmm-buffer-mode-display-name nil) + (mmm-set-mode-line))) + +;;}}} +;;{{{ Mode Keymap + +(defvar mmm-mode-map (make-sparse-keymap) + "Keymap for MMM Minor Mode.") + +(defvar mmm-mode-prefix-map (make-sparse-keymap) + "Keymap for MMM Minor Mode after `mmm-mode-prefix-key'.") + +(defvar mmm-mode-menu-map (make-sparse-keymap "MMM") + "Keymap for MMM Minor Mode menu.") + +(defun mmm-define-key (key binding &optional keymap) + (define-key (or keymap mmm-mode-prefix-map) + (vector (append mmm-command-modifiers (list key))) + binding)) + +(when mmm-use-old-command-keys + (mmm-use-old-command-keys)) + +(mmm-define-key ?c 'mmm-ify-by-class) +(mmm-define-key ?x 'mmm-ify-by-regexp) +(mmm-define-key ?r 'mmm-ify-region) + +(mmm-define-key ?b 'mmm-parse-buffer) +(mmm-define-key ?g 'mmm-parse-region) +(mmm-define-key ?% 'mmm-parse-block) +(mmm-define-key ?5 'mmm-parse-block) + +(mmm-define-key ?k 'mmm-clear-current-region) +(mmm-define-key ?\ 'mmm-reparse-current-region) +(mmm-define-key ?e 'mmm-end-current-region) + +(mmm-define-key ?z 'mmm-narrow-to-submode-region) + +;; This one is exact, since C-h is (usually) already used for help. +(define-key mmm-mode-prefix-map [?h] 'mmm-insertion-help) + +;; Default bindings to do insertion (dynamic) +(mmm-set-keymap-default mmm-mode-prefix-map 'mmm-insert-region) + +;; Set up the prefix help command, since otherwise the default binding +;; overrides it. +(define-key mmm-mode-prefix-map (vector help-char) prefix-help-command) + +;; And put it all onto the prefix key +(define-key mmm-mode-map mmm-mode-prefix-key mmm-mode-prefix-map) + +;; Order matters for the menu bar. +(define-key mmm-mode-menu-map [off] + '("MMM Mode Off" . mmm-mode-off)) +(define-key mmm-mode-menu-map [sep0] '(menu-item "----")) + +(define-key mmm-mode-menu-map [clhist] + '("Clear History" . mmm-clear-history)) +(define-key mmm-mode-menu-map [end] + '("End Current" . mmm-end-current-region)) +(define-key mmm-mode-menu-map [clear] + '("Clear Current" . mmm-clear-current-region)) +(define-key mmm-mode-menu-map [reparse] + '("Reparse Current" . mmm-reparse-current-region)) + +(define-key mmm-mode-menu-map [sep10] '(menu-item "----")) + +(define-key mmm-mode-menu-map [ins-help] + '("List Insertion Keys" . mmm-insertion-help)) + +(define-key mmm-mode-menu-map [sep20] '(menu-item "----")) + +(define-key mmm-mode-menu-map [region] + '(menu-item "MMM-ify Region" mmm-ify-region :enable mark-active)) +(define-key mmm-mode-menu-map [regexp] + '("MMM-ify by Regexp" . mmm-ify-by-regexp)) +(define-key mmm-mode-menu-map [class] + '("Apply Submode Class" . mmm-ify-by-class)) + +(define-key mmm-mode-menu-map [sep30] '(menu-item "----")) + +(define-key mmm-mode-menu-map [parse-region] + '(menu-item "Parse Region" mmm-parse-region :enable mark-active)) +(define-key mmm-mode-menu-map [parse-buffer] + '("Parse Buffer" . mmm-parse-buffer)) +(define-key mmm-mode-menu-map [parse-block] + '("Parse Block" . mmm-parse-block)) + +(define-key mmm-mode-map [menu-bar mmm] (cons "MMM" mmm-mode-menu-map)) + +(add-to-list 'minor-mode-map-alist (cons 'mmm-mode mmm-mode-map)) + +;;}}} + +(provide 'mmm-mode) + +;;; mmm-mode.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-noweb.el b/mmm-mode-0.4.8/mmm-noweb.el new file mode 100644 index 0000000..ec0e5d3 --- /dev/null +++ b/mmm-mode-0.4.8/mmm-noweb.el @@ -0,0 +1,410 @@ +;;; mmm-noweb.el --- MMM submode class for Noweb programs +;; +;; Copyright 2003, 2004 Joe Kelsey +;; +;; The filling, completion and chunk motion commands either taken +;; directly from or inspired by code in: +;; noweb-mode.el - edit noweb files with GNU Emacs +;; Copyright 1995 by Thorsten.Ohl @ Physik.TH-Darmstadt.de +;; with a little help from Norman Ramsey +;; + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file contains the definition of an MMM Mode submode class for +;; editing Noweb programs. + +;;; Code: + +(require 'mmm-region) +(require 'mmm-vars) +(require 'mmm-mode) + +;;{{{ Variables + +(defvar mmm-noweb-code-mode 'fundamental-mode + "*Major mode for editing code chunks. +This is set to FUNDAMENTAL-MODE by default, but you might want to change +this in the Local Variables section of your file to something more +appropriate, like C-MODE, FORTRAN-MODE, or even INDENTED-TEXT-MODE.") + +(defvar mmm-noweb-quote-mode nil + "*Major mode for quoted code chunks within documentation chunks. +If nil, defaults to `mmm-noweb-code-mode', which see.") + +(defvar mmm-noweb-quote-string "quote" + "*String used to form quoted code submode region names. +See `mmm-noweb-quote'.") + +(defvar mmm-noweb-quote-number 0 + "*Starting value appended to `mmm-noweb-quote-string'. +See `mmm-noweb-quote'.") + +(defvar mmm-noweb-narrowing nil + "*Narrow the region to the current pair of chunks.") + +;;}}} +;;{{{ Support for mmm submode stuff + +(defun mmm-noweb-chunk (form) + "Return the noweb code mode chosen by the user. +If the next 100 characters of the buffer contain a string of the form +\"-*- MODE -*-\", then return MODE as the chosen mode, otherwise +return the value of `mmm-noweb-code-mode'." + ;; Look for -*- mode -*- in the first two lines. + ;; 120 chars = 40 chars for #! + 80 chars for following line... + (if (re-search-forward "-\\*-\\s +\\(\\S-+\\)\\s +-\\*-" (+ (point) 120) t) + (let* ((string (match-string-no-properties 1)) + (modestr (intern (if (string-match "mode\\'" string) + string + (concat string "-mode"))))) + (or (mmm-ensure-modename modestr) + mmm-noweb-code-mode)) + mmm-noweb-code-mode)) + +(defun mmm-noweb-quote (form) + "Create a unique name for a quoted code region within a documentation chunk." + (or mmm-noweb-quote-mode + mmm-noweb-code-mode)) + +(defun mmm-noweb-quote-name (form) + "Create a unique name for a quoted code region within a documentation chunk." + (setq mmm-noweb-quote-number (1+ mmm-noweb-quote-number)) + (concat mmm-noweb-quote-string "-" + (number-to-string mmm-noweb-quote-number))) + +(defun mmm-noweb-chunk-name (form) + "Get the chunk name from FRONT-FORM." + (string-match "<<\\(.*\\)>>=" form) + (match-string-no-properties 1 form)) + +;;}}} +;;{{{ mmm noweb submode group + +;; We assume that the global document mode is latex or whatever, the +;; user wants. This class controls the code chunk submodes. We use +;; match-submode to either return the value in mmm-noweb-code-mode or to +;; look at the first line of the chunk for a submode setting. We reset +;; case-fold-search because chunk names are case sensitive. The front +;; string identifies the chunk name between the <<>>. Since this is +;; done, name-match can use the same functions as save-matches for back. +;; Our insert skeleton places a new code chunk and the skel-name lets us +;; optimize the skelton naming to use the inserted string. + +(mmm-add-group + 'noweb + '((noweb-chunk + :match-submode mmm-noweb-chunk + :case-fold-search nil + :front "^<<\\(.*\\)>>=" + :match-name "~1" + :save-name 1 + :front-offset (end-of-line 1) + :back "^@\\( \\|$\\|\\( %def .*$\\)\\)" + :insert ((?c noweb-code "Code Chunk Name: " + "\n" @ "<<" str ">>=" @ "\n" _ "\n" @ "@ " @ "\n")) + :skel-name t + ) + (noweb-quote + :match-submode mmm-noweb-quote + :face mmm-special-submode-face + :front "\\[\\[" +; :name-match mmm-noweb-quote-name + :back "\\]\\]" + :insert ((?q noweb-quote nil @ "[[" @ _ @ "]]" @)) + ) + )) + +;;}}} +;;{{{ Noweb regions + +(defun mmm-noweb-regions (start stop regexp &optional delim) + "Return a liat of regions of the form \(NAME BEG END) that exclude +names which match REGEXP." + (let* ((remove-next nil) + (regions + (maplist #'(lambda (pos-list) + (if (cdr pos-list) + (if remove-next + (setq remove-next nil) + (let ((name (or (mmm-name-at (car pos-list) 'beg) + (symbol-name mmm-primary-mode)))) + (if (and regexp (string-match regexp name) ) + (progn + (setq remove-next t) + nil) + (list name + (car pos-list) (cadr pos-list))))))) + (mmm-submode-changes-in start stop t delim)))) + ;; The above loop leaves lots of nils in the list... + ;; Removing them saves us from having to do the (last x 2) + ;; trick that mmm-regions-in does. + (setq regions (delq nil regions)))) + +;;}}} +;;{{{ Filling, etc + +(defun mmm-noweb-narrow-to-doc-chunk () + "Narrow to the current doc chunk. +The current chunk includes all quoted code chunks (i.e., \[\[...\]\]). +This function is only valid when called with point in a doc chunk or +quoted code chunk." + (interactive) + (let ((name (mmm-name-at (point)))) + (if (or (null name) (string-match "^quote" name)) + (let ((prev (cond + ((= (point) (point-min)) (point)) + (t (cadar (last (mmm-noweb-regions (point-min) (point) + "^quote")))))) + (next (cond + ((= (point) (point-max)) (point)) + (t (save-excursion + (goto-char (cadr + (cadr (mmm-noweb-regions (point) + (point-max) + "^quote")))) + (forward-line -1) + (point)))))) + (narrow-to-region prev next))))) + +(defun mmm-noweb-fill-chunk (&optional justify) + "Fill the current chunk according to mode. +Run `fill-region' on documentation chunks and `indent-region' on code +chunks." + (interactive "P") + (save-restriction + (let ((name (mmm-name-at (point)))) + (if (and name (not (string-match "^quote" name))) + (if (or indent-region-function indent-line-function) + (progn + (mmm-space-other-regions) + (indent-region (overlay-start mmm-current-overlay) + (overlay-end mmm-current-overlay) nil)) + (error "No indentation functions defined in %s!" major-mode)) + (progn + (mmm-word-other-regions) + (fill-paragraph justify))) + (mmm-undo-syntax-other-regions)))) + +(defun mmm-noweb-fill-paragraph-chunk (&optional justify) + "Fill a paragraph in the current chunk." + (interactive "P") + (save-restriction + (let ((name (mmm-name-at (point)))) + (if (and name (not (string-match "^quote" name))) + (progn + (mmm-space-other-regions) + (fill-paragraph justify)) + (progn + (mmm-word-other-regions) + (fill-paragraph justify))) + (mmm-undo-syntax-other-regions)))) + +(defun mmm-noweb-fill-named-chunk (&optional justify) + "Fill the region containing the named chunk." + (interactive "P") + (save-restriction + (let* ((name (or (mmm-name-at) (symbol-name mmm-primary-mode))) + (list (cdr (assoc name (mmm-names-alist (point-min) (point-max)))))) + (if (or (string= name (symbol-name mmm-primary-mode)) + (string-match "^quote" name)) + (progn + (mmm-word-other-regions) + (do-auto-fill)) + (progn + (mmm-space-other-regions) + (indent-region (caar list) (cadar (last list)) nil))) + (mmm-undo-syntax-other-regions)))) + +(defun mmm-noweb-auto-fill-doc-chunk () + "Replacement for `do-auto-fill'." + (save-restriction + (mmm-noweb-narrow-to-doc-chunk) + (mmm-word-other-regions) + (do-auto-fill) + (mmm-undo-syntax-other-regions))) + +(defun mmm-noweb-auto-fill-doc-mode () + "Install the improved auto fill function, iff necessary." + (if auto-fill-function + (setq auto-fill-function 'mmm-noweb-auto-fill-doc-chunk))) + +(defun mmm-noweb-auto-fill-code-mode () + "Install the default auto fill function, iff necessary." + (if auto-fill-function + (setq auto-fill-function 'do-auto-fill))) + +;;}}} +;;{{{ Functions on named chunks + +(defun mmm-noweb-complete-chunk () + "Try to complete the chunk name." + (interactive) + (let ((end (point)) + (beg (save-excursion + (if (re-search-backward "<<" + (save-excursion + (beginning-of-line) + (point)) + t) + (match-end 0) + nil)))) + (if beg + (let* ((pattern (buffer-substring beg end)) + (alist (mmm-names-alist (point-min) (point-max))) + (completion (try-completion pattern alist))) + (cond ((eq completion t)) + ((null completion) + (message "Can't find completion for \"%s\"" pattern) + (ding)) + ((not (string= pattern completion)) + (delete-region beg end) + (insert completion) + (if (not (looking-at ">>")) + (insert ">>"))) + (t + (message "Making completion list...") + (with-output-to-temp-buffer "*Completions*" + (display-completion-list + (all-completions pattern alist))) + (message "Making completion list...%s" "done")))) + (message "Not at chunk name...")))) + +(defvar mmm-noweb-chunk-history nil + "History for `mmm-noweb-goto-chunk'.") + +(defun mmm-noweb-goto-chunk () + "Goto the named chunk." + (interactive) + (widen) + (let* ((completion-ignore-case t) + (alist (mmm-names-alist (point-min) (point-max))) + (chunk (completing-read + "Chunk: " alist nil t + (mmm-name-at (point)) + mmm-noweb-chunk-history))) + (goto-char (caadr (assoc chunk alist))))) + +(defun mmm-noweb-goto-next (&optional cnt) + "Goto the continuation of the current chunk." + (interactive "p") + (widen) + (let ((name (mmm-name-at (point)))) + (if name + (let ((list (cdr (assoc name (mmm-names-alist + (overlay-end mmm-current-overlay) + (point-max)))))) + (if list + (goto-char (caar (nthcdr (1- cnt) list)))))))) + +(defun mmm-noweb-goto-previous (&optional cnt) + "Goto the continuation of the current chunk." + (interactive "p") + (widen) + (let ((name (mmm-name-at (point)))) + (if name + (let ((list (reverse + (cdr (assoc name + (mmm-names-alist (point-min) + (overlay-start + mmm-current-overlay))))))) + (if list + (goto-char (cadar (nthcdr cnt list)))))))) + +;;}}} +;;{{{ Key mappings + +(defvar mmm-noweb-map (make-sparse-keymap)) +(defvar mmm-noweb-prefix-map (make-sparse-keymap)) +(define-key mmm-noweb-map mmm-mode-prefix-key mmm-noweb-prefix-map) + +(mmm-define-key ?d 'mmm-noweb-narrow-to-doc-chunk mmm-noweb-prefix-map) +(mmm-define-key ?n 'mmm-noweb-goto-next mmm-noweb-prefix-map) +(mmm-define-key ?p 'mmm-noweb-goto-previous mmm-noweb-prefix-map) +(mmm-define-key ?q 'mmm-noweb-fill-chunk mmm-noweb-prefix-map) +;; Cannot use C-g as goto command, so use C-s. +(mmm-define-key ?s 'mmm-noweb-goto-chunk mmm-noweb-prefix-map) + +(define-key mmm-noweb-prefix-map "\t" 'mmm-noweb-complete-chunk) + +;; Don't want to add to either the mmm mode map (used in other mmm +;; buffers) or the local map (used in other major mode buffers), so we +;; make a full-buffer spanning overlay and add the map there. +(defun mmm-noweb-bind-keys () + (save-restriction + (widen) + (let ((ovl (make-overlay (point-min) (point-max) nil nil t))) + ;; 'keymap', not 'local-map' + (overlay-put ovl 'keymap mmm-noweb-map)))) + +(add-hook 'mmm-noweb-class-hook 'mmm-noweb-bind-keys) + +;; TODO: make this overlay go away if mmm is turned off + +;;}}} + +;; These functions below living here temporarily until a real place is +;; found. + +(defun mmm-syntax-region-list (syntax regions) + "Apply SYNTAX to a list of REGIONS of the form (BEG END). +If SYNTAX is not nil, set the syntax-table property of each region. +If SYNTAX is nil, remove the region syntax-table property. +See `mmm-syntax-region'." + (mapcar #'(lambda (reg) + (mmm-syntax-region (car reg) (cadr reg) syntax)) + regions)) + +(defun mmm-syntax-other-regions (syntax &optional name) + "Apply SYNTAX cell to other regions. +Regions are separated by name, using either `mmm-name-at' or the +optional NAME to determine the current region name." + (if (null name) + (setq name (or (mmm-name-at) + (symbol-name mmm-primary-mode)))) + (mapcar #'(lambda (reg) + (if (not (string= (car reg) name)) + (mmm-syntax-region-list syntax (cdr reg)))) + (mmm-names-alist (point-min) (point-max)))) + +(defun mmm-word-other-regions () + "Give all other regions word syntax." + (interactive) + (mmm-syntax-other-regions '(2 . 0)) + (setq parse-sexp-lookup-properties t)) + +(defun mmm-space-other-regions () + "Give all other regions space syntax." + (interactive) + (mmm-syntax-other-regions '(0 . 0)) + (setq parse-sexp-lookup-properties t)) + +(defun mmm-undo-syntax-other-regions () + "Remove syntax-table property from other regions." + (interactive) + (mmm-syntax-other-regions nil) + (setq parse-sexp-lookup-properties nil)) + + +(provide 'mmm-noweb) + +;;; mmm-noweb.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-region.el b/mmm-mode-0.4.8/mmm-region.el new file mode 100644 index 0000000..e62de02 --- /dev/null +++ b/mmm-mode-0.4.8/mmm-region.el @@ -0,0 +1,817 @@ +;;; mmm-region.el --- Manipulating and behavior of MMM submode regions + +;; Copyright (C) 2000 by Michael Abraham Shulman + +;; Author: Michael Abraham Shulman +;; Version: $Id: mmm-region.el,v 1.38 2003/06/19 11:24:04 viritrilbia Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file provides the functions and variables to create, delete, +;; and inspect submode regions, as well as functions that make them +;; behave like the submode with respect to syntax tables, local maps, +;; font lock, etc. + +;; See mmm-class.el for functions which scan the buffer and decide +;; where to create regions. + +;;; Code: + +(require 'cl) +(require 'font-lock) +(require 'mmm-compat) +(require 'mmm-utils) +(require 'mmm-auto) +(require 'mmm-vars) + +;; INSPECTION +;;{{{ Current Overlays + +;; Emacs counts an overlay starting at POS as "at" POS, but not an +;; overlay ending at POS. XEmacs is more sensible and uses beg- and +;; end-stickiness to determine whether an endpoint is within an +;; extent. Here we want to act like XEmacs does. + +(defsubst mmm-overlay-at (&optional pos type) + "Return the highest-priority MMM Mode overlay at POS. +See `mmm-included-p' for the values of TYPE." + (car (mmm-overlays-at pos type))) + +(defun mmm-overlays-at (&optional pos type) + "Return a list of the MMM overlays at POS, in decreasing priority. +See `mmm-included-p' for the values of TYPE." + (or pos (setq pos (point))) + (mmm-sort-overlays + (remove-if-not + #'(lambda (ovl) + (and (overlay-get ovl 'mmm) + (mmm-included-p ovl pos type))) + ;; XEmacs complains about positions outside the buffer + (overlays-in (max (1- pos) (point-min)) + (min (1+ pos) (point-max)))))) + +(defun mmm-included-p (ovl pos &optional type) + "Return true if the overlay OVL contains POS. + +If OVL strictly contains POS, always return true. If OVL starts or +ends at POS, return true or false based on the value of TYPE, which +should be one of nil, `beg', `end', `none', or `all'. +* If TYPE is nil, return true for an overlay starting at POS only if + it is beg-sticky, and for one ending at POS only if it is end-sticky. +* If TYPE is `beg', return true for any overlay starting at POS but + false for any ending at POS. +* If TYPE is `end', return true for any overlay ending at POS but + false for any starting at POS. +* If TYPE is `all', return true for any overlay starting or ending at POS. +* If TYPE is `none' \(or any other value), return false for any + overlay starting or ending at POS." + (let ((beg (overlay-start ovl)) + (end (overlay-end ovl))) + (cond ((and (= beg pos) (= end pos)) + ;; Do the Right Thing for zero-width overlays + (case type + ((nil) (and (overlay-get ovl 'beg-sticky) + (overlay-get ovl 'end-sticky))) + ((none) nil) + (t t))) + ((= beg pos) + (case type + ((nil) (overlay-get ovl 'beg-sticky)) + ((beg all) t) + (t nil))) + ((= end pos) + (case type + ((nil) (overlay-get ovl 'end-sticky)) + ((end all) t) + (t nil))) + ((and (> end pos) (< beg pos)) + t)))) + +;;; `mmm-overlays-in' has been retired as altogether too confusing a +;;; name, when what is really meant is one of the following three: + +(defun mmm-overlays-containing (start stop) + "Return all MMM overlays containing the region START to STOP. +The overlays are returned in order of decreasing priority. No +attention is paid to stickiness." + (mmm-sort-overlays + (remove-if-not + #'(lambda (ovl) + (and (overlay-get ovl 'mmm) + (<= (overlay-start ovl) start) + (>= (overlay-end ovl) stop))) + (overlays-in (max start (point-min)) + (min stop (point-max)))))) + +(defun mmm-overlays-contained-in (start stop) + "Return all MMM overlays entirely contained in START to STOP. +The overlays are returned in order of decreasing priority. No +attention is paid to stickiness." + (mmm-sort-overlays + (remove-if-not + #'(lambda (ovl) + (and (overlay-get ovl 'mmm) + (>= (overlay-start ovl) start) + (<= (overlay-end ovl) stop))) + (overlays-in (max start (point-min)) + (min stop (point-max)))))) + +(defun mmm-overlays-overlapping (start stop) + "Return all MMM overlays overlapping the region START to STOP. +The overlays are returned in order of decreasing priority. No +attention is paid to stickiness." + (mmm-sort-overlays + (remove-if-not + #'(lambda (ovl) + (overlay-get ovl 'mmm)) + (overlays-in (max start (point-min)) + (min stop (point-max)))))) + +(defun mmm-sort-overlays (overlays) + "Sort OVERLAYS in order of decreasing priority." + (sort (copy-list overlays) + #'(lambda (x y) (> (or (overlay-get x 'priority) 0) + (or (overlay-get y 'priority) 0))))) + +;;}}} +;;{{{ Current Submode + +(defvar mmm-current-overlay nil + "What submode region overlay we think we are currently in. +May be out of date; call `mmm-update-current-submode' to correct it.") +(make-variable-buffer-local 'mmm-current-overlay) + +(defvar mmm-previous-overlay nil + "What submode region overlay we were in just before this one. +Set by `mmm-update-current-submode'.") +(make-variable-buffer-local 'mmm-previous-overlay) + +(defvar mmm-current-submode nil + "What submode we think we are currently in. +May be out of date; call `mmm-update-current-submode' to correct it.") +(make-variable-buffer-local 'mmm-current-submode) + +(defvar mmm-previous-submode nil + "What submode we were in just before this one. +Set by `mmm-update-current-submode'.") +(make-variable-buffer-local 'mmm-previous-submode) + +(defun mmm-update-current-submode (&optional pos) + "Update current and previous position variables to POS, or point. +Return non-nil if the current region changed. + +Also deletes overlays that ought to evaporate because their delimiters +have disappeared." + (mapc #'delete-overlay + (remove-if #'(lambda (ovl) + (or (not (eq (overlay-get ovl 'mmm-evap) 'front)) + (overlay-buffer (overlay-get ovl 'front)))) + (mmm-overlays-at pos))) + (let ((ovl (mmm-overlay-at pos))) + (if (eq ovl mmm-current-overlay) + nil + (setq mmm-previous-overlay mmm-current-overlay + mmm-previous-submode mmm-current-submode) + (setq mmm-current-overlay ovl + mmm-current-submode (if ovl (overlay-get ovl 'mmm-mode))) + t))) + +;; This function is, I think, mostly for hacking font-lock. +(defun mmm-set-current-submode (mode &optional pos) + "Set the current submode to MODE and the current region to whatever +region of that mode is present at POS, or nil if none." + (setq mmm-previous-overlay mmm-current-overlay + mmm-previous-submode mmm-current-submode) + (setq mmm-current-submode mode + mmm-current-overlay + (find-if #'(lambda (ovl) + (eq (overlay-get ovl 'mmm-mode) mode)) + (mmm-overlays-at (or pos (point)) 'all)))) + +(defun mmm-submode-at (&optional pos type) + "Return the submode at POS \(or point), or NIL if none. +See `mmm-included-p' for values of TYPE." + (let ((ovl (mmm-overlay-at pos type))) + (if ovl (overlay-get ovl 'mmm-mode)))) + +;;}}} +;;{{{ Delimiter Matching and Boundaries + +(defun mmm-match-front (ovl) + "Return non-nil if the front delimiter of OVL matches as it should. +Sets the match data to the front delimiter, if it is a regexp. +Otherwise, calls it as a function with point at the beginning of the +front delimiter overlay \(i.e. where the front delimiter ought to +start) and one argument being the region overlay. The function should +return non-nil if the front delimiter matches correctly, and set the +match data appropriately." + (let* ((front-ovl (overlay-get ovl 'front)) + (front (if front-ovl (overlay-get front-ovl 'match)))) + (when front + (save-excursion + (goto-char (overlay-start front-ovl)) + (if (stringp front) + ;; It's a regexp + (looking-at front) + ;; It's a function + (funcall front ovl)))))) + +(defun mmm-match-back (ovl) + "Return non-nil if the back delimiter of OVL matches as it should. +Sets the match data to the back delimiter, if it is a regexp. +Otherwise, calls it as a function with point at the beginning of the +back delimiter overlay \(i.e. where the back delimiter ought to start) +and one argument being the region overlay. The function should return +non-nil if the back delimiter matches correctly, and set the match +data appropriately." + (let* ((back-ovl (overlay-get ovl 'back)) + (back (if back-ovl (overlay-get back-ovl 'match)))) + (when back + (save-excursion + (goto-char (overlay-start back-ovl)) + (if (stringp back) + ;; It's a regexp + (looking-at back) + ;; It's a function + (funcall back ovl)))))) + +(defun mmm-front-start (ovl) + "Return the position at which the front delimiter of OVL starts." + (let ((front (overlay-get ovl 'front))) + ;; Overlays which have evaporated become "overlays in no buffer" + (if (and front (overlay-buffer front)) + (overlay-start front) + (overlay-start ovl)))) + +(defun mmm-back-end (ovl) + "Return the position at which the back delimiter of OVL ends." + (let ((back (overlay-get ovl 'back))) + ;; Overlays which have evaporated become "overlays in no buffer" + (if (and back (overlay-buffer back)) + (overlay-end back) + (overlay-end ovl)))) + +;;}}} + +;; CREATION & DELETION +;;{{{ Make Submode Regions + +(defun mmm-valid-submode-region (submode beg end) + "Check if the region between BEG and END is valid for SUBMODE. +This region must be entirely contained within zero or more existing +submode regions, none of which start or end inside it, and it must be +a valid child of the highest-priority of those regions, if any. +Signals errors, returns `t' if no error." + ;; First check if the placement is valid. Every existing region + ;; that overlaps this one must contain it in its entirety. + (let ((violators (set-difference + (mmm-overlays-overlapping beg end) + (mmm-overlays-containing beg end)))) + (if violators + (signal 'mmm-subregion-invalid-placement + violators))) + ;; Now check if it is inside a valid parent + (let ((parent-mode (mmm-submode-at beg 'beg))) + (and parent-mode + ;; TODO: Actually check parents here. For present purposes, + ;; we just make sure we aren't putting a submode inside one + ;; of the same type. Actually, what we should really be + ;; doing is checking classes/names of regions, not just the + ;; submodes. + (eq submode parent-mode) + (signal 'mmm-subregion-invalid-parent + (list parent-mode)))) + t) + +(defun* mmm-make-region + (submode beg end &key face + front back (evaporation 'front) + delimiter-mode front-face back-face + display-name + (match-front "") (match-back "") + (beg-sticky t) (end-sticky t) + name creation-hook + ) + "Make a submode region from BEG to END of SUBMODE. + +BEG and END are buffer positions or markers with BEG <= END \(although +see EVAPORATION below). SUBMODE is a major mode function or a valid +argument to `mmm-modename->function'. FACE is a valid display face. + +FRONT and BACK specify the positions of the front and back delimiters +for this region, if any. If FRONT is a buffer position or marker, the +front delimiter runs from it to BEG. FRONT can also be a two-element +list \(FRONT-BEG FRONT-END) specifying the exact position of the front +delimiter. One must have FRONT-BEG < FRONT-END <= BEG. + +Similarly, BACK may be a buffer position or marker, in which case the +back delimiter runs from END to BACK. BACK can also be a two-element +list \(BACK-BEG BACK-END) specifying the exact position, in which case +we must have END <= BACK-BEG < BACK-END. + +EVAPORATION specifies under what conditions this submode region should +disappear. +* If `nil', the region never disappears. This can cause serious + problems when using cut-and-paste and is not recommended. +* If the value is t, the region disappears whenever it has zero + length. This is recommended for manually created regions used for + temporary editing convenience. +* If the value is `front', the region will disappear whenever the text + in its front delimiter disappears, that is, whenever the overlay + which marks its front delimiter has zero width. +The default value is `front'. However, if the parameter FRONT is nil, +then this makes no sense, so the default becomes `t'. Note that if +EVAPORATION is `t', then an error is signalled if BEG = END. + +MATCH-FRONT \(resp. MATCH-BACK) is a regexp or function to match the +correct delimiters, see `mmm-match-front' \(resp. `mmm-match-back'). +It is ignored if FRONT \(resp. BACK) is nil. At present these are not +used much. + +DELIMITER-MODE specifies the major mode to use for delimiter regions. +A `nil' value means they remain in the primary mode. + +FACE, FRONT-FACE, and BACK-FACE, are faces to use for the region, the +front delimiter, and the back delimiter, respectively, under high +decoration \(see `mmm-submode-decoration-level'). + +BEG-STICKY and END-STICKY determine whether the front and back of the +region, respectively, are sticky with respect to new insertion. The +default is yes. + +NAME is a string giving the \"name\" of this submode region. Submode +regions with the same name are considered part of the same code +fragment and formatted accordingly. + +DISPLAY-NAME is a string to display in the mode line when point is in +this submode region. If nil or not given, the name associated with +SUBMODE is used. In delimiter regions, \"--\" is shown. + +CREATION-HOOK should be a function to run after the region is created, +with point at the start of the new region." + ;; Check placement of region and delimiters + (unless (if (eq evaporation t) + (< beg end) + (<= beg end)) + (signal 'mmm-subregion-invalid-placement (list beg end))) + (when front + (unless (listp front) + (setq front (list front beg))) + (unless (and (< (car front) (cadr front)) + (<= (cadr front) beg)) + (signal 'mmm-subregion-invalid-placement front))) + (when back + (unless (listp back) + (setq back (list end back))) + (unless (and (< (car back) (cadr back)) + (<= end (car back))) + (signal 'mmm-subregion-invalid-placement back))) + (setq submode (mmm-modename->function submode)) + ;; Check embedding in existing regions + (mmm-valid-submode-region submode beg end) + (mmm-mode-on) + (when submode + (mmm-update-mode-info submode)) + (and (not front) (eq evaporation 'front) (setq evaporation t)) + (let ((region-ovl + (mmm-make-overlay submode beg end name face beg-sticky end-sticky + (or (eq evaporation t) nil) display-name))) + ;; Save evaporation type for checking later + (overlay-put region-ovl 'mmm-evap evaporation) + ;; Calculate priority to supersede anything already there. + (overlay-put region-ovl 'priority (length (mmm-overlays-at beg))) + ;; Make overlays for the delimiters, with appropriate pointers. + (when front + (let ((front-ovl + (mmm-make-overlay delimiter-mode (car front) (cadr front) + nil front-face nil nil t "--" t))) + (overlay-put region-ovl 'front front-ovl) + (overlay-put front-ovl 'region region-ovl) + (overlay-put front-ovl 'match match-front))) + (when back + (let ((back-ovl + (mmm-make-overlay delimiter-mode (car back) (cadr back) + nil back-face nil nil t "--" t))) + (overlay-put region-ovl 'back back-ovl) + (overlay-put back-ovl 'region region-ovl) + (overlay-put back-ovl 'match match-back))) + ;; Update everything and run all the hooks + (mmm-save-all + (goto-char (overlay-start region-ovl)) + (mmm-set-current-submode submode) + (mmm-set-local-variables submode) + (mmm-run-submode-hook submode) + (when creation-hook + (funcall creation-hook)) + (mmm-save-changed-local-variables region-ovl submode)) + (setq mmm-previous-submode submode + mmm-previous-overlay region-ovl) + (mmm-update-submode-region) + region-ovl)) + +(defun mmm-make-overlay (submode beg end name face beg-sticky end-sticky evap + &optional display-name delim) + "Internal function to make submode overlays. +Does not handle delimiters. Use `mmm-make-region'." + (let ((ovl (make-overlay beg end nil (not beg-sticky) end-sticky))) + (mapc + #'(lambda (pair) (overlay-put ovl (car pair) (cadr pair))) + `((mmm t) ; Mark all submode overlays + (mmm-mode ,submode) + ,@(if delim '((delim t)) nil) + (mmm-local-variables + ;; Have to be careful to make new list structure here + ,(list* (list 'font-lock-cache-state nil) + (list 'font-lock-cache-position (make-marker)) + (copy-tree + (cdr (assq submode mmm-region-saved-locals-defaults))))) + (name ,name) + (display-name ,display-name) + ;; Need to save these, because there's no way of accessing an + ;; overlay's official "front-advance" parameter once it's created. + (beg-sticky ,beg-sticky) + (end-sticky ,end-sticky) + ;; These have special meaning to Emacs + (,mmm-evaporate-property ,evap) + (face ,(mmm-get-face face submode delim)) + )) + ovl)) + +(defun mmm-get-face (face submode &optional delim) + (cond ((= mmm-submode-decoration-level 0) nil) + ((and (= mmm-submode-decoration-level 2) face) face) + (delim 'mmm-delimiter-face) + (submode 'mmm-default-submode-face))) + +;;}}} +;;{{{ Clear Overlays + +;; See also `mmm-clear-current-region'. + +(defun mmm-clear-overlays (&optional start stop strict) + "Clears all MMM overlays overlapping START and STOP. +If STRICT, only clear those entirely included in that region." + (mapcar #'delete-overlay + (if strict + (mmm-overlays-contained-in (or start (point-min)) + (or stop (point-max))) + (mmm-overlays-overlapping (or start (point-min)) + (or stop (point-max))))) + (mmm-update-submode-region)) + +;;}}} + +;; BASIC UPDATING +;;{{{ Submode Info + +(defun mmm-update-mode-info (mode &optional force) + "Save the global-saved and buffer-saved variables for MODE. +Global saving is done on properties of the symbol MODE and buffer +saving in `mmm-buffer-saved-locals'. This function must be called for +both the dominant mode and all submodes, in each file. Region-saved +variables are initialized from `mmm-region-saved-locals-defaults', +which is set here as well. See `mmm-save-local-variables'. If FORCE +is non-nil, don't quit if the info is already there." + (let ((buffer-entry (assq mode mmm-buffer-saved-locals)) + (region-entry (assq mode mmm-region-saved-locals-defaults)) + global-vars buffer-vars region-vars + ;; kludge for XEmacs 20 + (html-helper-build-new-buffer nil)) + (unless (and (not force) + (get mode 'mmm-local-variables) + buffer-entry + region-entry) + (save-excursion + (let ((filename (buffer-file-name))) + ;; On errors, the temporary buffers don't get deleted, so here + ;; we get rid of any old ones that may be hanging around. + (when (buffer-live-p (get-buffer mmm-temp-buffer-name)) + (save-excursion + (set-buffer (get-buffer mmm-temp-buffer-name)) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer)))) + ;; Now make a new temporary buffer. + (set-buffer (mmm-make-temp-buffer (current-buffer) + mmm-temp-buffer-name)) + ;; Handle stupid modes that need the file name set + (if (memq mode mmm-set-file-name-for-modes) + (setq buffer-file-name filename))) + (funcall mode) + (when (featurep 'font-lock) + ;; XEmacs doesn't have global-font-lock-mode (or rather, it + ;; has nothing but global-font-lock-mode). + (when (or mmm-xemacs + ;; Code copied from font-lock.el to detect when font-lock + ;; should be on via global-font-lock-mode. + (and (or font-lock-defaults + (assq major-mode font-lock-defaults-alist) + (assq major-mode font-lock-keywords-alist)) + (or (eq font-lock-global-modes t) + (if (eq (car-safe font-lock-global-modes) 'not) + (not (memq major-mode + (cdr font-lock-global-modes))) + (memq major-mode font-lock-global-modes))))) + ;; Don't actually fontify in the temp buffer, but note + ;; that we should fontify when we use this mode. + (put mode 'mmm-font-lock-mode t)) + ;; Get the font-lock variables + (when mmm-font-lock-available-p + ;; To fool `font-lock-add-keywords' + (let ((font-lock-mode t)) + (mmm-set-font-lock-defaults))) + ;; These can't be in the local variables list, because we + ;; replace their actual values, but we want to use their + ;; original values elsewhere. + (unless (and mmm-xemacs (= emacs-major-version 20)) + ;; XEmacs 20 doesn't have this variable. This effectively + ;; prevents the MMM font-lock support from working, but we + ;; just ignore it and go on, to prevent an error message. + (put mode 'mmm-fontify-region-function + font-lock-fontify-region-function)) + (put mode 'mmm-beginning-of-syntax-function + font-lock-beginning-of-syntax-function)) + ;; Get variables + (setq global-vars (mmm-get-locals 'global) + buffer-vars (mmm-get-locals 'buffer) + region-vars (mmm-get-locals 'region)) + (put mode 'mmm-mode-name mode-name) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) + (put mode 'mmm-local-variables global-vars) + (if buffer-entry + (setcdr buffer-entry buffer-vars) + (push (cons mode buffer-vars) mmm-buffer-saved-locals)) + (if region-entry + (setcdr region-entry region-vars) + (push (cons mode region-vars) + mmm-region-saved-locals-defaults))))) + +;;}}} +;;{{{ Updating Hooks + +(defun mmm-update-submode-region () + "Update all MMM properties correctly for the current position. +This function and those it calls do the actual work of setting the +different keymaps, syntax tables, local variables, etc. for submodes." + (when (mmm-update-current-submode) + (mmm-save-changed-local-variables mmm-previous-overlay + mmm-previous-submode) + (let ((mode (or mmm-current-submode mmm-primary-mode))) + (mmm-update-mode-info mode) + (mmm-set-local-variables mode) + (mmm-enable-font-lock mode)) + (mmm-set-mode-line) + (dolist (func (if mmm-current-overlay + (overlay-get mmm-current-overlay 'entry-hook) + mmm-primary-mode-entry-hook)) + (ignore-errors (funcall func))))) + +(defun mmm-add-hooks () + ;(make-local-hook 'post-command-hook) + (add-hook 'post-command-hook 'mmm-update-submode-region nil 'local)) + +(defun mmm-remove-hooks () + (remove-hook 'post-command-hook 'mmm-update-submode-region 'local)) + +;;}}} +;;{{{ Local Variables + +(defun mmm-get-local-variables-list (type mode) + "Filter `mmm-save-local-variables' to match TYPE and MODE. +Return a list \(VAR ...). In some cases, VAR will be a cons cell +\(GETTER . SETTER) -- see `mmm-save-local-variables'." + (mapcan #'(lambda (element) + (and (if (and (consp element) + (cdr element) + (cadr element)) + (eq (cadr element) type) + (eq type 'global)) + (if (and (consp element) + (cddr element) + (not (eq (caddr element) t))) + (if (functionp (caddr element)) + (funcall (caddr element)) + (member mode (caddr element))) + t) + (list (if (consp element) (car element) element)))) + mmm-save-local-variables)) + +(defun mmm-get-locals (type) + "Get the local variables and values for TYPE from this buffer. +Return \((VAR VALUE) ...). In some cases, VAR will be of the form +\(GETTER . SETTER) -- see `mmm-save-local-variables'." + (mapcan #'(lambda (var) + (if (consp var) + `((,var ,(funcall (car var)))) + (and (boundp var) + ;; This seems logical, but screws things up. + ;;(local-variable-p var) + `((,var ,(symbol-value var)))))) + (mmm-get-local-variables-list type major-mode))) + +(defun mmm-get-saved-local (mode var) + "Get the value of the local variable VAR saved for MODE, if any." + (cadr (assq var (mmm-get-saved-local-variables mode)))) + +(defun mmm-set-local-variables (mode) + "Set all the local variables saved for MODE. +Looks up both global, buffer, and region saves." + (mapcar #'(lambda (var) + ;; (car VAR) may be (GETTER . SETTER) + (if (consp (car var)) + (funcall (cdar var) (cadr var)) + (make-local-variable (car var)) + (set (car var) (cadr var)))) + (mmm-get-saved-local-variables mode))) + +(defun mmm-get-saved-local-variables (mode) + (append (get mode 'mmm-local-variables) + (cdr (assq mode mmm-buffer-saved-locals)) + (let ((ovl (mmm-overlay-at (point)))) + (if ovl + (overlay-get ovl 'mmm-local-variables) + mmm-region-saved-locals-for-dominant)))) + +(defun mmm-save-changed-local-variables (ovl mode) + "Save by-buffer and by-region variables for OVL and MODE. +Called when we move to a new submode region, with OVL and MODE the +region and mode for the previous position." + (let ((buffer-vars (cdr (assq (or mode mmm-primary-mode) + mmm-buffer-saved-locals))) + (region-vars (if ovl + (overlay-get ovl 'mmm-local-variables) + mmm-region-saved-locals-for-dominant)) + (set-local-value + #'(lambda (var) + (setcar (cdr var) + ;; (car VAR) may be (GETTER . SETTER) + (if (consp (car var)) + (funcall (caar var)) + (symbol-value (car var))))))) + (mapc set-local-value buffer-vars) + (mapc set-local-value region-vars))) + +(defun mmm-clear-local-variables () + "Clear all buffer- and region-saved variables for current buffer." + (setq mmm-buffer-saved-locals () + mmm-region-saved-locals-defaults () + mmm-region-saved-locals-for-dominant ())) + +;;}}} + +;; FONT LOCK +;;{{{ Enable Font Lock + +(defun mmm-enable-font-lock (mode) + "Turn on font lock if it is not already on and MODE enables it." + (mmm-update-mode-info mode) + (and mmm-font-lock-available-p + (not font-lock-mode) + (get mode 'mmm-font-lock-mode) + (font-lock-mode 1))) + +(defun mmm-update-font-lock-buffer () + "Turn on font lock iff any mode in the buffer enables it." + (when mmm-font-lock-available-p + (if (some #'(lambda (mode) + (get mode 'mmm-font-lock-mode)) + (cons mmm-primary-mode + (mapcar #'(lambda (ovl) + (overlay-get ovl 'mmm-mode)) + (mmm-overlays-overlapping + (point-min) (point-max))))) + (font-lock-mode 1) + (font-lock-mode 0)))) + +(defun mmm-refontify-maybe (&optional start stop) + "Re-fontify from START to STOP, or entire buffer, if enabled." + (and font-lock-mode + (if (or start stop) + (font-lock-fontify-region (or start (point-min)) + (or stop (point-max))) + (font-lock-fontify-buffer)))) + +;;}}} +;;{{{ Get Submode Regions + +;;; In theory, these are general functions that have nothing to do +;;; with font-lock, but they aren't used anywhere else, so we might as +;;; well have them close. + +(defun mmm-submode-changes-in (start stop) + "Return a list of all submode-change positions from START to STOP. +The list is sorted in order of increasing buffer position." + (sort (remove-duplicates + (list* start stop + (mapcan #'(lambda (ovl) + `(,(overlay-start ovl) + ,(overlay-end ovl))) + (mmm-overlays-overlapping start stop)))) + #'<)) + +(defun mmm-regions-in (start stop) + "Return a list of regions of the form (MODE BEG END) whose disjoint +union covers the region from START to STOP, including delimiters." + (let ((regions + (maplist #'(lambda (pos-list) + (if (cdr pos-list) + (list (or (mmm-submode-at (car pos-list) 'beg) + mmm-primary-mode) + (car pos-list) (cadr pos-list)))) + (mmm-submode-changes-in start stop)))) + (setcdr (last regions 2) nil) + regions)) + + +(defun mmm-regions-alist (start stop) + "Return a list of lists of the form \(MODE . REGIONS) where REGIONS +is a list of elements of the form \(BEG END). The disjoint union all +of the REGIONS covers START to STOP." + (let ((regions (mmm-regions-in start stop))) + (mapcar #'(lambda (mode) + (cons mode + (mapcan #'(lambda (region) + (if (eq mode (car region)) + (list (cdr region)))) + regions))) + ;; All the modes + (remove-duplicates (mapcar #'car regions))))) + +;;}}} +;;{{{ Fontify Regions + +(defun mmm-fontify-region (start stop &optional loudly) + "Fontify from START to STOP keeping track of submodes correctly." + (when loudly + (message "Fontifying %s with submode regions..." (buffer-name))) + ;; Necessary to catch changes in font-lock cache state and position. + (mmm-save-changed-local-variables + mmm-current-overlay mmm-current-submode) + ;; For some reason `font-lock-fontify-block' binds this to nil, thus + ;; preventing `mmm-beginning-of-syntax' from doing The Right Thing. + ;; I don't know why it does this, but let's undo it here. + (let ((font-lock-beginning-of-syntax-function 'mmm-beginning-of-syntax)) + (mapc #'(lambda (elt) + (when (get (car elt) 'mmm-font-lock-mode) + (mmm-fontify-region-list (car elt) (cdr elt)))) + (mmm-regions-alist start stop))) + ;; With jit-lock, this causes blips in the mode line and menus. + ;; Shouldn't be necessary here, since it's in post-command-hook too. + ;;(mmm-update-submode-region) + (when loudly (message nil))) + +(defun mmm-fontify-region-list (mode regions) + "Fontify REGIONS, each like \(BEG END), in mode MODE." + (save-excursion + (let (;(major-mode mode) + (func (get mode 'mmm-fontify-region-function))) + (mapc #'(lambda (reg) + (goto-char (car reg)) + ;; Here we do the same sort of thing that + ;; `mmm-update-submode-region' does, but we force it + ;; to use a specific mode, and don't save anything, + ;; fontify, or change the mode line. + (mmm-set-current-submode mode) + (mmm-set-local-variables mode) + (funcall func (car reg) (cadr reg) nil) + ;; Catch changes in font-lock cache. + (mmm-save-changed-local-variables + mmm-current-overlay mmm-current-submode)) + regions)))) + +;;}}} +;;{{{ Beginning of Syntax + +(defun mmm-beginning-of-syntax () + (goto-char + (let ((ovl (mmm-overlay-at (point))) + (func (get (or mmm-current-submode mmm-primary-mode) + 'mmm-beginning-of-syntax-function))) + (max (if ovl (overlay-start ovl) (point-min)) + (if func (progn (funcall func) (point)) (point-min)) + (point-min))))) + +;;}}} + +(provide 'mmm-region) + +;;; mmm-region.el ends here diff --git a/mmm-mode-0.4.8/mmm-rpm.el b/mmm-mode-0.4.8/mmm-rpm.el new file mode 100644 index 0000000..1fe1bab --- /dev/null +++ b/mmm-mode-0.4.8/mmm-rpm.el @@ -0,0 +1,81 @@ +;;; mmm-rpm.el --- MMM submode class for RPM spec files + +;; Copyright (C) 2000 by Marcus Harnisch + +;; Author: Marcus Harnisch +;; Version: $Id: mmm-rpm.el,v 1.3 2001/01/11 00:56:30 mas Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file contains the definition of an MMM Mode submode class for +;; editing shell script sections within RPM (Redhat Package Manager) +;; spec files. I recommend to use it in combination with +;; rpm-spec-mode.el by Stig Bjørlykke and Steve +;; Sanbeg (http://www.xemacs.org/~stigb/rpm-spec-mode.el) + +;;; Installation: + +;; 1. Copy this file where Emacs can find it. +;; +;; 2. Add the following lines to one of your startup files (e.g. ~/.emacs): +;; +;; (add-to-list 'mmm-mode-ext-classes-alist +;; '(rpm-spec-mode "\\.spec\\'" rpm-sh)) + +;;; Code: + +(require 'mmm-auto) + +(defconst mmm-rpm-sh-start-tags + '("prep" "build" "install" "clean" "preun" "postun" "pre" + "post" "triggerin" "triggerun" "triggerpostun") + "List containing RPM tags that start a shell-script section in a spec file") + +(defvar mmm-rpm-sh-end-tags + (append '("files" "description" "package") mmm-rpm-sh-start-tags) + "List containing RPM tags that end a shell-script section in a spec file") + +(defvar mmm-rpm-sh-start-regexp + (concat "^%" (mmm-regexp-opt mmm-rpm-sh-start-tags t) "\\b.*$") + "Regexp matching RPM tags that start a shell-script section in a spec file") + +(defvar mmm-rpm-sh-end-regexp + (concat "\\'\\|^%" (mmm-regexp-opt mmm-rpm-sh-end-tags t) "\\b.*$") + "Regexp matching RPM tags that end a shell-script section in a spec file") + +(mmm-add-group + 'rpm + `((rpm-sh + :submode sh-mode + :face mmm-code-submode-face + ;; match tags that starts sh-script region + :front ,mmm-rpm-sh-start-regexp + ;; match end of buffer or next tag that ends sh-script region + :back ,mmm-rpm-sh-end-regexp + :front-offset 1 + :back-offset 0 + :save-matches 0 + ))) + +(provide 'mmm-rpm) + +;;; mmm-rpm.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-sample.el b/mmm-mode-0.4.8/mmm-sample.el new file mode 100644 index 0000000..04e7d0c --- /dev/null +++ b/mmm-mode-0.4.8/mmm-sample.el @@ -0,0 +1,374 @@ +;;; mmm-sample.el --- Sample MMM submode classes + +;; Copyright (C) 2003, 2004 by Michael Abraham Shulman + +;; Author: Michael Abraham Shulman +;; Version: $Id: mmm-sample.el,v 1.28 2004/06/03 00:53:52 alanshutko Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file contains several sample submode classes for use with MMM +;; Mode. For a more detailed and useful example, see `mmm-mason.el'. + +;;; Code: + +(require 'mmm-auto) +(require 'mmm-vars) + +;;{{{ CSS embedded in HTML + +;; This is the simplest example. Many applications will need no more +;; than a simple regexp. +(mmm-add-classes + '((embedded-css + :submode css + :face mmm-declaration-submode-face + :delimiter-mode nil + :front "]*>" + :back ""))) + +;;}}} +;;{{{ Javascript in HTML + +;; We use two classes here, one for code in a " + :insert ((?j js-tag nil @ "" @)) + ) + (js-inline + :submode javascript + :face mmm-code-submode-face + :delimiter-mode nil + :front "on\\w+=\"" + :back "\""))) + +;;}}} +;;{{{ Here-documents + +;; Here we match the here-document syntax used by Perl and shell +;; scripts. We try to be automagic about recognizing what mode the +;; here-document should be in. To make sure that it is recognized +;; correctly, the name of the mode, perhaps minus `-mode', in upper +;; case, and/or with hyphens converted to underscores, should be +;; separated from the rest of the here-document name by hyphens or +;; underscores. + +(defvar mmm-here-doc-mode-alist '() + "Alist associating here-document name regexps to submodes. +Normally, this variable is unnecessary, as the `here-doc' submode +class tries to automagically recognize the right submode. If you use +here-document names that it doesn't recognize, however, then you can +add elements to this alist. Each element is \(REGEXP . MODE) where +REGEXP is a regular expression matched against the here-document name +and MODE is a major mode function symbol.") + +(defun mmm-here-doc-get-mode (string) + (string-match "[a-zA-Z_-]+" string) + (setq string (match-string 0 string)) + (or (mmm-ensure-modename + ;; First try the user override variable. + (some #'(lambda (pair) + (if (string-match (car pair) string) (cdr pair) nil)) + mmm-here-doc-mode-alist)) + (let ((words (split-string (downcase string) "[_-]+"))) + (or (mmm-ensure-modename + ;; Try the whole name, stopping at "mode" if present. + (intern + (mapconcat #'identity + (nconc (ldiff words (member "mode" words)) + (list "mode")) + "-"))) + ;; Try each word by itself (preference list) + (some #'(lambda (word) + (mmm-ensure-modename (intern word))) + words) + ;; Try each word with -mode tacked on + (some #'(lambda (word) + (mmm-ensure-modename + (intern (concat word "-mode")))) + words) + ;; Try each pair of words with -mode tacked on + (loop for (one two) on words + if (mmm-ensure-modename + (intern (concat one two "-mode"))) + return it) + ;; I'm unaware of any modes whose names, minus `-mode', + ;; are more than two words long, and if the entire mode + ;; name (perhaps minus `-mode') doesn't occur in the + ;; here-document name, we can give up. + (signal 'mmm-no-matching-submode nil))))) + +(mmm-add-classes + '((here-doc + :front "<<[\"\'\`]?\\([a-zA-Z0-9_-]+\\)" + :front-offset (end-of-line 1) + :back "^~1$" + :save-matches 1 + :delimiter-mode nil + :match-submode mmm-here-doc-get-mode + :insert ((?d here-doc "Here-document Name: " @ "<<" str _ "\n" + @ "\n" @ str "\n" @)) + ))) + +;;}}} +;;{{{ Embperl + +(mmm-add-group + 'embperl + '((embperl-perl + :submode perl + :front "\\[\\([-\\+!\\*\\$]\\)" + :back "~1\\]" + :save-matches 1 + :match-name "embperl" + :match-face (("[+" . mmm-output-submode-face) + ("[-" . mmm-code-submode-face) + ("[!" . mmm-init-submode-face) + ("[*" . mmm-code-submode-face) + ("[$" . mmm-special-submode-face)) + :insert ((?p embperl "Region Type (Character): " @ "[" str + @ " " _ " " @ str "]" @) + (?+ embperl+ ?p . "+") + (?- embperl- ?p . "-") + (?! embperl! ?p . "!") + (?* embperl* ?p . "*") + (?$ embperl$ ?p . "$") + ) + ) + (embperl-comment + :submode text-mode + :face mmm-comment-submode-face + :front "\\[#" + :back "#\\]" + :insert ((?# embperl-comment nil @ "[#" @ " " _ " " @ "#]" @)) + ))) + +;;}}} +;;{{{ ePerl + +(mmm-add-group + 'eperl + '((eperl-expr + :submode perl + :face mmm-output-submode-face + :front "<:=" + :back ":>" + :insert ((?= eperl-expr nil @ "<:=" @ " " _ " " @ ":>" @))) + (eperl-code + :submode perl + :face mmm-code-submode-face + :front "<:" + :back "_?:>" + :match-name "eperl" + :insert ((?p eperl-code nil @ "<:" @ " " _ " " @ ":>" @) + (?: eperl-code ?p . nil) + (?_ eperl-code_ nil @ "<:" @ " " _ " " @ "_:>" @))) + (eperl-comment + :submode text + :face mmm-comment-submode-face + :front ":>//" + :back "\n") + )) + +;;}}} +;;{{{ File Variables + +;; This submode class puts file local variable values, specified with +;; a `Local Variables:' line as in (emacs)File Variables, into Emacs +;; Lisp Mode. It is a good candidate to put in `mmm-global-classes'. + +(defun mmm-file-variables-verify () + ;; It would be nice to cache this somehow, which could be done in a + ;; buffer-local variable with markers for positions, but the trick + ;; is knowing when to expire the cache. + (let ((bounds + (save-excursion + (save-match-data + (goto-char (point-max)) + (backward-page) + (and (re-search-forward "^\\(.*\\)Local Variables:" nil t) + (list (match-string 1) + (progn (end-of-line) (point)) + (and (search-forward + (format "%sEnd:" (match-string 1)) + nil t) + (progn (beginning-of-line) + (point))))))))) + (and bounds (caddr bounds) + (save-match-data + (string-match (format "^%s" (regexp-quote (car bounds))) + (match-string 0))) + (> (match-beginning 0) (cadr bounds)) + (< (match-end 0) (caddr bounds))))) + +(defun mmm-file-variables-find-back (bound) + (forward-sexp) + (if (> (point) bound) + nil + (looking-at ""))) + +(mmm-add-classes + '((file-variables + :front ".+:" + :front-verify mmm-file-variables-verify + :back mmm-file-variables-find-back + :submode emacs-lisp-mode + :delimiter-mode nil + ))) + +;;}}} +;;{{{ JSP Pages + +(mmm-add-group 'jsp + `((jsp-comment + :submode text-mode + :face mmm-comment-submode-face + :front "<%--" + :back "--%>" + :insert ((?- jsp-comment nil @ "<%--" @ " " _ " " @ "--%>" @)) + ) + (jsp-code + :submode java + :match-face (("<%!" . mmm-declaration-submode-face) + ("<%=" . mmm-output-submode-face) + ("<%" . mmm-code-submode-face)) + :front "<%[!=]?" + :back "%>" + :match-name "jsp" + :insert ((?% jsp-code nil @ "<%" @ " " _ " " @ "%>" @) + (?! jsp-declaration nil @ "<%!" @ " " _ " " @ "%>" @) + (?= jsp-expression nil @ "<%=" @ " " _ " " @ "%>" @)) + ) + (jsp-directive + :submode text-mode + :face mmm-special-submode-face + :front "<%@" + :back "%>" + :insert ((?@ jsp-directive nil @ "<%@" @ " " _ " " @ "%>" @)) + ))) + +;;}}} +;;{{{ SGML DTD + +;; Thanks to Yann Dirson for writing and +;; contributing this submode class. + +(mmm-add-classes + '((sgml-dtd + :submode dtd-mode + :face mmm-declaration-submode-face + :delimiter-mode nil + :front "[]*\\[" + :back "]>"))) + +;;}}} +;;{{{ in httpd.conf + +(mmm-add-classes + '((httpd-conf-perl + :submode perl + :delimiter-mode nil + :front "" + :back ""))) + +;; Suggested Use: +;; (mmm-add-mode-ext-class 'apache-generic-mode nil 'httpd-conf-perl) + +;;}}} +;;{{{ PHP in HTML + +(mmm-add-group 'html-php + '((html-php-output + :submode php-mode + :face mmm-output-submode-face + :front "<\\?php *echo " + :back "\\?>" + :include-front t + :front-offset 5 + :insert ((?e php-echo nil @ "" @)) + ) + (html-php-code + :submode php-mode + :face mmm-code-submode-face + :front "<\\?\\(php\\)?" + :back "\\?>" + :insert ((?p php-section nil @ "" @) + (?b php-block nil @ "" @)) + ))) + +;;}}} + +;; NOT YET UPDATED +;;{{{ HTML in PL/SQL;-COM- +;-COM- +;-COM-;; This one is the most complex example. In PL/SQL, HTML is generally +;-COM-;; output as a (single quote delimited) string inside a call to htp.p or +;-COM-;; its brethren. The problem is that there may be strings outside of +;-COM-;; htp.p calls that should not be HTML, so we need to only look inside +;-COM-;; these calls. The situation is complicated by PL/SQL's rule that two +;-COM-;; sequential single quotes in a string mean to put a single quote +;-COM-;; inside the string. +;-COM- +;-COM-;; These functions have not been thoroughly tested, and always search +;-COM-;; the entire buffer, ignoring START and END. +;-COM- +;-COM-(defun mmm-html-in-plsql (start end) +;-COM- (save-match-data +;-COM- (let ((case-fold-search t)) +;-COM- (and (re-search-forward "htp.p\\(\\|rn\\|rint\\)1?(" nil t) +;-COM- (mmm-html-in-plsql-in-htp +;-COM- ;; Find the end of the procedure call +;-COM- (save-excursion (forward-char -1) (forward-sexp) (point)) +;-COM- start end))))) +;-COM- +;-COM-(defun mmm-html-in-plsql-in-htp (htp-end start end) +;-COM- (let (beg end) +;-COM- (or (and (re-search-forward "'" htp-end 'limit) +;-COM- (setf beg (match-end 0)) +;-COM- ;; Find an odd number of 's to end the string. +;-COM- (do ((lgth 0 (length (match-string 0)))) +;-COM- ((oddp lgth) t) +;-COM- (re-search-forward "'+" nil t)) +;-COM- (setf end (1- (match-end 0))) +;-COM- (cons (cons beg end) +;-COM- (mmm-html-in-plsql-in-htp htp-end start end))) +;-COM- ;; No more strings in the procedure call; look for another. +;-COM- (and (eql (point) htp-end) +;-COM- (mmm-html-in-plsql start end))))) +;-COM- +;-COM-(add-to-list 'mmm-classes-alist +;-COM- '(htp-p (:function html-mode mmm-html-in-plsql))) +;-COM- +;;}}} + +(provide 'mmm-sample) + +;;; mmm-sample.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-univ.el b/mmm-mode-0.4.8/mmm-univ.el new file mode 100644 index 0000000..7c16df2 --- /dev/null +++ b/mmm-mode-0.4.8/mmm-univ.el @@ -0,0 +1,64 @@ +;;; mmm-univ.el --- The "Universal" Submode Class + +;; Copyright (C) 2000 by Free Software Foundation, Inc. + +;; Author: Michael Abraham Shulman + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file defines the "universal" submode class, the default value +;; of `mmm-global-classes', which specifies a standard way to indicate +;; that part of a buffer should be in a different mode--for example, +;; in an email message. + +;;; Code: + +(require 'mmm-auto) +(require 'mmm-vars) + +(defun mmm-univ-get-mode (string) + (string-match "[a-zA-Z-]+" string) + (setq string (match-string 0 string)) + (let ((modestr (intern (if (string-match "mode\\'" string) + string + (concat string "-mode"))))) + (or (mmm-ensure-modename modestr) + (signal 'mmm-no-matching-submode nil)))) + +(mmm-add-classes + `((universal + :front "{%\\([a-zA-Z-]+\\)%}" + :back "{%/~1%}" + :insert ((?/ universal "Submode: " @ "{%" str "%}" @ "\n" _ "\n" + @ "{%/" str "%}" @)) + :match-submode mmm-univ-get-mode + :save-matches 1 + ))) + +(provide 'mmm-univ) + + +;;; Local Variables: +;;; mmm-global-classes: nil +;;; End: + +;;; mmm-univ.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-utils.el b/mmm-mode-0.4.8/mmm-utils.el new file mode 100644 index 0000000..7f2eb4b --- /dev/null +++ b/mmm-mode-0.4.8/mmm-utils.el @@ -0,0 +1,158 @@ +;;; mmm-utils.el --- Coding Utilities for MMM Mode + +;; Copyright (C) 2000 by Michael Abraham Shulman + +;; Author: Michael Abraham Shulman +;; Version: $Id: mmm-utils.el,v 1.14 2003/03/09 17:04:04 viritrilbia Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file provides a number of macros and other coding utilities +;; for MMM Mode. + +;;; Code: + +(require 'cl) + +;;{{{ Valid Buffer + +;; We used to wrap almost everything in this, but I realized that +;; only `mmm-mode-on' really needs it. Kept it as a macro, though, +;; for modularity and in case we need it somewhere else. +(defmacro mmm-valid-buffer (&rest body) + "Execute BODY if in a valid buffer for MMM Mode to be enabled. This +means not hidden, not a minibuffer, not in batch mode, and not in of +`mmm-never-modes'." + `(unless (or (eq (aref (buffer-name) 0) ?\ ) + (window-minibuffer-p (selected-window)) + (memq major-mode mmm-never-modes) + noninteractive + ;; Unnecessary as now hidden +;;; (equal (buffer-name) mmm-temp-buffer-name) + ) + ,@body)) + +;;;(def-edebug-spec mmm-valid-buffer t) + +;;}}} +;;{{{ Save Everything + +;; Never trust callback functions to preserve anything. +(defmacro mmm-save-all (&rest body) + "Execute BODY forms, then restoring point, mark, current buffer, +restrictions, and match data." + `(save-excursion + (save-restriction + (save-match-data + ,@body)))) + +;;;(def-edebug-spec mmm-save-all t) + +;;}}} +;;{{{ String Formatting + +(defun mmm-format-string (string arg-pairs) + "Format STRING by replacing arguments as specified by ARG-PAIRS. +Each element of ARG-PAIRS is \(REGEXP . STR) where each STR is to be +substituted for the corresponding REGEXP wherever it matches." + (let ((case-fold-search nil)) + (save-match-data + (dolist (pair arg-pairs) + (while (string-match (car pair) string) + (setq string (replace-match (cdr pair) t t string)))))) + string) + +(defun mmm-format-matches (string &optional on-string) + "Format STRING by matches from the current match data. +Strings like ~N are replaced by the Nth subexpression from the last +global match. Does nothing if STRING is not a string. + +ON-STRING, if supplied, means to use the match data from a +`string-match' on that string, rather than the global match data." + (when (stringp string) + (let ((old-data (match-data)) + subexp) + (save-match-data + (while (string-match "~\\([0-9]\\)" string) + (setq subexp (string-to-int (match-string-no-properties 1 string)) + string (replace-match + (save-match-data + (set-match-data old-data) + (match-string-no-properties subexp on-string)) + t t string)))))) + string) + +;;}}} +;;{{{ Save Keywords + +(defmacro mmm-save-keyword (param) + "If the value of PARAM as a variable is non-nil, return the list +\(:PARAM (symbol-value PARAM)), otherwise NIL. Best used only when it +is important that nil values disappear." + `(if (and (boundp ',param) ,param) + (list (intern (concat ":" (symbol-name ',param))) ,param) + nil)) + +(defmacro mmm-save-keywords (&rest params) + "Return a list saving the non-nil elements of PARAMS. E.g. +\(let \(\(a 1) \(c 2)) \(mmm-save-keywords a b c)) ==> \(:a 1 :c 2) +Use of this macro can make code more readable when there are a lot of +PARAMS, but less readable when there are only a few. Also best used +only when it is important that nil values disappear." + `(append ,@(mapcar #'(lambda (param) + (macroexpand `(mmm-save-keyword ,param))) + params))) + +;;}}} +;;{{{ Looking Back At + +(defun mmm-looking-back-at (regexp &optional bound) + "Return t if text before point matches REGEXP. +Modifies the match data. If supplied, BOUND means not to look farther +back that that many characters before point. Otherwise, it defaults to +\(length REGEXP), which is good enough when REGEXP is a simple +string." + (eq (point) + (save-excursion + (and (re-search-backward regexp + (- (point) (or bound (length regexp))) + t) + (match-end 0))))) + +;;}}} +;;{{{ Markers + +;; Mostly for remembering interactively made regions +(defun mmm-make-marker (pos beg-p sticky-p) + "Make, and return, a marker at POS that is or isn't sticky. +BEG-P represents whether the marker delimits the beginning of a +region \(or the end of it). STICKY-P is whether it should be sticky, +i.e. whether text inserted at the marker should be inside the region." + (let ((mkr (set-marker (make-marker) pos))) + (set-marker-insertion-type mkr (if beg-p (not sticky-p) sticky-p)) + mkr)) + +;;}}} + +(provide 'mmm-utils) + +;;; mmm-utils.el ends here \ No newline at end of file diff --git a/mmm-mode-0.4.8/mmm-vars.el b/mmm-mode-0.4.8/mmm-vars.el new file mode 100644 index 0000000..68eff49 --- /dev/null +++ b/mmm-mode-0.4.8/mmm-vars.el @@ -0,0 +1,1050 @@ +;;; mmm-vars.el --- Variables for MMM Mode + +;; Copyright (C) 2000, 2004 by Michael Abraham Shulman + +;; Author: Michael Abraham Shulman +;; Version: $Id: mmm-vars.el,v 1.56 2004/06/16 14:14:18 alanshutko Exp $ + +;;{{{ GPL + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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 GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;}}} + +;;; Commentary: + +;; This file provides the definitions for the variables used by MMM +;; Mode, as well as several functions to manipulate them. It also +;; defines the errors that MMM Mode can signal. + +;;; Code: + +(require 'mmm-compat) + +;; MISCELLANEOUS +;;{{{ Shut up the Byte Compiler + +;; Otherwise it complains about undefined variables. +(eval-when-compile + (defvar mmm-current-submode) + (defvar mmm-save-local-variables) + (defvar mmm-mode-string) + (defvar mmm-submode-mode-line-format) + (defvar mmm-mode-ext-classes-alist) + (defvar mmm-mode-prefix-key) + (defvar mmm-global-mode) + (defvar mmm-primary-mode) + (defvar mmm-classes-alist)) + +;;}}} +;;{{{ Error Conditions + +;; Most of these should be caught internally and never seen by the +;; user, except when the user is creating submode regions manually. + +;; Signalled when we try to put a submode region inside one where it +;; isn't meant to go. +(put 'mmm-subregion-invalid-parent + 'error-conditions + '(mmm-subregion-invalid-parent mmm-error error)) +(put 'mmm-subregion-invalid-parent + 'error-message + "Invalid submode region parent") + +;; Signalled when we try to put a submode region overlapping others in +;; an invalid way. +(put 'mmm-subregion-invalid-placement + 'error-conditions + '(mmm-subregion-invalid-placement mmm-error error)) +(put 'mmm-subregion-invalid-placement + 'error-message + "Submode region placement invalid") + +;; Signalled when we try to apply a submode class that doesn't exist. +(put 'mmm-invalid-submode-class + 'error-conditions + '(mmm-invalid-submode-class mmm-error error)) +(put 'mmm-invalid-submode-class + 'error-message + "Invalid or undefined submode class") + +;; Signalled by :match-submode functions when they are unable to +;; resolve a submode. This error should *always* be caught internally +;; and never seen by the user. +(put 'mmm-no-matching-submode + 'error-conditions + '(mmm-no-matching-submode mmm-error error)) +(put 'mmm-no-matching-submode + 'error-message + "Internal error: no matching submode.") + +;;}}} + +;; USER VARIABLES +;;{{{ Customization Group + +(defgroup mmm nil + "Multiple Major Modes in one buffer." + :group 'tools) + +;;}}} +;;{{{ Save Local Variables + +(defvar mmm-c-derived-modes + '(c-mode c++-mode objc-mode pike-mode java-mode jde-mode javascript-mode + php-mode)) + +(defvar mmm-save-local-variables + `(;; Don't use `function' (#') here!! We're already inside `quote'! + major-mode + comment-start + comment-end + (comment-line-start-skip buffer (fortran-mode)) + comment-start-skip + (comment-column buffer) + comment-indent-function + comment-line-break-function + sentence-end + ,@(when mmm-xemacs + '(mode-popup-menu + (((lambda () current-menubar) . set-buffer-menubar)) + )) + font-lock-keywords + font-lock-keywords-only + font-lock-keywords-case-fold-search + font-lock-syntax-table + font-lock-mark-block-function ; Override this? + font-lock-syntactic-keywords + indent-line-function + parse-sexp-ignore-comments ; Fixes indentation in PHP-mode? + ;; Can be different in different buffers + (c-basic-offset + buffer (c-mode c++-mode objc-mode pike-mode java-mode jde-mode)) + ;; These are necessary for C syntax parsing + (c-class-key nil ,mmm-c-derived-modes) + (c-extra-toplevel-key nil ,mmm-c-derived-modes) + (c-inexpr-class-key nil ,mmm-c-derived-modes) + (c-conditional-key nil ,mmm-c-derived-modes) + semantic-bovinate-toplevel-override + semantic-toplevel-bovine-table + ;; Indentation style control variables. + ;; These have to be localized in Emacs: see `mmm-mode-on'. + ,@(mapcar + #'(lambda (var) (list var nil mmm-c-derived-modes)) + '(c++-template-syntax-table + c-<-op-cont-regexp + c->-op-cont-regexp + c-after-suffixed-type-decl-key + c-after-suffixed-type-maybe-decl-key + c-any-class-key + c-any-class-key + c-asm-stmt-kwds + c-assignment-op-regexp + c-backslash-column + c-basic-offset + c-bitfield-kwds + c-block-comment-prefix + c-block-decls-with-vars + c-block-stmt-1-key + c-block-stmt-1-key + c-block-stmt-1-kwds + c-block-stmt-2-key + c-block-stmt-2-key + c-block-stmt-2-kwds + c-brace-list-key + c-cast-parens + c-class-key + c-class-key + c-class-kwds + c-cleanup-list + c-colon-type-list-re + c-comment-only-line-offset + c-comment-prefix-regexp + c-comment-start-regexp + c-comment-start-regexp + c-cpp-defined-fns + c-current-comment-prefix + c-decl-block-key + c-decl-block-key + c-decl-prefix-re + c-decl-spec-kwds + c-doc-comment-start-regexp + c-expr-kwds + c-file-offsets + c-file-style + c-hanging-braces-alist + c-hanging-colons-alist + c-hanging-comment-ender-p + c-hanging-comment-starter-p + c-hanging-semi\&comma-criteria + c-identifier-key + c-identifier-last-sym-match + c-identifier-start + c-identifier-syntax-modifications + c-identifier-syntax-table + c-in-comment-lc-prefix + c-indent-comment-alist + c-indent-comments-syntactically-p + c-indentation-style + c-inexpr-block-kwds + c-inexpr-class-kwds + c-keywords + c-keywords-obarray + c-keywords-regexp + c-keywords-regexp + c-known-type-key + c-label-key + c-label-key + c-label-kwds + c-label-kwds-regexp + c-label-kwds-regexp + c-label-minimum-indentation + c-lambda-kwds + c-literal-start-regexp + c-nonsymbol-chars + c-nonsymbol-token-regexp + c-not-decl-init-keywords + c-offsets-alist + c-opt-<>-arglist-start + c-opt-<>-arglist-start-in-paren + c-opt-<>-sexp-key + c-opt-access-key + c-opt-access-key + c-opt-asm-stmt-key + c-opt-asm-stmt-key + c-opt-bitfield-key + c-opt-bitfield-key + c-opt-block-decls-with-vars-key + c-opt-block-stmt-key + c-opt-block-stmt-key + c-opt-cpp-prefix + c-opt-cpp-start + c-opt-decl-spec-key + c-opt-friend-key + c-opt-friend-key + c-opt-identifier-concat-key + c-opt-inexpr-block-key + c-opt-inexpr-block-key + c-opt-inexpr-brace-list-key + c-opt-inexpr-class-key + c-opt-inexpr-class-key + c-opt-lambda-key + c-opt-lambda-key + c-opt-method-key + c-opt-method-key + c-opt-postfix-decl-spec-key + c-opt-type-component-key + c-opt-type-concat-key + c-opt-type-modifier-key + c-opt-type-suffix-key + c-other-decl-block-key + c-other-decl-block-key + c-other-decl-block-kwds + c-other-decl-kwds + c-overloadable-operators-regexp + c-paragraph-separate + c-paragraph-start + c-paren-stmt-key + c-primary-expr-regexp + c-primitive-type-key + c-primitive-type-kwds + c-protection-kwds + c-recognize-<>-arglists + c-recognize-knr-p + c-recognize-knr-p + c-recognize-paren-inits + c-recognize-typeless-decls + c-regular-keywords-regexp + c-simple-stmt-key + c-simple-stmt-kwds + c-special-brace-lists + c-special-brace-lists + c-specifier-key + c-specifier-kwds + c-stmt-delim-chars + c-stmt-delim-chars-with-comma + c-symbol-key + c-symbol-key + c-symbol-start + c-syntactic-eol + c-syntactic-ws-end + c-syntactic-ws-start + c-type-decl-prefix-key + c-type-decl-suffix-key + c-type-prefix-key + comment-end + comment-start + comment-start-skip)) + ;; Skeleton insertion + skeleton-transformation + ;; Abbrev mode + abbrev-mode + local-abbrev-table + ;; And finally the syntax table and local map. + ((syntax-table . set-syntax-table)) + ((current-local-map . use-local-map) buffer) + paragraph-separate + paragraph-start + ) + "Which local variables to save for major mode regions. +Each element has the form \(VARIABLE [TYPE [MODES]]), causing VARIABLE +to be saved for all major modes in the list MODES. If MODES is t or +absent, the variable is saved for all major modes. MODES can also be +a function of no arguments which returns non-nil whenever the variable +should be saved. + +TYPE should be either the symbol `global', meaning to save the +variable globally, the symbol `buffer', meaning to save it per buffer, +or the symbol `region', meaning to save it for each submode region. +If TYPE has any other value, such as nil, or is absent, the variable +is saved globally. If all optional parameters are omitted, the +element may be simply VARIABLE instead of \(VARIABLE). + +It is possible for VARIABLE to be not a symbol but a cons cell of the +form \(GETTER . SETTER), thus specifying special functions to set and +get the value of the \"variable\". This is used for objects like +local maps, syntax tables, etc. which need to be installed in a +special way. GETTER should be a function of no arguments, and SETTER +a function of one. In this case, even if TYPE and MODES are omitted, +the list cannot be flattened--it must be \((GETTER . SETTER)). +\"Variables\" of this type cannot be seen with `mmm-get-saved-local'. + +A single variable may appear more than once in this list, with +different modes and/or types. If the same mode appears more than once +for the same variable with different types, the behavior is undefined. +Changing the value of this variable after MMM Mode has been activated +in some buffer may produce unpredictable results. + +Globally saved variables are saved in the mmm-local-variables property +of the mode symbol. Buffer saved variables are saved in the alist +`mmm-buffer-saved-locals'. Region saved variables are saved in the +mmm-local-variables property of the overlay.") + +(defvar mmm-buffer-saved-locals () + "Stores saved local variables for this buffer, by mode. +Each element looks like \(MODE \(VAR VALUE) ...).") +(make-variable-buffer-local 'mmm-buffer-saved-locals) + +(defvar mmm-region-saved-locals-defaults () + "Stores saved defaults for region-saved locals, by mode. +Each element looks like \(MODE \(VAR VALUE) ...). Used to initialize +new submode regions.") +(make-variable-buffer-local 'mmm-region-saved-locals-defaults) + +(defvar mmm-region-saved-locals-for-dominant () + "Stores saved region locals for the dominant major mode. +The dominant major mode is considered to be one region for purposes of +saving region variables. Region-saved variables for submode regions +are saved as overlay properties.") +(make-variable-buffer-local 'mmm-region-saved-locals-for-dominant) + +;;}}} +;;{{{ Submode Faces + +(defgroup mmm-faces nil + "Faces and coloring for submode regions. +In general, only background colors should be set, to avoid interfering +with font-lock." + :group 'mmm) + +(defcustom mmm-submode-decoration-level 1 + "*Amount of coloring to use in submode regions. +Should be either 0, 1, or 2, representing None, Low, and High amounts +of coloring respectively. +* None (0) means to use no coloring at all. +* Low (1) means to use `mmm-default-submode-face' for all submode + regions \(except for \"non-submode\" regions, i.e. those that are of + the primary mode) and `mmm-delimiter-face' for region delimiters. +* High (2) means to use different faces for different types of submode + regions and delimiters, such as initialization code, expressions that + are output, declarations, and so on, as specified by the submode + class. The default faces are still used for regions that do not + specify a face." + :group 'mmm-faces + :type '(choice (const :tag "None" 0) + (const :tag "Low" 1) + (const :tag "High" 2))) + +(defface mmm-init-submode-face '((t (:background "Pink"))) + "Face used for submodes containing initialization code." + :group 'mmm-faces) + +(defface mmm-cleanup-submode-face '((t (:background "Wheat"))) + "Face used for submodes containing cleanup code." + :group 'mmm-faces) + +(defface mmm-declaration-submode-face '((t (:background "Aquamarine"))) + "Face used for submodes containing declarations." + :group 'mmm-faces) + +(defface mmm-comment-submode-face '((t (:background "SkyBlue"))) + "Face used for submodes containing comments and documentation." + :group 'mmm-faces) + +(defface mmm-output-submode-face '((t (:background "Plum"))) + "Face used for submodes containing expression that are output." + :group 'mmm-faces) + +(defface mmm-special-submode-face '((t (:background "MediumSpringGreen"))) + "Face used for special submodes not fitting any other category." + :group 'mmm-faces) + +(defface mmm-code-submode-face '((t (:background "LightGray"))) + "Face used for submodes containing ordinary code." + :group 'mmm-faces) + +(defface mmm-default-submode-face '((t (:background "gray85"))) + "Face used for all submodes at decoration level 1. +Also used at decoration level 2 for submodes not specifying a type." + :group 'mmm-faces) + +(defface mmm-delimiter-face nil + "Face used to mark submode delimiters." + :group 'mmm-faces) + +;;}}} +;;{{{ Mode Line Format + +(defcustom mmm-mode-string " MMM" + "*String to display in mode line as MMM minor mode indicator." + :group 'mmm + :type 'string) + +(defcustom mmm-submode-mode-line-format "~M[~m]" + "*Format of the mode-line display when point is in a submode region. + +~M is replaced by the name of the primary major mode \(which may be +replaced by a combined-mode function, see the info documentation). + +~m is replaced by the submode region overlay's `display-name' +property, if it has one. Otherwise it is replaced by the mode name of +the submode region. + +If `mmm-primary-mode-display-name' is non-nil, then this variable is +used even when point is not in a submode region \(i.e. it is in a +primary mode region), with ~m being replaced by the value of that +variable." + :group 'mmm + :type 'string) + +(defvar mmm-primary-mode-display-name nil + "If non-nil, displayed as the primary mode name in the mode line. +See also `mmm-buffer-mode-display-name'.") +(make-variable-buffer-local 'mmm-primary-mode-display-name) + +(defvar mmm-buffer-mode-display-name nil + "If non-nil, displayed in the mode line instead of the primary mode +name, which is then shown next to it as if it were a submode when in a +primary mode region, i.e. outside all submode regions.") +(make-variable-buffer-local 'mmm-buffer-mode-display-name) + +(defun mmm-set-mode-line () + "Set the mode line display correctly for the current submode, +according to `mmm-submode-mode-line-format'." + (let ((primary (or mmm-primary-mode-display-name + (get mmm-primary-mode 'mmm-mode-name))) + (submode (and mmm-current-overlay + (or (overlay-get mmm-current-overlay 'display-name) + (get mmm-current-submode 'mmm-mode-name))))) + (if mmm-buffer-mode-display-name + (setq mode-name + (mmm-format-string mmm-submode-mode-line-format + `(("~M" . ,mmm-buffer-mode-display-name) + ("~m" . ,(or submode primary))))) + (if submode + (setq mode-name + (mmm-format-string mmm-submode-mode-line-format + `(("~M" . ,primary) + ("~m" . ,submode)))) + (setq mode-name primary)))) + (force-mode-line-update)) + +;;}}} +;;{{{ Submode Classes + +(defvar mmm-classes nil + "*List of submode classes that apply to a buffer. +Generally set in a file local variables list. Can either be one +symbol, or a list of symbols. Automatically buffer-local.") +(make-variable-buffer-local 'mmm-classes) + +(defvar mmm-global-classes '(universal) + "*List of submode classes that apply to all buffers. +Can be overridden in a file local variables list.") + +;;}}} +;;{{{ Modes and Extensions + +(defcustom mmm-mode-ext-classes-alist nil + "Alist of submode classes for major modes and/or file extensions. +This variable can now be directly modified. + +Elements look like \(MODE EXT CLASS), where MODE is a major mode, EXT +is a regexp to match a filename such as in `auto-mode-alist', and +CLASS is a submode class. CLASS is activated in all buffers in mode +MODE \(if non-nil) and whose filenames match EXT \(if non-nil). If +both MODE and EXT are nil, CLASS is activated in all buffers. If CLASS +is the symbol t, MMM Mode is turned on in all buffers matching MODE +and EXT, but no classes are activated. + +See `mmm-global-mode'." + :group 'mmm + :type '(repeat (list (symbol :tag "Major Mode") + (string :tag "Filename Regexp") + (symbol :tag "Class"))) + :require 'mmm-mode) + +(defun mmm-add-mode-ext-class (mode ext class) + "Add an element to `mmm-mode-ext-classes-alist', which see. +That variable can now be directly modified, so this function is +unnecessary. It probably won't go away, though." + (add-to-list 'mmm-mode-ext-classes-alist (list mode ext class))) + +;;}}} +;;{{{ Preferred Major Modes + +(defcustom mmm-major-mode-preferences + '((perl cperl-mode perl-mode) + (javascript javascript-mode c++-mode) + (java jde-mode java-mode c++-mode) + (css css-mode c++-mode)) + "User preferences about what major modes to use. +Each element has the form \(LANGUAGE . MODES) where LANGUAGE is the +name of a programming language such as `perl' as a symbol, and MODES +is a list of possible major modes to use, such as `cperl-mode' or +`perl-mode'. The first element of MODES which is `fboundp' is used +for submodes of LANGUAGE. The last element of MODES should be a mode +which will always be available." + :group 'mmm + :type '(repeat (cons symbol + (repeat + (restricted-sexp :match-alternatives + (fboundp)))))) + +(defun mmm-add-to-major-mode-preferences (language mode &optional default) + "Set the preferred major mode for LANGUAGE to MODE. +This sets the value of `mmm-major-mode-preferences'. If DEFAULT is +nil or unsupplied, MODE is added at the front of the list of modes for +LANGUAGE. If DEFAULT is non-nil, then it is added at the end. This +may be used by packages to ensure that some mode is present, but not +override any user-specified mode." + (let ((pair (assq language mmm-major-mode-preferences))) + (if pair + ;; Existing mode preferences + (if default + (setcdr pair (cons mode (cdr pair))) + (setcdr pair (append (cdr pair) (list mode)))) + ;; No existing mode preference + (add-to-list 'mmm-major-mode-preferences (list language mode))))) + +(defun mmm-ensure-modename (symbol) + "Return SYMBOL if it is a valid submode name, else nil. +Valid submode names are either `fboundp' or present as the `car' of an +element in `mmm-major-mode-preferences'." + (if (or (fboundp symbol) + (assq symbol mmm-major-mode-preferences)) + symbol + nil)) + +(defun mmm-modename->function (mode) + "Convert MODE to a mode function, nil if impossible. +Valid submode names are either `fboundp' or present as the `car' of an +element in `mmm-major-mode-preferences'. In the latter case, the +first `fboundp' element of the `cdr' is returned, or nil if none." + (if (fboundp mode) + mode + (car (remove-if-not + #'fboundp + (cdr (assq mode mmm-major-mode-preferences)))))) + +;;}}} +;;{{{ Delimiter Regions + +(defcustom mmm-delimiter-mode 'fundamental-mode + "Major mode used by default for delimiter regions. +Classes are encouraged to override this by providing a delimiter-mode +parameter-- see `mmm-classes-alist'." + :group 'mmm + :type 'function) + +;;}}} +;;{{{ Key Bindings + +(defcustom mmm-mode-prefix-key [(control ?c) ?%] + "Prefix key for the MMM Minor Mode Keymap." + :group 'mmm + :type 'vector) + +(defcustom mmm-command-modifiers '(control) + "List of key modifiers for MMM command keys. +The MMM commands in the MMM Mode map, after `mmm-mode-prefix-key', +are bound to default keys with these modifiers added. This variable +must be set before MMM Mode is loaded to have an effect. + +It is suggested that the value of this variable be either nil or +\(control), as the default keys are either plain keys or have only a +meta modifier. The shift modifier is not particularly portable between +Emacsen. The values of this variable and `mmm-insert-modifiers' should +be disjoint." + :group 'mmm + :type '(repeat (symbol :tag "Modifier"))) + +(defcustom mmm-insert-modifiers '() + "List of key modifiers for MMM submode insertion keys. +When a key pressed after `mmm-mode-prefix-key' has no MMM Mode command +binding, and its modifiers include these, then its basic type, plus any +modifiers in addition to these, is looked up in classes' :insert +specifications. + +It is suggested that the value of this variable be either nil or +\(control), allowing submode classes to specify the presence or +absence of the meta modifier. The shift modifier is not particularly +portable between Emacsen. The values of `mmm-command-modifiers' and +this variable should be disjoint." + :group 'mmm + :type '(repeat (symbol :tag "Modifier"))) + +(defcustom mmm-use-old-command-keys nil + "Non-nil means to Use the old command keys for MMM Mode. +MMM Mode commands then have no modifier while insertion commands have +a control modifier, i.e. `mmm-command-modifiers' is set to nil and +`mmm-insert-modifiers' is set to \(control). If nil, the values of +these variables are as the default, or whatever the user has set them +to. This variable must be set before MMM Mode is loaded." + :group 'mmm + :type 'boolean) + +(defun mmm-use-old-command-keys () + "Use the old command keys \(no control modifer) in MMM Mode." + (setq mmm-command-modifiers '() + mmm-insert-modifiers '(control))) + +;;}}} +;;{{{ MMM Hooks + +(defcustom mmm-mode-hook () + "Hook run when MMM Mode is enabled in a buffer. + +A hook named mmm--hook is also run, if it exists. For +example, `mmm-html-mode-hook' is run whenever MMM Mode is entered with +HTML mode the dominant mode. + +A hook named mmm--submode-hook is run when a submode region +of a given mode is created. For example, `mmm-cperl-mode-submode-hook' +is run whenever a CPerl mode submode region is created, in any buffer. +When this hooks are run, point is guaranteed to be at the start of +the newly created submode region. + +Finally, a hook named mmm--class-hook is run whenever a buffer +is first mmm-ified with a given submode class. For example, +`mmm-mason-class-hook' is run whenever the `mason' class is first +applied in a buffer." + :group 'mmm + :type 'hook) + +(defun mmm-run-constructed-hook (body &optional suffix) + "Run the hook named `mmm---hook', if it exists. +If SUFFIX is nil or unsupplied, run `mmm--hook' instead." + (let ((hook (intern-soft (if suffix + (format "mmm-%s-%s-hook" body suffix) + (format "mmm-%s-hook" body))))) + (if hook (run-hooks hook)))) + +(defun mmm-run-major-hook () + (mmm-run-constructed-hook mmm-primary-mode)) + +(defun mmm-run-submode-hook (submode) + (mmm-run-constructed-hook submode "submode")) + +(defvar mmm-class-hooks-run () + "List of submode classes for which hooks have already been run in +the current buffer.") +(make-variable-buffer-local 'mmm-class-hooks-run) + +(defun mmm-run-class-hook (class) + (unless (member class mmm-class-hooks-run) + (mmm-run-constructed-hook class "class") + (add-to-list 'mmm-class-hooks-run class))) + +(defvar mmm-primary-mode-entry-hook nil + "Hook run when point moves into a region of the primary mode. +Each submode region can have an `entry-hook' property which is run +when they are entered, but since primary mode regions have no overlay +to store properties, this is a buffer-local variable. + +N.B. This variable is not a standard Emacs hook. Unlike Emacs' +\"local hooks\" it has *no* global value, only a local one. Its value +should always be a list of functions \(possibly empty) and never a +single function. It may be used with `add-hook', however.") +(make-variable-buffer-local 'mmm-primary-mode-entry-hook) + +;;}}} +;;{{{ Major Mode Hook + +(defcustom mmm-major-mode-hook () + "Hook run whenever a new major mode is finished starting up. +MMM Mode implements this with a hack \(see comments in the source) so +that `mmm-global-mode' will function correctly, but makes this hook +available so that others can take advantage of the hack as well. + +Note that file local variables have *not* been processed by the time +this hook is run. If a function needs to inspect them, it should also +be added to `find-file-hooks'. However, `find-file-hooks' is not run +when creating a non-file-based buffer, or when changing major modes in +an existing buffer." + :group 'mmm + :type 'hook) + +(defun mmm-run-major-mode-hook () + (dolist (func mmm-major-mode-hook) + (ignore-errors (funcall func)))) + +;;}}} +;;{{{ MMM Global Mode + +;;; There's a point to be made that this variable should default to +;;; `maybe' (i.e. not nil and not t), because that's what practically +;;; everyone wants. I subscribe, however, to the view that simply +;;; *loading* a lisp extension should not change the (user-visible) +;;; behavior of Emacs, until it is configured or turned on in some +;;; way, which dictates that the default for this must be nil. +(defcustom mmm-global-mode nil + "*Specify in which buffers to turn on MMM Mode automatically. + +- If nil, MMM Mode is never enabled automatically. +- If t, MMM Mode is enabled automatically in all buffers. +- If any other symbol, MMM mode is enabled only in those buffers that + have submode classes associated with them. See `mmm-classes' and + `mmm-mode-ext-classes-alist' for more information." + :group 'mmm + :type '(choice (const :tag "Always" t) + (const :tag "Never" nil) + (other :tag "Maybe" maybe)) + :require 'mmm-mode) + +;; These are not traditional editing modes, so mmm makes no sense, and +;; can mess things up seriously if it doesn't know not to try. +(defcustom mmm-never-modes + '( + help-mode + Info-mode + dired-mode + comint-mode + telnet-mode + shell-mode + eshell-mode + forms-mode + ) + "List of modes in which MMM Mode is never activated." + :group 'mmm + :type '(repeat (symbol :tag "Mode"))) + +;;}}} +;;{{{ Buffer File Name + +(defvar mmm-set-file-name-for-modes '(mew-draft-mode) + "List of modes for which the temporary buffers MMM creates have a +file name. In these modes, this file name is the same as that of the +parent buffer. In general, this has been found to cause more problems +than it solves, but some modes require it.") + +;;}}} + +;; NON-USER VARIABLES +;;{{{ Mode Variable + +(defvar mmm-mode nil + "Non-nil means MMM Mode is turned on in this buffer. +Do not set this variable directly; use the function `mmm-mode'.") +(make-variable-buffer-local 'mmm-mode) + +;;}}} +;;{{{ Primary Mode + +(defvar mmm-primary-mode nil + "The primary major mode in the current buffer.") +(make-variable-buffer-local 'mmm-primary-mode) + +;;}}} +;;{{{ Classes Alist + +;; Notes: +;; 1. :parent could be an all-class argument. Same with :keymap. +;; 2. :match-submode really does have to be distinct from :submode, +;; because 'functionp' isn't enough to distinguish which is meant. +(defvar mmm-classes-alist nil + "Alist containing all defined mmm submode classes. +A submode class is a named recipe for parsing a document into submode +regions, and sometimes for inserting new ones while editing. + +Each element of this alist looks like \(CLASS . ARGS) where CLASS is a +symbol naming the submode class and ARGS is a list of keyword +arguments, called a \"class specifier\". There are a large number of +accepted keyword arguments in the class specifier. + +The argument CLASSES, if supplied, must be a list of other submode +class names, or class specifiers, representing other classes to call +recursively. The FACE arguments of these classes are overridden by +the FACE argument of this class. If the argument CLASSES is supplied, +all other arguments to this class are ignored. That is, \"grouping\" +classes can do nothing but group other classes. + +The argument HANDLER, if supplied, also overrides any other processing. +It must be a function, and all the arguments are passed to it as +keywords, and it must do everything. See `mmm-ify' for what sorts of +things it must do. This back-door interface should be cleaned up. + +The optional argument FACE gives the display face of the submode +regions under high decoration (see `mmm-submode-decoration-level'). +It must be a valid face. The standard faces used for submode regions +are `mmm-*-submode-face' where * is one of `init', `cleanup', +`declaration', `comment', `output', `special', or `code'. A more +flexible alternative is the argument MATCH-FACE. MATCH-FACE can be a +function, which is called with one argument, the form of the front +delimiter \(found from FRONT-FORM, below), and should return the face +to use. It can also be an alist, with each element of the form +\(DELIM . FACE). + +If neither CLASSES nor HANDLER are supplied, either SUBMODE or +MATCH-SUBMODE must be. SUBMODE specifies the submode to use for the +submode regions, a symbol such as `cperl-mode' or `emacs-lisp-mode', +while MATCH-SUBMODE must be a function to be called immediately after +a match is found for FRONT, which is passed one argument, the form of +the front delimiter \(found from FRONT-FORM, below), and return a +symbol such as SUBMODE would be set to. If MATCH-SUBMODE detects an +invalid match--for example a specified mode which is not `fboundp'--it +should \(signal 'mmm-no-matching-submode nil). + +FRONT and BACK are the means to find the submode regions, and can be +either buffer positions \(number-or-markers), regular expressions, or +functions. If they are absolute buffer positions, only one submode +region is created, from FRONT to BACK. This is generally not used in +named classes. \(Unnamed classes are created by interactive commands +in `mmm-interactive-history'). + +If FRONT is a regexp, then that regexp is searched for, and the end of +its FRONT-MATCH'th match \(or the beginning thereof, if INCLUDE-FRONT +is non-nil), plus FRONT-OFFSET, becomes the beginning of the submode +region. If FRONT is a function, that function is called instead, and +must act somewhat like a search, in that it should start at point, +take one argument as a search bound, and set the match data. A +similar pattern is followed for BACK \(the search starts at the +beginning of the submode region), save that the beginning of its +BACK-MATCH'th match \(or the end, if INCLUDE-BACK is non-nil) becomes +the end of the submode region, plus BACK-OFFSET. + +If SAVE-MATCHES is non-nil, then BACK, if it is a regexp, is formatted +by replacing strings of the form \"~N\" by the corresponding value of +\(match-string n) after matching FRONT. + +FRONT-MATCH and BACK-MATCH default to zero. They specify which +sub-match of the FRONT and BACK regexps to treat as the delimiter. +This number will be passed to any calls to `match-beginning' and +company. + +FRONT- and BACK-OFFSET default to 0. In addition to numbers, they can +also be functions to call which should move point to the correct +position for the beginning or end of the submode region. Common +choices include `beginning-of-line' and `end-of-line', and new +functions can of course be written. They can also be lists which will +be applied in sequence, such as \(end-of-line 1) meaning move to end +of line and then forward one character. + +FRONT-VERIFY and BACK-VERIFY, if supplied, must be functions that +inspect the match data to see if a match found by FRONT or BACK +respectively is valid. + +FRONT-DELIM \(resp. BACK-DELIM), if supplied, can take values like +those of FRONT-OFFSET \(resp. BACK-OFFSET), specifying the offset from +the start \(resp. end) of the match for FRONT \(resp. BACK) to use as +the starting \(resp. ending) point for the front \(resp. back) +delimiter. If nil, it means not to make a region for the respective +delimiter at all. + +DELIMITER-MODE, if supplied, specifies what submode to use for the +delimiter regions, if any. If `nil', the primary mode is used. If +not supplied, `mmm-delimiter-mode' is used. + +FRONT-FACE and BACK-FACE specify faces to use for displaying the +delimiter regions, under high decoration. + +FRONT-FORM and BACK-FORM, if given, must supply a regexp used to match +the *actual* delimiter. If they are strings, they are used as-is. If +they are functions, they are called and must inspect the match data. +If they are lists, their `car' is taken as the delimiter. The default +for both is \(regexp-quote \(match-string 0)). + +The last case--them being a list--is usually used to set the delimiter +to a function. Such a function must take 1-2 arguments, the first +being the overlay in question, and the second meaning to insert the +delimiter and adjust the overlay rather than just matching the +delimiter. See `mmm-match-front', `mmm-match-back', and +`mmm-end-current-region'. + +CASE-FOLD-SEARCH, if specified, controls whether the search is +case-insensitive. See `case-fold-search'. It defaults to `t'. + +CREATION-HOOK, if specified, should be a function which is run +whenever a submode region is created, with point at the beginning of +the new region. One use for it is to set region-saved local variables +\(see `mmm-save-local-variables'). + +INSERT specifies the keypress insertion spec for such submode regions. +INSERT's value should be list of elements of the form \(KEY NAME . +SPEC). Each KEY should be either a character, a function key symbol, +or a dotted list \(MOD . KEY) where MOD is a symbol for a modifier +key. The use of any other modifier than meta is discouraged, as +`mmm-insert-modifiers' is sometimes set to \(control), and other +modifiers are not very portable. Each NAME should be a symbol +representing the insertion for that key. Each SPEC can be either a +skeleton, suitable for passing to `skeleton-insert' to create a +submode region, or a dotted pair \(OTHER-KEY . ARG) meaning to use the +skeleton defined for OTHER-KEY but pass it the argument ARG as the +`str' variable, possible replacing a prompt string. Skeletons for +insertion should have the symbol `_' where point \(or wrapped text) +should go, and the symbol `@' in four different places: at the +beginning of the front delimiter, the beginning of the submode region, +the end of the submode region, and the end of the back delimiter. + +If END-NOT-BEGIN is non-nil, it specifies that a BACK delimiter cannot +begin a new submode region. + +MATCH-NAME, if supplied, specifies how to determine the \"name\" for +each submode region. It must be a string or a function. If it is a +function, it is passed the value of FRONT-FORM and must return the +name to use. If it is a string, it is used as-is unless SAVE-NAME has +a non-nil value, in which case, the string is interpreted the same as +BACK when SAVE-MATCHES is non-nil. If MATCH-NAME is not specified, +the regions are unnamed. Regions with the same name are considered +part of the same chunk of code, and formatted as such, while unnamed +regions are not grouped with any others. + +As a special optimization for insertion, if SKEL-NAME is non-nil, the +insertion code will use the user-prompted string value as the region +name, instead of going through the normal matching procedure. + +PRIVATE, if supplied and non-nil, means that this class is a private +or internal class, usually one invoked by another class via :classes, +and is not for the user to see.") + +(defun mmm-add-classes (classes) + "Add the submode classes CLASSES to `mmm-classes-alist'." + (dolist (class classes) + (add-to-list 'mmm-classes-alist class))) + +(defun mmm-add-group (group classes) + "Add CLASSES and a \"grouping class\" named GROUP which calls them all. +The CLASSES are all made private, i.e. non-user-visible." + (mmm-add-classes (mapcar #'(lambda (class) + (append class + '(:private t))) + classes)) + (add-to-list 'mmm-classes-alist + (list group :classes (mapcar #'first classes)))) + +(defun mmm-add-to-group (group classes) + "Add CLASSES to the \"grouping class\" named GROUP. +The CLASSES are all made private, i.e. non-user-visible." + (mmm-add-classes (mapcar #'(lambda (class) + (append class + '(:private t))) + classes)) + (mmm-set-class-parameter group :classes + (append (mmm-get-class-parameter group :classes) + (mapcar #'first classes)))) + +;;}}} +;;{{{ Version Number + +(defconst mmm-version "0.4.8" + "Current version of MMM Mode.") + +(defun mmm-version () + (interactive) + (message "MMM Mode version %s by Michael Abraham Shulman" mmm-version)) + +;;}}} +;;{{{ Temp Buffer Name + +(defvar mmm-temp-buffer-name " *mmm-temp*" + "Name for temporary buffers created by MMM Mode.") + +;;}}} +;;{{{ Interactive History + +(defvar mmm-interactive-history nil + "History of interactive mmm-ification in the current buffer. +Elements are either submode class symbols or class specifications. See +`mmm-classes-alist' for more information.") +(make-variable-buffer-local 'mmm-interactive-history) + +(defun mmm-add-to-history (class) + (add-to-list 'mmm-interactive-history class)) + +(defun mmm-clear-history () + "Clears history of interactive mmm-ification in current buffer." + (interactive) + (setq mmm-interactive-history nil)) + +;;}}} +;;{{{ Mode/Ext Manipulation + +(defvar mmm-mode-ext-classes () + "List of classes associated with current buffer by mode and filename. +Set automatically from `mmm-mode-ext-classes-alist'.") +(make-variable-buffer-local 'mmm-mode-ext-classes) + +(defun mmm-get-mode-ext-classes () + "Return classes for current buffer from major mode and filename. +Uses `mmm-mode-ext-classes-alist' to find submode classes." + (or mmm-mode-ext-classes + (setq mmm-mode-ext-classes + (mapcar #'third + (remove-if-not #'mmm-mode-ext-applies + mmm-mode-ext-classes-alist))))) + +(defun mmm-clear-mode-ext-classes () + "Clear classes added by major mode and filename." + (setq mmm-mode-ext-classes nil)) + +(defun mmm-mode-ext-applies (element) + (destructuring-bind (mode ext class) element + (and (if mode + (eq mode + ;; If MMM is on in this buffer, use the primary mode, + ;; otherwise use the normal indicator. + (or mmm-primary-mode major-mode)) + t) + (if ext + (and (buffer-file-name) + (save-match-data + (string-match ext (buffer-file-name)))) + t)))) + +(defun mmm-get-all-classes (global) + "Return a list of all classes applicable to the current buffer. +These come from mode/ext associations, `mmm-classes', and interactive +history, as well as `mmm-global-classes' if GLOBAL is non-nil." + (append mmm-interactive-history + (if (listp mmm-classes) mmm-classes (list mmm-classes)) + (if global mmm-global-classes ()) + (mmm-get-mode-ext-classes))) + +;;}}} + +(provide 'mmm-vars) + +;;; mmm-vars.el ends here diff --git a/mmm-mode-0.4.8/mmm.info b/mmm-mode-0.4.8/mmm.info new file mode 100644 index 0000000..3ddf0ad --- /dev/null +++ b/mmm-mode-0.4.8/mmm.info @@ -0,0 +1,92 @@ +This is mmm.info, produced by makeinfo version 4.2 from mmm.texinfo. + +INFO-DIR-SECTION GNU Emacs Lisp +START-INFO-DIR-ENTRY +* MMM-Mode: (mmm). Multiple Major Modes for Emacs +END-INFO-DIR-ENTRY + + This is edition 0.4.8 of the MMM Mode Manual, last updated 9 March +2003. It documents version 0.4.8 of MMM Mode. + + Copyright 2000 Michael Abraham Shulman. + + Permission is granted to make and distribute verbatim copies of this +manual provided the copyright notice and this permission notice are +preserved on all copies. + + Permission is granted to copy and distribute modified versions of +this manual under the conditions for verbatim copying, provided also +that the sections entitled "Copying" and "GNU General Public License" +are included exactly as in the original, and provided that the entire +resulting derived work is distributed under the terms of a permission +notice identical to this one. + + Permission is granted to copy and distribute translations of this +manual into another language, under the above conditions for modified +versions, except that this permission notice may be stated in a +translation approved by the Free Software Foundation. + + +Indirect: +mmm.info-1: 1173 +mmm.info-2: 48220 + +Tag Table: +(Indirect) +Node: Top1173 +Node: Overview5225 +Ref: Overview-Footnote-17721 +Node: Basic Concepts7841 +Node: Installation10197 +Node: Quick Start12191 +Node: Basics14732 +Node: MMM Minor Mode15417 +Node: Enabling MMM Mode16105 +Node: MMM Mode Keys17364 +Node: Submode Classes19626 +Node: Selecting Classes20972 +Node: File Classes21803 +Node: Mode-Ext Classes22571 +Node: Global Classes24306 +Node: Insertion25812 +Node: Re-parsing27989 +Node: Interactive28236 +Node: Global Mode30827 +Node: Major Mode Hook32787 +Node: Customizing34483 +Node: Region Coloring35222 +Node: Preferred Modes37790 +Node: Mode Line39769 +Node: Key Bindings41318 +Node: Local Variables43058 +Node: Changing Classes44858 +Node: Hooks45893 +Node: Supplied Classes47351 +Node: Mason48220 +Node: File Variables51908 +Node: Here-documents52646 +Node: Javascript54084 +Node: Embedded CSS54608 +Node: Embperl55033 +Node: ePerl55461 +Node: JSP55846 +Node: RPM56226 +Node: Noweb56903 +Node: Writing Classes59711 +Node: Basic Classes60883 +Node: Paired Delimiters63438 +Node: Region Placement65138 +Node: Submode Groups68109 +Node: Calculated Submodes69809 +Node: Calculated Faces72033 +Node: Insertion Commands73679 +Node: Region Names76786 +Node: Other Hooks78136 +Node: Delimiters80178 +Node: Misc Keywords83921 +Node: Indices84316 +Node: Concept Index84604 +Node: Function Index87817 +Node: Keystroke Index89556 + +End Tag Table diff --git a/mmm-mode-0.4.8/mmm.info-1 b/mmm-mode-0.4.8/mmm.info-1 new file mode 100644 index 0000000..6b5d140 --- /dev/null +++ b/mmm-mode-0.4.8/mmm.info-1 @@ -0,0 +1,1084 @@ +This is mmm.info, produced by makeinfo version 4.2 from mmm.texinfo. + +INFO-DIR-SECTION GNU Emacs Lisp +START-INFO-DIR-ENTRY +* MMM-Mode: (mmm). Multiple Major Modes for Emacs +END-INFO-DIR-ENTRY + + This is edition 0.4.8 of the MMM Mode Manual, last updated 9 March +2003. It documents version 0.4.8 of MMM Mode. + + Copyright 2000 Michael Abraham Shulman. + + Permission is granted to make and distribute verbatim copies of this +manual provided the copyright notice and this permission notice are +preserved on all copies. + + Permission is granted to copy and distribute modified versions of +this manual under the conditions for verbatim copying, provided also +that the sections entitled "Copying" and "GNU General Public License" +are included exactly as in the original, and provided that the entire +resulting derived work is distributed under the terms of a permission +notice identical to this one. + + Permission is granted to copy and distribute translations of this +manual into another language, under the above conditions for modified +versions, except that this permission notice may be stated in a +translation approved by the Free Software Foundation. + + +File: mmm.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir) + +MMM Mode +******** + + MMM Mode is a minor mode for Emacs which allows Multiple Major Modes +to coexist in a single buffer. + + This is edition 0.4.8 of the MMM Mode Manual, last updated 9 March +2003, which documents version 0.4.8 of MMM Mode. + +* Menu: + +* Overview:: An overview and introduction to MMM Mode. +* Basics:: The basics of how to use it. +* Customizing:: Customizing how it works to your needs. +* Supplied Classes:: The supplied submode classes. +* Writing Classes:: Writing your own submode classes. +* Indices:: Just that. + + --- The Detailed Node Listing --- + +Overview of MMM Mode + +* Basic Concepts:: A simple explanation of how it works. +* Installation:: How to install MMM Mode. +* Quick Start:: Getting started using MMM Mode quickly. + +MMM Mode Basics + +* MMM Minor Mode:: The Emacs minor mode that manages it all. +* Submode Classes:: What they are and how to use them. +* Selecting Classes:: How MMM Mode knows what classes to use. +* Insertion:: Inserting new submode regions automatically. +* Re-parsing:: Re-scanning for submode regions. +* Interactive:: Adding submode regions manually. +* Global Mode:: Turning MMM Mode on automatically. + +The MMM Minor Mode + +* Enabling MMM Mode:: Turning MMM Mode on and off. +* MMM Mode Keys:: Default key bindings in MMM Mode. + +How MMM Mode selects submode classes + +* File Classes:: Classes for a single file. +* Mode-Ext Classes:: Classes for a given mode or extension. +* Global Classes:: Classes for all MMM Mode buffers. + +MMM Global Mode + +* Major Mode Hook:: Using MMM's Major Mode Hook + +Customizing MMM Mode + +* Region Coloring:: Changing or removing background colors. +* Preferred Modes:: Choosing which major modes to use. +* Mode Line:: What is displayed in the mode line. +* Key Bindings:: Customizing the MMM Mode key bindings. +* Local Variables:: What local variables are saved for submodes. +* Changing Classes:: Changing the supplied submode classes. +* Hooks:: How to make MMM Mode run your code. + +Supplied Submode Classes + +* Mason:: Mason server-side Perl in HTML. +* File Variables:: Elisp code in File Variables. +* Here-documents:: Code in shell and Perl here-documents. +* Javascript:: Javascript embedded in HTML. +* Embedded CSS:: CSS Styles embedded in HTML. +* Embperl:: Another syntax for Perl in HTML. +* ePerl:: A general Perl-embedding syntax. +* JSP:: Java code embedded in HTML. +* RPM:: Shell scripts in RPM Spec Files. +* Noweb:: Noweb literate programs. + +Writing Submode Classes + +* Basic Classes:: Writing a simple submode class. +* Paired Delimiters:: Matching paired delimiters. +* Region Placement:: Placing the region more accurately. +* Submode Groups:: Grouping several classes together. +* Calculated Submodes:: Deciding the submode at run-time. +* Calculated Faces:: Deciding the display face at run-time. +* Insertion Commands:: Inserting regions automatically. +* Region Names:: Naming regions for syntax grouping. +* Other Hooks:: Running code at arbitrary points. +* Delimiters:: Controlling delimiter overlays. +* Misc Keywords:: Other miscellaneous options. + +Indices + +* Concept Index:: Index of MMM Mode Concepts. +* Function Index:: Index of functions and variables. +* Keystroke Index:: Index of key bindings in MMM Mode. + + +File: mmm.info, Node: Overview, Next: Basics, Prev: Top, Up: Top + +Overview of MMM Mode +******************** + + MMM Mode is a minor mode for Emacs which allows Multiple Major Modes +to coexist in a single buffer. The name is an abbreviation of `Multiple +Major Modes'(1). A major mode is a customization of Emacs for editing a +certain type of text, such as code for a specific programming language. +*Note Major Modes: (emacs)Major Modes, for details. + + MMM Mode is a general extension to Emacs which is useful whenever one +file contains text in two or more programming languages, or that should +be in two or more different modes. For example: + + * CGI scripts written in any language, from Perl to PL/SQL, may want + to output verbatim HTML, and the writer of such scripts may want + to use Emacs' html-mode or sgml-mode to edit this HTML code, while + remaining in the appropriate programming language mode for the + rest of the file. *Note Here-documents::, for example. + + * There are now many "content delivery systems" which turn the CGI + script idea around and simply add extra commands to an HTML file, + often in some programming language, which are interpreted on the + server. *Note Mason::, *Note Embperl::, *Note ePerl::, *Note + JSP::. + + * HTML itself can also contain embedded languages such as Javascript + and CSS styles, for which Emacs has different major modes. *Note + Javascript::, and *Note Embedded CSS::, for example. + + * The idea of "literate programming" requires the same file to + contain documentation (written as text, html, latex, etc.) and + code (in an appropriate programming language). *Note Noweb::, for + example. + + * Emacs allows files of any type to contain `local variables', which + can include Emacs Lisp code to be evaluated. *Note File Variables: + (emacs)File Variables. It may be easier to edit this code in Emacs + Lisp mode than in whatever mode is used for the rest of the file. + *Note File Variables::. + + * There are many more possible uses for MMM Mode. RPM spec files can + contain shell scripts (*note RPM::). Email or newsgroup messages + may contain sample code. And so on. We encourage you to + experiment. + +* Menu: + +* Basic Concepts:: A simple explanation of how it works. +* Installation:: How to install MMM Mode. +* Quick Start:: Getting started using MMM Mode quickly. + + ---------- Footnotes ---------- + + (1) The name is derived from `mmm.el' for XEmacs by Gongquan Chen +, from which MMM Mode was adapted. + + +File: mmm.info, Node: Basic Concepts, Next: Installation, Prev: Overview, Up: Overview + +Basic Concepts +============== + + The way MMM Mode works is as follows. Each buffer has a "dominant" +or "default" major mode, which is chosen as major modes normally are: +the user can set it interactively, or it can be chosen automatically +with `auto-mode-alist' (*note Choosing Modes: (emacs)Choosing Modes.). +Within the file, MMM Mode creates "submode regions" within which other +major modes are in effect. While the point is in a submode region, the +following changes occur: + + 1. The local keymap is that of the submode. This means the key + bindings for the submode are available, while those of the + dominant mode are not. + + 2. The mode line (*note Mode Line: (emacs)Mode Line.) changes to show + which submode region is active. This can be configured; see *Note + Mode Line::. + + 3. The major mode menu, both on the menu bar and the mouse popup, are + that of the submode. + + 4. Some local variables of the submode shadow those of the default + mode (*note Local Variables::). For the user, this serves to help + make Emacs behave as if the submode were the major mode. + + 5. The syntax table and indentation are those of the submode. + + 6. Font-lock (*note Font Lock: (emacs)Font Lock.) fontifies correctly + for the submode. + + 7. The submode regions are highlighted by a background color; see + *Note Region Coloring::. + + + The submode regions are represented internally by Emacs Lisp objects +known as "overlays". Some of the above are implemented by overlay +properties, and others are updated by an MMM Mode function in +`post-command-hook'. You don't need to know this to use MMM Mode, but it +may make any error messages you come across more understandable. *Note +Overlays: (elisp)Overlays, for more information on overlays. + + Because overlays are not saved with a file, every time a file is +opened, they must be created. Creating submode regions is occasionally +referred to as "mmm-ification". (I've never had occasion to pronounce +this, but if I did I would probably say `mummification'. Like what they +did in ancient Egypt.) You can mmm-ify a buffer interactively, but +most often MMM Mode will find and create submode regions automatically +based on a buffer's file extension, dominant mode, or local variables. + + +File: mmm.info, Node: Installation, Next: Quick Start, Prev: Basic Concepts, Up: Overview + +Installing MMM Mode +=================== + + MMM Mode has a standard installation process. See the file INSTALL +for generic information on this process. To summarize, unpack the +archive, `cd' to the created MMM Mode directory, type `./configure', +then `make', then `make install'. If all goes correctly, this will +compile the MMM Mode elisp files, install them in your local site-lisp +directory, and install the MMM Mode info file `mmm.info' in your local +info directory. + + Now you need to configure your Emacs initialization file (usually +`~/.emacs') to use MMM Mode. First, Emacs has to know where to find +MMM Mode. In other words, the MMM Mode directory has to be in +`load-path'. This can be done in the parent directory's `subdirs.el' +file, or in the init file with a line such as: + + (add-to-list 'load-path "/path/to/site-lisp/mmm/") + + Once `load-path' is configured, MMM Mode must be loaded. You can +load all of MMM Mode with the line + + (require 'mmm-mode) + +but if you use MMM Mode only rarely, it may not be desirable to load all +of it at the beginning of every editing session. You can load just +enough of MMM Mode so it will turn itself on when necessary and load the +rest of itself, by using instead the line + + (require 'mmm-auto) + +in your initialization file. + + One more thing you may want to do right now is to set the variable +`mmm-global-mode'. If this variable is `nil' (the default), MMM Mode +will never turn itself on. If it is `t', MMM Mode will turn itself on +in every buffer. Probably the most useful value for it, however, is +the symbol `maybe' (actually, anything that is not `nil' and not `t'), +which causes MMM Mode to turn itself on in precisely those buffers +where it would be useful. You can do this with a line such as: + + (setq mmm-global-mode 'maybe) + +in your initialization file. *Note Global Mode::, for more detailed +information. + + +File: mmm.info, Node: Quick Start, Prev: Installation, Up: Overview + +Getting Started Quickly +======================= + + Perhaps the simplest way to create submode regions is to do it +interactively by specifying a region. First you must turn MMM Mode +on--say, with `M-x mmm-mode'--then place point and mark around the area +you want to make into a submode region, type `C-c % C-r', and enter the +desired major mode. *Note Interactive::, for more details. + + A better way to add submode regions is by using submode classes, +which store a lot of useful information for MMM Mode about how to add +and manipulate the regions created. *Note Submode Classes::, for more +details. There are several sample submode classes that come with MMM +Mode, which are documented later in this manual. Look through these and +determine if one of them fits your needs. If so, I suggest reading the +comments on that mode. Then come back here to find out to use it. + + To apply a submode class to a buffer interactively, turn MMM Mode on +as above, then type `C-c % C-c' and enter the name of the class. +Submode regions should be added automatically, if there are any regions +in the buffer appropriate to the submode class. + + If you want a given file to always use a given submode class, you can +express this in a file variable: add a line containing the string `-*- +mmm-classes: CLASS -*-' at the top of the file. *Note File Variables: +(emacs)File Variables, for more information and other methods. Now +whenever MMM Mode is turned on in that file, it will be mmm-ified +according to CLASS. If `mmm-global-mode' is non-nil, then MMM Mode will +turn itself on whenever a file with a `mmm-classes' local variable is +opened. *Note Global Mode::, for more information. + + If you want a submode class to apply to _all_ files in a certain +major mode or with a certain extension, add a line such as this to your +initialization file: + + (mmm-add-mode-ext-class MODE EXTENSION CLASS) + +After this call, any file opened whose name matches the regular +expression EXTENSION _and_ whose default mode is MODE will be +automatically mmm-ified according to CLASS (assuming `mmm-global-mode' +is non-nil). If one of EXTENSION or MODE is `nil', a file need only +satisfy the other one to be mmm-ified. + + You can now read the rest of this manual to learn more about how MMM +Mode works and how to configure it to your preferences. If none of the +supplied submode classes fit your needs, then you can try to write your +own. *Note Writing Classes::, for more information. + + +File: mmm.info, Node: Basics, Next: Customizing, Prev: Overview, Up: Top + +MMM Mode Basics +*************** + + This chapter explains the most important parts of how to use MMM +Mode. + +* Menu: + +* MMM Minor Mode:: The Emacs minor mode that manages it all. +* Submode Classes:: What they are and how to use them. +* Selecting Classes:: How MMM Mode knows what classes to use. +* Insertion:: Inserting new submode regions automatically. +* Re-parsing:: Re-scanning for submode regions. +* Interactive:: Adding submode regions manually. +* Global Mode:: Turning MMM Mode on automatically. + + +File: mmm.info, Node: MMM Minor Mode, Next: Submode Classes, Prev: Basics, Up: Basics + +The MMM Minor Mode +================== + + An Emacs minor mode is an optional feature which can be turned on or +off in a given buffer, independently of the major mode. *Note Minor +Modes: (emacs)Minor Modes. MMM Mode is implemented as a minor mode +which manages the submode regions. This minor mode must be turned on in +a buffer for submode regions to be effective. When activated, the MMM +Minor mode is denoted by `MMM' in the mode line (*note Mode Line::). + +* Menu: + +* Enabling MMM Mode:: Turning MMM Mode on and off. +* MMM Mode Keys:: Default key bindings in MMM Mode. + + +File: mmm.info, Node: Enabling MMM Mode, Next: MMM Mode Keys, Prev: MMM Minor Mode, Up: MMM Minor Mode + +Enabling MMM Mode +----------------- + + If `mmm-global-mode' is non-`nil' (*note Global Mode::), then the +MMM minor mode will be turned on automatically whenever a file with +associated submode classes is opened (*note Selecting Classes::). It +is also turned on by interactive mmm-ification (*note Interactive::), +although the interactive commands do not have key bindings when it is +not on and must be invoked via `M-x'. You can also turn it on (or off) +manually with `M-x mmm-mode', in which case it applies all submode +classes associated with the buffer. Turning MMM Mode off automatically +removes all submode regions from the buffer. + + - Command: mmm-mode ARG + Toggle the state of MMM Mode in the current buffer. If ARG is + supplied, turn MMM Mode on if and only if ARG is positive. + + - Function: mmm-mode-on + Turn MMM Mode on unconditionally in the current buffer. + + - Function: mmm-mode-off + Turn MMM Mode off unconditionally in the current buffer. + + - Variable: mmm-mode + This variable represents whether MMM Mode is on in the current + buffer. Do not set this variable directly; use one of the above + functions. + + +File: mmm.info, Node: MMM Mode Keys, Prev: Enabling MMM Mode, Up: MMM Minor Mode + +Key Bindings in MMM Mode +------------------------ + + When MMM Mode is on, it defines a number of key bindings. By default, +these are bound after the prefix sequence `C-c %'. Minor mode keymaps +are supposed to use `C-c PUNCTUATION' sequences, and I find this one to +be a good mnemonic because `%' is used by Mason to denote special tags. +This prefix key can be customized; *Note Key Bindings::. + + There are two types of key bindings in MMM Mode: "commands" and +"insertions". Command bindings run MMM Mode interactive functions to do +things like re-parse the buffer or end the current submode region, and +are defined statically as normal Emacs key-bindings. Insertion bindings +insert submode region skeletons with delimiters into the buffer, and +are defined dynamically, according to which submode classes (*note +Submode Classes::) are in effect, via a keymap default binding. + + To distinguish between the two, MMM Mode uses distinct modifier keys +for each. By default, command bindings use the control key (e.g. `C-c % +C-b' re-parses the buffer), and insertion bindings do not (e.g. `C-c % +p', when the Mason class is in effect, inserts a `<%perl>...' +region). This makes the command bindings different from in previous +versions, however, so the variable `mmm-use-old-bindings' is provided. +If this variable is set to `t' before MMM Mode is loaded, the bindings +will be reversed: insertion bindings will use the control key and +command bindings will not. + + Normally, Emacs gives help on a prefix command if you type `C-h' +after that command (e.g. `C-x C-h' displays all key bindings starting +with `C-x'). Because of how insertion bindings are implemented +dynamically with a default binding, they do not show up when you hit +`C-c % C-h'. For this reason, MMM Mode defines the command `C-c % h' +which displays a list of all currently valid insertion key sequences. +If you use the defaults for command and insertion bindings, the `C-h' +and `h' should be mnemonic. + + In the rest of this manual, I will assume you are using the defaults +for the mode prefix (`C-c %') and the command and insertion modifiers. +You can customize them, however; *Note Key Bindings::. + + +File: mmm.info, Node: Submode Classes, Next: Selecting Classes, Prev: MMM Minor Mode, Up: Basics + +Understanding Submode Classes +============================= + + A submode class represents a "type" of submode region. It specifies +how to find the regions, what their delimiters look like, what submode +they should be, how to insert them, and how they behave in other ways. +It is represented by a symbol, such as `mason' or `eval-elisp'. + + For example, in the Mason set of classes, there is one class +representing all `<%...%>' inline Perl regions, and one representing +regions such as `<%perl>...', `<%init>...', and so on. +These are different to Mason, but to Emacs they are all just Perl +sections, so they are covered by the same submode class. + + But it would be tedious if whenever we wanted to use the Mason +classes, we had to specify both of these. (Actually, this is a +simplification: there are some half a dozen Mason submode classes.) So +submode classes can also "group" others together, and we can refer to +the `mason' class and mean all of them. + + The way a submode class is used is to "apply" it to a buffer. This +scans the buffer for regions which should be submode regions according +to that class, and also remembers the class for later, so that new +submode regions can be inserted and scanned for later. + + +File: mmm.info, Node: Selecting Classes, Next: Insertion, Prev: Submode Classes, Up: Basics + +How MMM Mode selects submode classes +==================================== + + Submode classes that apply to a buffer come from three sources: +mode/extension-associated classes, file-local classes, and interactive +MMM-ification (*note Interactive::). Whenever MMM Mode is turned on in a +buffer (*note MMM Minor Mode::, and *Note Global Mode::), it inspects +the value of two variables to determine which classes to automatically +apply to the buffer. This covers the first two sources; the latter is +covered in a later chapter. + +* Menu: + +* File Classes:: Classes for a single file. +* Mode-Ext Classes:: Classes for a given mode or extension. +* Global Classes:: Classes for all MMM Mode buffers. + + +File: mmm.info, Node: File Classes, Next: Mode-Ext Classes, Prev: Selecting Classes, Up: Selecting Classes + +File-Local Submode Classes +-------------------------- + + - Variable: mmm-classes + This variable is always buffer-local when set. Its value should be + either a single symbol or a list of symbols. Each symbol + represents a submode class that is applied to the buffer. + + `mmm-classes' is usually set in a file local variables list. *Note +File Variables: (emacs)File Variables. The easiest way to do this is +for the first line of the file to contain the string `-*- mmm-classes: +CLASSES -*-', where CLASSES is the desired value of `mmm-classes' for +the file in question. It can also be done with a local variables list +at the end of the file. + + +File: mmm.info, Node: Mode-Ext Classes, Next: Global Classes, Prev: File Classes, Up: Selecting Classes + +Submode Classes Associated with Modes and Extensions +---------------------------------------------------- + + - User Option: mmm-mode-ext-classes-alist + This global variable associates certain submode classes with major + modes and/or file extensions. Its value is a list of elements of + the form `(MODE EXT CLASS)'. Any buffer whose major mode is MODE + (a symbol) _and_ whose file name matches EXT (a regular + expression) will automatically have the submode class CLASS + applied to it. + + If MODE is `nil', then only EXT is considered to determine if a + buffer fits the criteria, and vice versa. Thus if both MODE and + EXT are nil, then CLASS is applied to _all_ buffers in which MMM + Mode is on. Note that EXT can be any regular expression, although + its name indicates that it most often refers to the file extension. + + If CLASS is the symbol `t', then no submode class is actually + applied for this association. However, if `mmm-global-mode' is + non-`nil' and non-`t', MMM Mode will be turned on in matching + buffers even if there are no actual submode classes being applied. + *Note Global Mode::. + + - Function: mmm-add-mode-ext-class MODE EXT CLASS + This function adds an element to `mmm-mode-ext-classes-alist', + associating the submode class CLASS with the major mode MODE and + extension EXT. + + Older versions of MMM Mode required this function to be used to + control the value of `mmm-mode-ext-classes-alist', rather than + setting it directly. In this version it is provided purely for + convenience and backward compatibility. + + +File: mmm.info, Node: Global Classes, Prev: Mode-Ext Classes, Up: Selecting Classes + +Globally Applied Classes and the Universal Class +------------------------------------------------ + + In addition to file-local and mode-ext-associated submode classes, +MMM Mode also allows you to specify that certain submode classes apply +to _all_ buffers in which MMM Mode is enabled. + + - User Option: mmm-global-classes + This variable's value should be a list of submode classes that + apply to all buffers with MMM Mode on. It can be overriden in a + file local variables list, such as to disable global class for a + specific file. Its default value is `(universal)'. + + The default global class is the "universal class", which is defined +in the file `mmm-univ.el' (loaded automatically), and allows the author +of text to specify that a certain section of it be in a specific major +mode. Thus, for example, when writing an email message that includes +sample code, the author can allow readers of the message (who use emacs +and MMM) to view the code in the appropriate major mode. The syntax +used is `{%MODE%} ... {%/MODE%}', where MODE should be the name of the +major mode, with or without the customary `-mode' suffix: for example, +both `cperl' and `cperl-mode' are acceptable. + + The universal class also defines an insertion key, `/', which +prompts for the submode to use. *Note Insertion::. The universal class +is most useful when `mmm-global-mode' is set to `t'; *Note Global +Mode::. + + +File: mmm.info, Node: Insertion, Next: Re-parsing, Prev: Selecting Classes, Up: Basics + +Inserting new submode regions +============================= + + So much for noticing submode regions already present when you open a +file. When editing a file with MMM Mode on, you will often want to add a +new submode region. MMM Mode provides several facilities to help you. +The simplest is to just hit a few keys and have the region and its +delimiters inserted for you. + + Each submode class can define an association of keystrokes with +"skeletons" to insert a submode region. If there are several submode +classes enabled in a buffer, it is conceivable that the keys they use +for insertion might conflict, but unlikely as most buffers will not use +more than one or two submode classes groups. + + As an example of how insertion works, consider the Mason classes. In +a buffer with MMM Mode enabled and Mason associated, the key sequence +`C-c % p' inserts the following perl section (the semicolon is to +prevent CPerl Mode from getting confused--*note Mason::): + + <%perl>-<-; + -!- + ->- + + In this schematic representation, the string `-!-' represents the +position of point (the cursor), `-<-' represents the beginning of the +submode region, and `->-' its end. + + All insertion keys come after the MMM Mode prefix keys (by default +`C-c %'; *note Key Bindings::) and are by default single characters +such as `p', `%', and `i'. To avoid confusion, all the MMM Mode +commands are bound by default to control characters (after the same +prefix keys), such as `C-b', `C-%' and `C-r'. This is a change from +earlier versions of MMM Mode, and can be customized; see *Note Key +Bindings::. + + To find out what insertion keys are available, consult the +documentation for the submode class you are using. If it is one of the +classes supplied with MMM Mode, you can find it in this Info file. + + Because insertion keys are implemented with a "default binding" for +flexibility, they do not show up in the output of `C-h m' and cannot be +found with `C-h k'. For this reason, MMM Mode supplies the command `C-c +% h' (`mmm-insertion-help' to view the available insertion keys. + + +File: mmm.info, Node: Re-parsing, Next: Interactive, Prev: Insertion, Up: Basics + +Re-Parsing Submode Regions +========================== + + Describe `mmm-parse-buffer', `mmm-parse-region', `mmm-parse-block', +and `mmm-clear-current-region'. + + +File: mmm.info, Node: Interactive, Next: Global Mode, Prev: Re-parsing, Up: Basics + +Interactive MMM-ification Functions +=================================== + + There are several commands you can use to create submode regions +interactively, rather than by applying a submode class to a buffer. +These commands (in particular, `mmm-ify-region'), can be useful when +editing a file or email message containing a snippet of code in some +other language. Also see *Note Global Classes::, for an alternate +approach to the same problem. + +`C-c % C-r' + Creates a submode region between point and mark. Prompts for the + submode to use, which must be a valid Emacs major mode name, such + as `emacs-lisp-mode' or `cperl-mode'. Adds markers to the + interactive history. (`mmm-ify-region') + +`C-c % C-c' + Applies an already-defined submode class to the buffer, which it + prompts for. Adds this class to the interactive history. + (`mmm-ify-by-class') + +`C-c % C-x' + Scans the buffer for submode regions (prompts for the submode) + using front and back regular expressions that it also prompts for. + Briefly, it starts at the beginning of the buffer and searches for + the front regexp. If it finds a match, it searches for the back + regexp. If it finds a match for that as well, it makes a submode + region between the two matches and continues searching until no + more matches are found. Adds the regexps to the interactive + history. (`mmm-ify-by-regexp') + + These commands are also useful when designing a new submode class +(*note Submode Classes::). Working with the regexps interactively can +make it easier to debug and tune the class before starting to use it on +automatic. All these commands also add to value of the following +variable. + + - Variable: mmm-interactive-history + Stores a history of all interactive mmm-ification that has been + performed in the current buffer. This way, for example, the + re-parsing functions (*note Re-parsing::) will respect + interactively added regions, and the insertion keys for classes + that were added interactively are available. + + If for any reason you want to "wipe the slate clean", this command +should help you. By default, it has no key binding, so you must invoke +it with `M-x mmm-clear-history '. + + - Command: mmm-clear-history + Clears all history of interactive mmm-ification in the current + buffer. This command does not affect existing submode regions; to + remove them, you may want to re-parse the buffer with `C-c % C-b' + (`mmm-parse-buffer'). + + +File: mmm.info, Node: Global Mode, Prev: Interactive, Up: Basics + +MMM Global Mode +=============== + + When a file has associated submode classes (*note Selecting +Classes::), you may want MMM Mode to turn itself on and parse that file +for submode regions automatically whenever it is opened in an Emacs +buffer. The value of the following variable controls when MMM Mode +turns itself on automatically. + + - User Option: mmm-global-mode + Do not be misled by the fact that this variable's name ends in + `-mode': it is not a simple on/off switch. There are three possible + (meanings of) values for it: `t', `nil', and anything else. + + When this variable is `nil', MMM Mode is never enabled + automatically. If it is enabled manually, such as by typing `M-x + mmm-mode', any submode classes associated with the buffer will + still be used, however. + + When this variable is `t', MMM Mode is enabled automatically in + _all_ buffers, including those not visiting files, except those + whose major mode is an element of `mmm-never-modes'. The default + value of this variable contains modes such as `help-mode' and + `dired-mode' in which most users would never want MMM Mode, and in + which MMM might cause problems. + + When this variable is neither `nil' nor `t', MMM Mode is enabled + automatically in all buffers that would have associated submode + classes; i.e. only if there would be something for it to do. The + value of `mmm-never-modes' is still respected, however. Note that + this can include buffers not visiting files, if that buffer's + major mode is present in `mmm-mode-ext-classes-alist' with a `nil' + value for EXT (*note Mode-Ext Classes::). Submode class values of + `t' in `mmm-mode-ext-classes-alist' cause MMM Mode to be enabled in + matching buffers, but supply no submode classes to be applied. + +* Menu: + +* Major Mode Hook:: Using MMM's Major Mode Hook + + +File: mmm.info, Node: Major Mode Hook, Prev: Global Mode, Up: Global Mode + +The Major Mode Hook +------------------- + + This section is intended for users who understand Emacs Lisp and +want to know how MMM Global Mode is implemented, and perhaps use the +same technique. In fact, MMM Mode exports a hook variable that you can +use easily, without understanding any of the details--see below. + + In order to enable itself in _all_ buffers, however, MMM Mode has to +hook itself into all major modes. Global Font Lock Mode from the +standard Emacs distribution (*note Font Lock: (emacs)Font Lock.) has a +similar problem, and solves it by adding a function to +`change-major-mode-hook', which is run by `kill-all-local-variables', +which is run in turn by all major mode functions at the _beginning_. +This function stores a list of which buffers need fontification. It +then adds a different function to `post-command-hook', which checks if +the current buffer needs fontification, and if so performs it. MMM +Global Mode uses the same technique. + + In the interests of generality, and for your use, the function that +MMM Mode runs in `post-command-hook' (`mmm-run-major-mode-hook') is not +specific to MMM Mode, but rather runs the hook variable +`mmm-major-mode-hook', which by default contains a function +(`mmm-mode-on-maybe') which possibly turns MMM Mode on, depending on +the value of `mmm-global-mode'. Thus, to run another function in all +major modes, all you need to do is add it to this hook. For example, +the following line in an initialization file will turn on Auto Fill +Mode (*note Auto Fill: (emacs)Auto Fill.) in all buffers: + + (add-hook 'mmm-major-mode-hook 'turn-on-auto-fill) + + +File: mmm.info, Node: Customizing, Next: Supplied Classes, Prev: Basics, Up: Top + +Customizing MMM Mode +******************** + + This chapter explains how to customize the appearance and +functioning of MMM Mode however you want. + +* Menu: + +* Region Coloring:: Changing or removing background colors. +* Preferred Modes:: Choosing which major modes to use. +* Mode Line:: What is displayed in the mode line. +* Key Bindings:: Customizing the MMM Mode key bindings. +* Local Variables:: What local variables are saved for submodes. +* Changing Classes:: Changing the supplied submode classes. +* Hooks:: How to make MMM Mode run your code. + + +File: mmm.info, Node: Region Coloring, Next: Preferred Modes, Prev: Customizing, Up: Customizing + +Customizing Region Coloring +=========================== + + By default, MMM Mode highlights all submode regions with a background +color. There are three levels of this decoration, controlled by the +following variable: + + - User Option: mmm-submode-decoration-level + This variable controls the level of coloring of submode regions. + It should be one of the integers 0, 1, or 2, representing + (respectively) none, low, and high coloring. + + No coloring means exactly that. Submode regions have the same +background as the rest of the text. This produces the minimal +interference with font-lock coloration. In particular, if you want to +use background colors for font-lock, this may be a good idea, because +the submode highlight, if present, overrides any font-lock background +coloring. + + Low coloring uses the same background color for all submode regions. +This color is specified with the face `mmm-default-submode-face' (*note +Faces: (emacs)Faces.) which can be customized, either through the Emacs +"customize" interface or using direct Lisp commands such as +`set-face-background'. Of course, other aspects of the face can also +be set, such as the foreground color, bold, underline, etc. These are +more likely to conflict with font-lock, however, so only a background +color is recommended. + + High coloring uses multiple background colors, depending on the +function of the submode region. The recognized functions and their +meanings are as follows: + +`init' + Code that is executed at the beginning of (something), as + initialization of some sort. + +`cleanup' + Code that is executed at the end of (something), as some sort of + clean up facility. + +`declaration' + Code that provides declarations of some sort, perhaps global or + local arguments, variables, or methods. + +`comment' + Text that is not executed as code, but instead serves to document + the code around it. Submode regions of this function often use a + mode such as Text Mode rather than a programming language mode. + +`output' + An expression that is evaluated and its value interpolated into the + output produced. + +`code' + Executed code not falling under any other category. + +`special' + Submode regions not falling under any other category, such as + component calls. + + The different background colors are provided by the faces +`mmm-FUNCTION-submode-face', which can be customized in the same way as +`mmm-default-submode-face'. + + +File: mmm.info, Node: Preferred Modes, Next: Mode Line, Prev: Region Coloring, Up: Customizing + +Preferred Major Modes +===================== + + Certain of the supplied submode classes know only the language that +certain sections are written in, but not what major mode you prefer to +use to edit such code. For example, many people prefer CPerl mode over +Perl mode; you may have a special mode for Javascript or just use C++ +mode. This variable allows you to tell submodes such as Mason (*note +Mason::) and Embedded Javascript (*note Javascript::) what major mode +to use for the submodes: + + - User Option: mmm-major-mode-preferences + The elements of this list are cons cells of the form `(LANGUAGE . + MODE)'. LANGUAGE should be a symbol such as `perl', `html-js', or + `java', while MODE should be the name of a major mode such as + `perl-mode', `cperl-mode', `javascript-mode', or `c++-mode'. + + You probably won't have to set this variable at all; MMM tries to + make intelligent guesses about what modes you prefer. For + example, if a function called `javascript-mode' exists, it is + chosen, otherwise `c++-mode' is used. Similarly for `jde-mode' and + `java-mode'. + + If you do need to change the defaults, you may find the following +function convenient. + + - Function: mmm-set-major-mode-preferences LANGUAGE MODE &optional + DEFAULT + Set the preferred major mode for LANGUAGE to MODE. If there is + already a mode specified for LANGUAGE, and DEFAULT is nil or + unsupplied, then it is changed. If DEFAULT is non-nil, then any + existing mode is unchanged. This is used by packages to ensure + that some mode is present, but not override any user-specified + mode. If you are not writing a submode class, you should ignore + the third argument. + + Thus, for example, to use `my-java-mode' for Java code, you would +use the following line: + + (mmm-set-major-mode-preferences 'java 'my-java-mode) + + +File: mmm.info, Node: Mode Line, Next: Key Bindings, Prev: Preferred Modes, Up: Customizing + +Customizing the Mode Line Display +================================= + + By default, when in a submode region, MMM Mode changes the section of +the mode line (*note Mode Line: (emacs)Mode Line.) that normally +displays the major mode name--for example, `HTML'--to instead show both +the dominant major mode and the currently active submode--for example, +`HTML[CPerl]'. You can change this format, however. + + - User Option: mmm-submode-mode-line-format + The value of this variable should be a string containing one or + both of the escape sequences `~M' and `~m'. The string displayed + in the major mode section of the mode line when in a submode is + obtained by replacing all occurrences of `~M' with the dominant + major mode name and `~m' with the currently active submode name. + For example, to display only the currently active submode, set + this variable to `~m'. The default value is `~M[~m]'. + + The MMM minor mode also normally displays the string `MMM' in the +minor mode section of the mode line to indicate when it is active. You +can customize or disable this as well. + + - User Option: mmm-mode-string + This string is displayed in the minor mode section of the mode + line when the MMM minor mode is active. If nonempty, it should + begin with a space to separate the MMM indicator from that of + other minor modes. To eliminate the indicator entirely, set this + variable to the empty string. + + +File: mmm.info, Node: Key Bindings, Next: Local Variables, Prev: Mode Line, Up: Customizing + +Customizing the MMM Mode Key Bindings +===================================== + + The default MMM Mode key bindings are explained in *Note MMM Mode +Keys::, and in *Note Insertion::. There are a couple of ways to +customize these bindings. + + - User Option: mmm-mode-prefix-key + The value of this variable (default is `C-c %') should be a key + sequence to use as the prefix for the MMM Mode keymap. Minor modes + typically use `C-c' followed by a punctuation character, but you + can change it to any user-available key sequence. To have an + effect, this variable should be set before MMM Mode is loaded. + + - User Option: mmm-use-old-command-keys + When this variable is `nil', MMM Mode commands use the control + modifier and insertion keys no modifier. Any other value switches + the two, so that `mmm-parse-buffer', for example, is bound to `C-c + % b', while perl-section insertion in the Mason class is bound to + `C-c % C-p'. This variable should be set before MMM Mode is loaded + to have an effect. + + When MMM is loaded, it uses the value of `mmm-use-old-command-keys' +to set the values of the variables `mmm-command-modifiers' and +`mmm-insert-modifiers', so if you prefer you can set these variables +instead. They should each be a list of key modifiers, such as +`(control)' or `()'. The Meta modifier is used in some of the command +and insertion keys, so it should not be used, and the Shift modifier is +not particularly portable between Emacsen--if it works for you, feel +free to use it. Other modifiers, such as Hyper and Super, are not +universally available, but are valid when present. + + +File: mmm.info, Node: Local Variables, Next: Changing Classes, Prev: Key Bindings, Up: Customizing + +Changing Saved Local Variables +============================== + + A lot of the functionality of MMM Mode--that which makes the major +mode appear to change--is implemented by saving and restoring the +values of local variables, or pseudo-variables. You can customize what +variables are saved, and how, with the following variable. + + - Variable: mmm-save-local-variables + At its simplest, this is a list each of whose elements is a + buffer-local variable whose value is saved and restored for each + major mode. Each elements can also, however, be a list whose + first element is the variable symbol and whose subsequent elements + specify how and where the variable is to be saved. The second + element of the list, if present, should be one of the symbols + `global', `buffer', or `region'. If not present, the default + value is `global'. The third element, if present, should be a + list of major mode symbols in which to save the variable. In the + list form, the variable symbol itself can be replaced with a cons + cell of two functions, one to get the value and one to set the + value. This is called a "pseudo-variable". + + Globally saved variables are the same in all (MMM-controlled) buffers +and submode regions of each major mode listed in the third argument, or +all major modes if it is `t' or not present. Buffer-saved variables +are the same in all submode regions of a given major mode in each +buffer, and region-saved variables can be different for each submode +region. + + Pseudo-variables are used, for example, to save and restore the +syntax table (*note Syntax: (emacs)Syntax.) and mode keymaps (*note +Keymaps: (emacs)Keymaps.). + + +File: mmm.info, Node: Changing Classes, Next: Hooks, Prev: Local Variables, Up: Customizing + +Changing the Supplied Submode Classes +===================================== + + If you need to use MMM with a syntax for which a submode class is not +supplied, and you have some facility with Emacs Lisp, you can write your +own; see *Note Writing Classes::. However, sometimes you will only want +to make a slight change to one of the supplied submode classes. You can +do this, after that class is loaded, with the following functions. + + - Function: mmm-set-class-parameter CLASS PARAM VALUE + Set the value of the keyword parameter PARAM of the submode class + CLASS to VALUE. *Note Writing Classes::, for an explanation of + the meaning of each keyword parameter. This creates a new + parameter if one is not already present in the class. + + - Function: mmm-get-class-parameter CLASS PARAM + Get the value of the keyword parameter PARAM for the submode class + CLASS. Returns `nil' if there is no such parameter. + + +File: mmm.info, Node: Hooks, Prev: Changing Classes, Up: Customizing + +Hooks Provided by MMM Mode +========================== + + MMM Mode defines several hook variables (*note Hooks: (emacs)Hooks.) +which are run at different times. The most often used is +`mmm-major-mode-hook' which is described in *Note Major Mode Hook::, +but there are a couple others. + + - Variable: mmm-mode-hook + This normal hook is run whenever MMM Mode is enabled in a buffer. + + - Variable: mmm-MAJOR-MODE-hook + This is actually a whole set of hook variables, a different one for + every major mode. Whenever MMM Mode is enabled in a buffer, the + corresponding hook variable for the dominant major mode is run. + + - Variable: mmm-SUBMODE-submode-hook + Again, this is a set of one hook variable per major mode. These + hooks are run whenever a submode region of the corresponding major + mode is created in any buffer, with point at the start of the new + submode region. + + - Variable: mmm-CLASS-class-hook + This is a set of one hook variable per submode class. These hooks + are run when a submode class is first applied to a given buffer. + + Submode classes also have a `:creation-hook' parameter which should +be a function to run whenever a submode region is created with that +class, with point at the beginning of the submode region. This can be +set for supplied submode classes with `mmm-set-class-parameter'; *Note +Changing Classes::. + + +File: mmm.info, Node: Supplied Classes, Next: Writing Classes, Prev: Customizing, Up: Top + +Supplied Submode Classes +************************ + + This chapter describes the submode classes that are supplied with MMM +Mode. + +* Menu: + +* Mason:: Mason server-side Perl in HTML. +* File Variables:: Elisp code in File Variables. +* Here-documents:: Code in shell and Perl here-documents. +* Javascript:: Javascript embedded in HTML. +* Embedded CSS:: CSS Styles embedded in HTML. +* Embperl:: Another syntax for Perl in HTML. +* ePerl:: A general Perl-embedding syntax. +* JSP:: Java code embedded in HTML. +* RPM:: Shell scripts in RPM Spec Files. +* Noweb:: Noweb literate programs. + diff --git a/mmm-mode-0.4.8/mmm.info-2 b/mmm-mode-0.4.8/mmm.info-2 new file mode 100644 index 0000000..f5a31d8 --- /dev/null +++ b/mmm-mode-0.4.8/mmm.info-2 @@ -0,0 +1,975 @@ +This is mmm.info, produced by makeinfo version 4.2 from mmm.texinfo. + +INFO-DIR-SECTION GNU Emacs Lisp +START-INFO-DIR-ENTRY +* MMM-Mode: (mmm). Multiple Major Modes for Emacs +END-INFO-DIR-ENTRY + + This is edition 0.4.8 of the MMM Mode Manual, last updated 9 March +2003. It documents version 0.4.8 of MMM Mode. + + Copyright 2000 Michael Abraham Shulman. + + Permission is granted to make and distribute verbatim copies of this +manual provided the copyright notice and this permission notice are +preserved on all copies. + + Permission is granted to copy and distribute modified versions of +this manual under the conditions for verbatim copying, provided also +that the sections entitled "Copying" and "GNU General Public License" +are included exactly as in the original, and provided that the entire +resulting derived work is distributed under the terms of a permission +notice identical to this one. + + Permission is granted to copy and distribute translations of this +manual into another language, under the above conditions for modified +versions, except that this permission notice may be stated in a +translation approved by the Free Software Foundation. + + +File: mmm.info, Node: Mason, Next: File Variables, Prev: Supplied Classes, Up: Supplied Classes + +Mason: Perl in HTML +=================== + + Mason is a syntax to embed Perl code in HTML and other documents. +See `http://www.masonhq.com' for more information. The submode class +for Mason components is called `mason' and is loaded on demand from +`mmm-mason.el'. The current Mason class is intended to correctly +recognize all syntax valid in Mason 0.896. There are insertion keys +for most of the available syntax; use `mmm-insertion-help' (`C-c % h' +by default) with Mason on to get a list. + + If you want to have mason submodes automatically in all Mason files, +you can use automatic mode and filename associations; the details +depend on what you call your Mason components and what major mode you +use. *Note Mode-Ext Classes::. If you use an extension for your Mason +files that emacs does not automatically place in your preferred HTML +Mode, you will probably want to associate that extension with your HTML +Mode as well; *Note Choosing Modes: (emacs)Choosing Modes. This also +goes for "special" Mason files such as autohandlers and dhandlers. + + The Perl mode used is controlled by the user: *Note Preferred +Modes::. The default is to use CPerl mode, if present. Unfortunately, +there are also certain problems with CPerl mode in submode regions. +(Not to say that the original perl-mode would do any better--it hasn't +been much tried.) First of all, the first line of a Perl section is +usually indented as if it were a continuation line. A fix for this is +to start with a semicolon on the first line. The insertion key +commands do this whenever the Mason syntax allows it. + + <%perl>; + print $var; + + + In addition, some users have reported that the CPerl indentation +sometimes does not work. This problem has not yet been tracked down, +however, and more data about when it happens would be helpful. + + Some people have reported problems using PSGML with Mason. Adding +the following line to a `.emacs' file should suffice to turn PSGML off +and cause emacs to use a simpler HTML mode: + + (autoload 'html-mode "sgml-mode" "HTML Mode" t) + + Earlier versions of PSGML may require instead the following fix: + + (delete '("\\.html$" . sgml-html-mode) auto-mode-alist) + (delete '("\\.shtml$" . sgml-html-mode) auto-mode-alist) + + Other users report using PSGML with Mason and MMM Mode without +difficulty. If you don't have problems and want to use PSGML, you may +need to replace `html-mode' in the suggested code with +`sgml-html-mode'. (Depending on your version of PSGML, this may not be +necessary.) Similarly, if you are using XEmacs and want to use the +alternate HTML mode `hm--html-mode', replace `html-mode' with that +symbol. + + One problem that crops up when using PSGML with Mason is that even +ignoring the special tags and Perl code (which, as I've said, haven't +caused me any problems), Mason components often are not a complete SGML +document. For instance, my autohandlers often say + + + <% $m->call_next %> + + + in which case the actual components contain no doctype declaration, +`', `', or `', confusing PSGML. One solution I've +found is to use the variable `sgml-parent-document' in such incomplete +components; try, for example, these lines at the end of a component. + + %# Local Variables: + %# sgml-parent-document: ("autohandler" "body" nil ("body")) + %# sgml-doctype: "/top/level/autohandler" + %# End: + + This tells PSGML that the current file is a sub-document of the file +`autohandler' and is included inside a `' tag, thus alleviating +its confusion. + + +File: mmm.info, Node: File Variables, Next: Here-documents, Prev: Mason, Up: Supplied Classes + +Elisp in a Local Variables List +=============================== + + Emacs allows the author of a file to specify major and minor modes +to be used while editing that file, as well as specifying values for +other local Elisp variables, with a File Variables list. *Note File +Variables: (emacs)File Variables. Since file variables values are +Elisp objects (and with the `eval' special "variable", they are forms +to be evaluated), one might want to edit them in `emacs-lisp-mode'. +The submode class `file-variables' allows this, and is suitable for +turning on in a given file with `mmm-classes', or in all files with +`mmm-global-classes'. + + +File: mmm.info, Node: Here-documents, Next: Javascript, Prev: File Variables, Up: Supplied Classes + +Here-documents +============== + + One of the long-time standard syntaxes for outputting large amounts +of code (or text, or HTML, or whatever) from a script (notably shell +scripts and Perl scripts) is the here-document syntax: + + print < + + Test Page + + + END_HTML + + The `here-doc' submode class recognizes this syntax, and can even +guess the correct submode to use in many cases. For instance, it would +put the above example in `html-mode', noticing the string `HTML' in the +name of the here-document. If you use less than evocative +here-document names, or if the submode is recognized incorrectly for +any other reason, you can tell it explicitly what submode to use. + + - User Option: mmm-here-doc-mode-alist + The value of this variable should be an alist, each element a cons + pair associating a regular expression to a submode symbol. + Whenever a here-document name matches one of these regexps, the + corresponding submode is applied. For example, if this variable + contains the element `("CODE" . cc-mode)', then any here-document + whose name contains the string `CODE' will be put in `cc-mode'. + The value of this variable overrides any guessing that the + `here-doc' submode class would do otherwise. + + +File: mmm.info, Node: Javascript, Next: Embedded CSS, Prev: Here-documents, Up: Supplied Classes + +Javascript in HTML +================== + + The submode class `html-js' allows for embedding Javascript code in +HTML documents. It recognizes both this syntax: + + + + and this syntax: + + + + The mode used for Javascript regions is controlled by the user; +*Note Preferred Modes::. + + +File: mmm.info, Node: Embedded CSS, Next: Embperl, Prev: Javascript, Up: Supplied Classes + +CSS embedded in HTML +==================== + + CSS (Cascading Style Sheets) can also be embedded in HTML. The +`embedded-css' submode class recognizes this syntax: + + + + It uses `css-mode' if present, `c++-mode' otherwise. This can be +customized: *Note Preferred Modes::. + + +File: mmm.info, Node: Embperl, Next: ePerl, Prev: Embedded CSS, Up: Supplied Classes + +Embperl: More Perl in HTML +========================== + + Embperl is another syntax for embedding Perl in HTML. See +`http://perl.apache.org/embperl' for more information. The `embperl' +submode class recognizes most if not all of the Embperl embedding +syntax. Its Perl mode is also controllable by the user; *Note +Preferred Modes::. + + +File: mmm.info, Node: ePerl, Next: JSP, Prev: Embperl, Up: Supplied Classes + +ePerl: General Perl Embedding +============================= + + Yet another syntax for embedding Perl is called ePerl. See +`http://www.engelschall.com/sw/eperl/' for more information. The +`eperl' submode class handles this syntax, using the Perl mode +specified by the user; *Note Preferred Modes::. + + +File: mmm.info, Node: JSP, Next: RPM, Prev: ePerl, Up: Supplied Classes + +JSP: Java Embedded in HTML +========================== + + JSP (Java Server Pages) is a syntax for embedding Java code in HTML. +The submode class `jsp' handles this syntax, using a Java mode +specified by the user; *Note Preferred Modes::. The default is +`jde-mode' if present, otherwise `java-mode'. + + +File: mmm.info, Node: RPM, Next: Noweb, Prev: JSP, Up: Supplied Classes + +RPM Spec Files +============== + + `mmm-rpm.el' contains the definition of an MMM Mode submode class +for editing shell script sections within RPM (Redhat Package Manager) +spec files. It is recommended for use in combination with +`rpm-spec-mode.el' by Stig Bjørlykke and Steve +Sanbeg +(`http://www.xemacs.org/~stigb/rpm-spec-mode.el'). + + Suggested setup code: + + (add-to-list 'mmm-mode-ext-classes-alist + '(rpm-spec-mode "\\.spec\\'" rpm-sh)) + + Thanks to Marcus Harnisch for contributing +this submode class. + + +File: mmm.info, Node: Noweb, Prev: RPM, Up: Supplied Classes + +Noweb literate programming +========================== + + `mmm-noweb.el' contains the definition of an MMM Mode submode class +for editing Noweb documents. Most Noweb documents use \LaTeX for the +documentation chunks. Code chunks in Noweb are document-specific, and +the mode may be set with a local variable setting in the document. The +variable MMM-NOWEB-CODE-MODE controls the global code chunk mode. Since +Noweb files may have many languages in their code chunks, this mode +also allows setting the mode by specifying a mode in the first line or +two of a code chunk, using the normal Emacs first-line mode setting +syntax. Note that this first-line mode setting only matches a single +word for the mode name, and does not support the variable name setting +of the generalized first file line syntax. + + +% -*- mode: latex; mmm-noweb-code-mode: c++; -*- +% First chunk delimiter! +@ +\noweboptions{smallcode} + +\title{Sample Noweb File} +\author{Joe Kelsey\\ +\nwanchorto{mailto:bozo@bozo.bozo}{\tt bozo@bozo.bozo}} +\maketitle + +@ +\section{Introduction} +Normal noweb documentation for the required [[*]] chunk. +<<*>>= +// C++ mode here! +// We might list the program here, or simply included chunks. +<> +@ %def myfile.cc + +@ +\section{[[myfile.cc]]} +This is [[myfile.cc]]. MMM noweb-mode understands code quotes in +documentation. +<>= +// This section is indented separately from previous. +@ + +@ +\section{A Perl Chunk} +We need a Perl chunk. +<>= +#!/usr/bin/perl +# -*- perl -*- +# Each differently named chunk is flowed separately. +@ + +\section{Finish [[myfile.cc]]} +When we resume a previously defined chunk, they are indented together. +<>= +// Pick up where we left off... +@ + + The quoted code chunks inside documentation chunks are given the mode +found in the variable MMM-NOWEB-QUOTE-MODE, if set, or the value in +MMM-NOWEB-CODE-MODE otherwise. Also, each quoted chunk is set to have +a unique name to prevent them from being indented as a unit. + + Suggested setup code: + (mmm-add-mode-ext-class 'latex-mode "\\.nw\\'" 'noweb) + (add-to-list 'auto-mode-alist '("\\.nw\\'" . latex-mode)) + + In mmm-noweb buffers, each differently-named code chunk has a +different `:name', allowing all chunks with the same name to get +indented together. + + This mode also supplies special paragraph filling operations for use +in documentation areas of the buffer. From a primary-mode +(`latex-mode, , emacs') region, pressing `C-c % C-q' will mark all +submode regions with word syntax (`mmm-word-other-regions'), fill the +current paragraph (`(fill-paragraph justify)'), and remove the syntax +markings (`mmm-undo-syntax-other-regions'). + + Thanks to Joe Kelsey for contributing this +class. + + +File: mmm.info, Node: Writing Classes, Next: Indices, Prev: Supplied Classes, Up: Top + +Writing Submode Classes +*********************** + + Sometimes (perhaps often) you may want to use MMM with a syntax for +which it is suited, but for which no submode is supplied. In such cases +you may have to write your own submode class. This chapter briefly +describes how to write a submode class, from the basic to the advanced, +with examples. + +* Menu: + +* Basic Classes:: Writing a simple submode class. +* Paired Delimiters:: Matching paired delimiters. +* Region Placement:: Placing the region more accurately. +* Submode Groups:: Grouping several classes together. +* Calculated Submodes:: Deciding the submode at run-time. +* Calculated Faces:: Deciding the display face at run-time. +* Insertion Commands:: Inserting regions automatically. +* Region Names:: Naming regions for syntax grouping. +* Other Hooks:: Running code at arbitrary points. +* Delimiters:: Controlling delimiter overlays. +* Misc Keywords:: Other miscellaneous options. + + +File: mmm.info, Node: Basic Classes, Next: Paired Delimiters, Prev: Writing Classes, Up: Writing Classes + +Writing Basic Submode Classes +============================= + + Writing a submode class can become rather complex, if the syntax to +match is complicated and you want to take advantage of some of MMM +Mode's extra features. But a simple submode class is not particularly +difficult to write. This section describes the basics of writing +submode classes. + + Submode classes are stored in the variable `mmm-classes-alist'. +Each element of this list represents a single submode class. For +convenience, the function `mmm-add-classes' takes a list of submode +classes and adds them all to this alist. Each class is represented by a +list containing the class name--a symbol such as `mason' or +`html-js'--followed by pairs of keywords and arguments called a "class +specifier". For example, consider the specifier for the submode class +`embedded-css': + + (mmm-add-classes + '((embedded-css + :submode css + :face mmm-declaration-submode-face + :front "]*>" + :back ""))) + + The name of the submode is `embedded-css', the first element of the +list. The rest of the list consists of pairs of keywords (symbols +beginning with a colon) such as `:submode' and `:front', and arguments, +such as `css' and `"]*>"'. It is the keywords and arguments +that specify how the submode works. The order of keywords is not +important; all that matters is the arguments that follow them. + + The three most important keywords are `:submode', `:front', and +`:back'. The argument following `:submode' names the major mode to use +in submode regions. It can be either a symbol naming a major mode, +such as `text-mode' or `c++-mode', or a symbol to look up in +`mmm-major-mode-preferences' (*note Preferred Modes::) such as `css', +as in this case. + + The arguments following `:front' and `:back' are regular expressions +(*note Regexps: (emacs)Regexps.) that should match the delimiter +strings which begin and end the submode regions. In our example, CSS +regions begin with a `' tag. + + The argument following `:face' specifies the face (background color) +to use when `mmm-submode-decoration-level' is 2 (high coloring). *Note +Region Coloring::, for a list of canonical available faces. + + There are many more possible keywords arguments. In the following +sections, we will examine each of them and their uses in writing submode +classes. + + +File: mmm.info, Node: Paired Delimiters, Next: Region Placement, Prev: Basic Classes, Up: Writing Classes + +Matching Paired Delimiters +========================== + + A simple pair of regular expressions does not always suffice to +exactly specify the beginning and end of submode regions correctly. +For this reason, there are several other possible keyword/argument +pairs which influence the matching process. + + Many submode regions are marked by paired delimiters. For example, +the tags used by Mason (*note Mason::) include `<%init>...' and +`<%args>...'. It would be possible to write a separate submode +class for each type of region, but there is an easier way: the keyword +argument `:save-matches'. If supplied and non-nil, it causes the +regular expression `:back', before being searched for, to be formatted +by replacing all strings of the form `~N' (where N is an integer) with +the corresponding numbered subexpression of the match for `:front'. As +an example, here is an excerpt from the `here-doc' submode class. +*Note Here-documents::, for more information about this submode. + + :front "<<\\([a-zA-Z0-9_-]+\\)" + :back "^~1$" + :save-matches 1 + + The regular expression for `:front' matches `<<' followed by a +string of one or more alphanumeric characters, underscores, and dashes. +The latter string, which happens to be the name of the here-document, is +saved as the first subexpression, since it is surrounded by `\(...\)'. +Then, because the value of `:save-matches' is present and non-nil, the +string `~1' is replaced in the value of `:back' by the name of the +here-document, thus creating a regular expression to match the correct +ending delimiter. + + +File: mmm.info, Node: Region Placement, Next: Submode Groups, Prev: Paired Delimiters, Up: Writing Classes + +Placing Submode Regions Precisely +================================= + + Normally, a submode region begins immediately after the end of the +string matching the `:front' regular expression and ends immediately +before the beginning of the string matching the `:back' regular +expression. This can be changed with the keywords `:include-front' and +`:include-back'. If their arguments are `nil', or they do not appear, +the default behavior is unchanged. But if the argument of +`:include-front' (respectively, `:include-back') is non-nil, the +submode region will begin (respectively, end) immediately before +(respectively, after) the string matching the `:front' (respectively, +`:back') regular expression. In other words, these keywords specify +whether or not the delimiter strings are _included_ in the submode +region. + + When `:front' and `:back' are regexps, the delimiter is normally +considered to be the entire matched region. This can be changed using +the `:front-match' and `:back-match' keywords. The values of the +keywords is a number specifying the submatch. This defaults to zero +(specifying the whole regexp). + + Two more keywords which affect the placement of the region +`:front-offset' and `:back-offset', which both take integers as +arguments. The argument of `:front-offset' (respectively, +`:back-offset') gives the distance in characters from the beginning +(respectively, ending) location specified so far, to the actual point +where the submode region begins (respectively, ends). For example, if +`:include-front' is nil or unsupplied and `:front-offset' is 2, the +submode region will begin two characters after the end of the match for +`:front', and if `:include-back' is non-nil and `:back-offset' is -1, +the region will end one character before the end of the match for +`:back'. + + In addition to integers, the arguments of `:front-offset' and +`:back-offset' can be functions which are invoked to move the point +from the position specified by the matches and inclusions to the correct +beginning or end of the submode region, or lists whose elements are +either functions or numbers and whose effects are applied in sequence. +To help disentangle these options, here is another excerpt from the +`here-doc' submode class: + + :front "<<\\([a-zA-Z0-9_-]+\\)" + :front-offset (end-of-line 1) + :back "^~1$" + :save-matches 1 + + Here the value of `:front-offset' is the list `(end-of-line 1)', +meaning that from the end of the match for `:front', go to the end of +the line, and then one more character forward (thus to the beginning of +the next line), and begin the submode region there. This coincides +with the normal behavior of here-documents: they begin on the following +line and go until the ending flag. + + If the `:back' should not be able to start a new submode region, set +the `:end-not-begin' keyword to non-nil. + + +File: mmm.info, Node: Submode Groups, Next: Calculated Submodes, Prev: Region Placement, Up: Writing Classes + +Defining Groups of Submodes +=========================== + + Sometimes more than one submode class is required to accurately +reflect the behavior of a single type of syntax. For example, Mason +has three very different types of Perl regions: blocks bounded by +matched tags such as `<%perl>...', inline output expressions +bounded by `<%...%>', and single lines of code which simply begin with a +`%' character. In cases like these, it is possible to specify an +"umbrella" class, to turn all these classes on or off together. + + - Function: mmm-add-group GROUP CLASSES + The submode classes CLASSES, which should be a list of lists, + similar to what might be passed to `mmm-add-classes', are added + just as by that function. Furthermore, another class named GROUP + is added, which encompasses all the classes in CLASSES. + + Technically, an group class is specified with a `:classes' keyword +argument, and the subsidiary classes are given a non-nil `:private' +keyword argument to make them invisible. But in general, all you should +ever need to know is how to invoke the function above. + + - Function: mmm-add-to-group GROUP CLASSES + Adds a list of classes to an already existing group. This can be + used, for instance, to add a new quoting definition to HTML-JS + using this example to add the quote characters "%=%": + + (mmm-add-to-group 'html-js '((js-html + :submode javascript + :face mmm-code-submode-face + :front "%=%" + :back "%=%" + :end-not-begin t))) + + +File: mmm.info, Node: Calculated Submodes, Next: Calculated Faces, Prev: Submode Groups, Up: Writing Classes + +Calculating the Correct Submode +=============================== + + In most cases, the author of a submode class will know in advance +what major mode to use, such as `text-mode' or `c++-mode'. If there +are multiple possible modes that the user might desire, then +`mmm-major-mode-preferences' should be used (*note Preferred Modes::). +The function `mmm-set-major-mode-preferences' can be used, with a third +argument, to ensure than the mode is present. + + In some cases, however, the author has no way of knowing in advance +even what language the submode region will be in. The `here-doc' class +is one of these. In such cases, instead of the `:submode' keyword, the +`:match-submode' keyword must be used. Its argument should be a +function, probably written by the author of the submode class, which +calculates what major mode each region should use. + + It is invoked immediately after a match is found for `:front', and +is passed one argument: a string representing the front delimiter. +Normally this string is simply whatever was matched by `:front', but +this can be changed with the keyword `:front-form' (*note +Delimiters::). The function should then return a symbol that would be +a valid argument to `:submode': either the name of a mode, or that of a +language to look up a preferred mode. If it detects an invalid +match--for example, the user has specified a mode which is not +available--it should `(signal 'mmm-no-matching-submode nil)'. + + Since here-documents can contain code in any language, the +`here-doc' submode class uses `:match-submode' rather than `:submode'. +The function it uses is `mmm-here-doc-get-mode', defined in +`mmm-sample.el', which inspects the name of the here-document for flags +indicating the proper mode. For example, this code should probably be +in `perl-mode' (or `cperl-mode'): + + print <' and ` +@end example + +and this syntax: + +@example + +@end example + +The mode used for Javascript regions is controlled by the user; +@xref{Preferred Modes}. + + +@node Embedded CSS, Embperl, Javascript, Supplied Classes +@comment node-name, next, previous, up +@section CSS embedded in HTML + +CSS (Cascading Style Sheets) can also be embedded in HTML. The +@code{embedded-css} submode class recognizes this syntax: + +@example + +@end example + +It uses @code{css-mode} if present, @code{c++-mode} otherwise. This can +be customized: @xref{Preferred Modes}. + + +@node Embperl, ePerl, Embedded CSS, Supplied Classes +@comment node-name, next, previous, up +@section Embperl: More Perl in HTML + +Embperl is another syntax for embedding Perl in HTML. See +@uref{http://perl.apache.org/embperl} for more information. The +@code{embperl} submode class recognizes most if not all of the Embperl +embedding syntax. Its Perl mode is also controllable by the user; +@xref{Preferred Modes}. + + +@node ePerl, JSP, Embperl, Supplied Classes +@comment node-name, next, previous, up +@section ePerl: General Perl Embedding + +Yet another syntax for embedding Perl is called ePerl. See +@uref{http://www.engelschall.com/sw/eperl/} for more information. The +@code{eperl} submode class handles this syntax, using the Perl mode +specified by the user; @xref{Preferred Modes}. + + +@node JSP, RPM, ePerl, Supplied Classes +@comment node-name, next, previous, up +@section JSP: Java Embedded in HTML + +JSP (Java Server Pages) is a syntax for embedding Java code in HTML. +The submode class @code{jsp} handles this syntax, using a Java mode +specified by the user; @xref{Preferred Modes}. The default is +@code{jde-mode} if present, otherwise @code{java-mode}. + + +@node RPM, Noweb, JSP, Supplied Classes +@comment node-name, next, previous, up +@section RPM Spec Files + +@file{mmm-rpm.el} contains the definition of an MMM Mode submode class +for editing shell script sections within RPM (Redhat Package Manager) +spec files. It is recommended for use in combination with +@file{rpm-spec-mode.el} by Stig Bjørlykke and +Steve Sanbeg +(@uref{http://www.xemacs.org/~stigb/rpm-spec-mode.el}). + +Suggested setup code: + +@lisp +(add-to-list 'mmm-mode-ext-classes-alist + '(rpm-spec-mode "\\.spec\\'" rpm-sh)) +@end lisp + +Thanks to Marcus Harnisch for contributing +this submode class. + +@node Noweb, , RPM, Supplied Classes +@comment node-name, next, previous, up +@section Noweb literate programming + +@file{mmm-noweb.el} contains the definition of an MMM Mode submode +class for editing Noweb documents. Most Noweb documents use \LaTeX +for the documentation chunks. Code chunks in Noweb are +document-specific, and the mode may be set with a local variable +setting in the document. The variable @var{mmm-noweb-code-mode} +controls the global code chunk mode. Since Noweb files may have many +languages in their code chunks, this mode also allows setting the mode +by specifying a mode in the first line or two of a code chunk, using +the normal Emacs first-line mode setting syntax. Note that this +first-line mode setting only matches a single word for the mode name, +and does not support the variable name setting of the generalized +first file line syntax. + +@verbatim +% -*- mode: latex; mmm-noweb-code-mode: c++; -*- +% First chunk delimiter! +@ +\noweboptions{smallcode} + +\title{Sample Noweb File} +\author{Joe Kelsey\\ +\nwanchorto{mailto:bozo@bozo.bozo}{\tt bozo@bozo.bozo}} +\maketitle + +@ +\section{Introduction} +Normal noweb documentation for the required [[*]] chunk. +<<*>>= +// C++ mode here! +// We might list the program here, or simply included chunks. +<> +@ %def myfile.cc + +@ +\section{[[myfile.cc]]} +This is [[myfile.cc]]. MMM noweb-mode understands code quotes in +documentation. +<>= +// This section is indented separately from previous. +@ + +@ +\section{A Perl Chunk} +We need a Perl chunk. +<>= +#!/usr/bin/perl +# -*- perl -*- +# Each differently named chunk is flowed separately. +@ + +\section{Finish [[myfile.cc]]} +When we resume a previously defined chunk, they are indented together. +<>= +// Pick up where we left off... +@ + +@end verbatim + +The quoted code chunks inside documentation chunks are given the mode +found in the variable @var{mmm-noweb-quote-mode}, if set, or the value +in @var{mmm-noweb-code-mode} otherwise. Also, each quoted chunk is +set to have a unique name to prevent them from being indented as a +unit. + +Suggested setup code: +@lisp +(mmm-add-mode-ext-class 'latex-mode "\\.nw\\'" 'noweb) +(add-to-list 'auto-mode-alist '("\\.nw\\'" . latex-mode)) +@end lisp + +In mmm-noweb buffers, each differently-named code chunk has a +different @code{:name}, allowing all chunks with the same name to get +indented together. + +This mode also supplies special paragraph filling operations for use +in documentation areas of the buffer. From a primary-mode +(@code{latex-mode, , emacs}) region, pressing @kbd{C-c % C-q} will mark all +submode regions with word syntax (@code{mmm-word-other-regions}), fill +the current paragraph (@code{(fill-paragraph justify)}), and remove the +syntax markings (@code{mmm-undo-syntax-other-regions}). + +Thanks to Joe Kelsey for contributing this +class. + + +@node Writing Classes, Indices, Supplied Classes, Top +@comment node-name, next, previous, up +@chapter Writing Submode Classes + +Sometimes (perhaps often) you may want to use MMM with a syntax for +which it is suited, but for which no submode is supplied. In such cases +you may have to write your own submode class. This chapter briefly +describes how to write a submode class, from the basic to the advanced, +with examples. + +@menu +* Basic Classes:: Writing a simple submode class. +* Paired Delimiters:: Matching paired delimiters. +* Region Placement:: Placing the region more accurately. +* Submode Groups:: Grouping several classes together. +* Calculated Submodes:: Deciding the submode at run-time. +* Calculated Faces:: Deciding the display face at run-time. +* Insertion Commands:: Inserting regions automatically. +* Region Names:: Naming regions for syntax grouping. +* Other Hooks:: Running code at arbitrary points. +* Delimiters:: Controlling delimiter overlays. +* Misc Keywords:: Other miscellaneous options. +@end menu + +@node Basic Classes, Paired Delimiters, Writing Classes, Writing Classes +@comment node-name, next, previous, up +@section Writing Basic Submode Classes +@cindex simple submode classes +@cindex submode classes, simple + +Writing a submode class can become rather complex, if the syntax to +match is complicated and you want to take advantage of some of MMM +Mode's extra features. But a simple submode class is not particularly +difficult to write. This section describes the basics of writing +submode classes. + +Submode classes are stored in the variable @code{mmm-classes-alist}. +Each element of this list represents a single submode class. For +convenience, the function @code{mmm-add-classes} takes a list of submode +classes and adds them all to this alist. Each class is represented by a +list containing the class name---a symbol such as @code{mason} or +@code{html-js}---followed by pairs of keywords and arguments called a +@dfn{class specifier}. For example, consider the specifier for the +submode class @code{embedded-css}: + +@lisp +(mmm-add-classes + '((embedded-css + :submode css + :face mmm-declaration-submode-face + :front "]*>" + :back ""))) +@end lisp + +The name of the submode is @code{embedded-css}, the first element of the +list. The rest of the list consists of pairs of keywords (symbols +beginning with a colon) such as @code{:submode} and @code{:front}, and +arguments, such as @code{css} and @code{"]*>"}. It is the +keywords and arguments that specify how the submode works. The order of +keywords is not important; all that matters is the arguments that follow +them. + +The three most important keywords are @code{:submode}, @code{:front}, +and @code{:back}. The argument following @code{:submode} names the +major mode to use in submode regions. It can be either a symbol naming +a major mode, such as @code{text-mode} or @code{c++-mode}, or a symbol +to look up in @code{mmm-major-mode-preferences} (@pxref{Preferred +Modes}) such as @code{css}, as in this case. + +The arguments following @code{:front} and @code{:back} are regular +expressions (@pxref{Regexps, , , emacs, The Emacs Manual}) that should +match the delimiter strings which begin and end the submode regions. In +our example, CSS regions begin with a @samp{} tag. + +The argument following @code{:face} specifies the face (background +color) to use when @code{mmm-submode-decoration-level} is 2 (high +coloring). @xref{Region Coloring}, for a list of canonical available +faces. + +There are many more possible keywords arguments. In the following +sections, we will examine each of them and their uses in writing submode +classes. + + +@node Paired Delimiters, Region Placement, Basic Classes, Writing Classes +@comment node-name, next, previous, up +@section Matching Paired Delimiters + +A simple pair of regular expressions does not always suffice to exactly +specify the beginning and end of submode regions correctly. For this +reason, there are several other possible keyword/argument pairs which +influence the matching process. + +Many submode regions are marked by paired delimiters. For example, the +tags used by Mason (@pxref{Mason}) include @samp{<%init>...} and +@samp{<%args>...}. It would be possible to write a separate +submode class for each type of region, but there is an easier way: the +keyword argument @code{:save-matches}. If supplied and non-nil, it +causes the regular expression @code{:back}, before being searched for, +to be formatted by replacing all strings of the form @samp{~@var{N}} +(where @var{N} is an integer) with the corresponding numbered +subexpression of the match for @code{:front}. As an example, here is an +excerpt from the @code{here-doc} submode class. @xref{Here-documents}, +for more information about this submode. + +@lisp +:front "<<\\([a-zA-Z0-9_-]+\\)" +:back "^~1$" +:save-matches 1 +@end lisp + +The regular expression for @code{:front} matches @samp{<<} followed by a +string of one or more alphanumeric characters, underscores, and dashes. +The latter string, which happens to be the name of the here-document, is +saved as the first subexpression, since it is surrounded by +@samp{\(...\)}. Then, because the value of @code{:save-matches} is +present and non-nil, the string @samp{~1} is replaced in the value of +@code{:back} by the name of the here-document, thus creating a regular +expression to match the correct ending delimiter. + + +@node Region Placement, Submode Groups, Paired Delimiters, Writing Classes +@comment node-name, next, previous, up +@section Placing Submode Regions Precisely + +Normally, a submode region begins immediately after the end of the +string matching the @code{:front} regular expression and ends +immediately before the beginning of the string matching the @code{:back} +regular expression. This can be changed with the keywords +@code{:include-front} and @code{:include-back}. If their arguments are +@code{nil}, or they do not appear, the default behavior is unchanged. +But if the argument of @code{:include-front} (respectively, +@code{:include-back}) is non-nil, the submode region will begin +(respectively, end) immediately before (respectively, after) the string +matching the @code{:front} (respectively, @code{:back}) regular +expression. In other words, these keywords specify whether or not the +delimiter strings are @emph{included} in the submode region. + +When @code{:front} and @code{:back} are regexps, the delimiter is +normally considered to be the entire matched region. This can be +changed using the @code{:front-match} and @code{:back-match} +keywords. The values of the keywords is a number specifying the +submatch. This defaults to zero (specifying the whole regexp). + +Two more keywords which affect the placement of the region +@code{:front-offset} and @code{:back-offset}, which both take integers +as arguments. The argument of @code{:front-offset} (respectively, +@code{:back-offset}) gives the distance in characters from the beginning +(respectively, ending) location specified so far, to the actual point +where the submode region begins (respectively, ends). For example, if +@code{:include-front} is nil or unsupplied and @code{:front-offset} is +2, the submode region will begin two characters after the end of the +match for @code{:front}, and if @code{:include-back} is non-nil and +@code{:back-offset} is -1, the region will end one character before the +end of the match for @code{:back}. + +In addition to integers, the arguments of @code{:front-offset} and +@code{:back-offset} can be functions which are invoked to move the point +from the position specified by the matches and inclusions to the correct +beginning or end of the submode region, or lists whose elements are +either functions or numbers and whose effects are applied in sequence. +To help disentangle these options, here is another excerpt from the +@code{here-doc} submode class: + +@lisp +:front "<<\\([a-zA-Z0-9_-]+\\)" +:front-offset (end-of-line 1) +:back "^~1$" +:save-matches 1 +@end lisp + +Here the value of @code{:front-offset} is the list @code{(end-of-line +1)}, meaning that from the end of the match for @code{:front}, go to the +end of the line, and then one more character forward (thus to the +beginning of the next line), and begin the submode region there. This +coincides with the normal behavior of here-documents: they begin on the +following line and go until the ending flag. + +If the @code{:back} should not be able to start a new submode region, +set the @code{:end-not-begin} keyword to non-nil. + +@node Submode Groups, Calculated Submodes, Region Placement, Writing Classes +@comment node-name, next, previous, up +@section Defining Groups of Submodes + +Sometimes more than one submode class is required to accurately reflect +the behavior of a single type of syntax. For example, Mason has three +very different types of Perl regions: blocks bounded by matched tags +such as @samp{<%perl>...}, inline output expressions bounded by +@samp{<%...%>}, and single lines of code which simply begin with a +@samp{%} character. In cases like these, it is possible to specify an +``umbrella'' class, to turn all these classes on or off together. + +@defun mmm-add-group @var{group} @var{classes} +The submode classes @var{classes}, which should be a list of lists, +similar to what might be passed to @code{mmm-add-classes}, are added +just as by that function. Furthermore, another class named +@var{group} is added, which encompasses all the classes in +@var{classes}. +@end defun + +Technically, an group class is specified with a @code{:classes} keyword +argument, and the subsidiary classes are given a non-nil @code{:private} +keyword argument to make them invisible. But in general, all you should +ever need to know is how to invoke the function above. + +@defun mmm-add-to-group @var{group} @var{classes} +Adds a list of classes to an already existing group. This can be +used, for instance, to add a new quoting definition to @var{html-js} +using this example to add the quote characters ``%=%'': + +@lisp +(mmm-add-to-group 'html-js '((js-html + :submode javascript + :face mmm-code-submode-face + :front "%=%" + :back "%=%" + :end-not-begin t))) +@end lisp +@end defun + + +@node Calculated Submodes, Calculated Faces, Submode Groups, Writing Classes +@comment node-name, next, previous, up +@section Calculating the Correct Submode + +In most cases, the author of a submode class will know in advance what +major mode to use, such as @code{text-mode} or @code{c++-mode}. If +there are multiple possible modes that the user might desire, then +@code{mmm-major-mode-preferences} should be used (@pxref{Preferred +Modes}). The function @code{mmm-set-major-mode-preferences} can be +used, with a third argument, to ensure than the mode is present. + +In some cases, however, the author has no way of knowing in advance even +what language the submode region will be in. The @code{here-doc} class +is one of these. In such cases, instead of the @code{:submode} keyword, +the @code{:match-submode} keyword must be used. Its argument should be +a function, probably written by the author of the submode class, which +calculates what major mode each region should use. + +It is invoked immediately after a match is found for @code{:front}, and +is passed one argument: a string representing the front delimiter. +Normally this string is simply whatever was matched by @code{:front}, +but this can be changed with the keyword @code{:front-form} +(@pxref{Delimiters}). The function should then return a symbol +that would be a valid argument to @code{:submode}: either the name of a +mode, or that of a language to look up a preferred mode. If it detects +an invalid match---for example, the user has specified a mode which is +not available---it should @code{(signal 'mmm-no-matching-submode nil)}. + +Since here-documents can contain code in any language, the +@code{here-doc} submode class uses @code{:match-submode} rather than +@code{:submode}. The function it uses is @code{mmm-here-doc-get-mode}, +defined in @file{mmm-sample.el}, which inspects the name of the +here-document for flags indicating the proper mode. For example, this +code should probably be in @code{perl-mode} (or @code{cperl-mode}): + +@example +print <} and @code{