[elpa] master 2cb7c99 189/433: Added multiple faces and optional levels of decoration.

[Dmitry Gutov]

branch: master
commit 2cb7c9945a2a8d39c754154222dca092330e2964
Author: mas <mas>
Commit: mas <mas>

    Added multiple faces and optional levels of decoration.
---
 mmm-class.el  | 29 ++++++++++++++---------
 mmm-region.el | 27 ++++++++++++++-------
 mmm-vars.el   | 75 ++++++++++++++++++++++++++++++++++++++++++++++++-----------
 3 files changed, 97 insertions(+), 34 deletions(-)

diff --git a/mmm-class.el b/mmm-class.el
index 2fcdaa9..c34db74 100644
--- a/mmm-class.el
+++ b/mmm-class.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 2000 by Michael Abraham Shulman
 
 ;; Author: Michael Abraham Shulman <address@hidden>
-;; Version: $Id: mmm-class.el,v 1.12 2000/09/29 20:43:10 mas Exp $
+;; Version: $Id: mmm-class.el,v 1.13 2001/01/11 00:56:08 mas Exp $
 
 ;;{{{ GPL
 
@@ -124,7 +124,8 @@ and interactive history."
            include-front include-back
            (front-offset 0) (back-offset 0)
            front-verify back-verify
-           front-form back-form creation-hook match-submode
+           front-form back-form creation-hook
+           match-submode match-face
            ;insert
            &allow-other-keys
            )
@@ -152,8 +153,9 @@ the rest of the arguments are for an actual class being 
applied. See
    (t
     (mmm-save-all
      (goto-char start)
-     (loop for (beg end matched-front matched-back matched-submode back-to) =
-           (apply #'mmm-match-region :start (point) all)
+     (loop for (beg end matched-front matched-back
+                    matched-submode matched-face back-to) =
+                    (apply #'mmm-match-region :start (point) all)
            while beg
            while (or (not end) (/= beg end)) ; Sanity check
            if end do            ; match-submode, if present, succeeded.
@@ -161,7 +163,7 @@ the rest of the arguments are for an actual class being 
applied. See
                (progn
                  (apply #'mmm-make-region (or matched-submode submode)
                         beg end :front matched-front :back matched-back
-                        all)
+                        :face (or matched-face face) all)
                  (goto-char end))
              ;; If our region is invalid, go back to the end of the
              ;; front match and continue on.
@@ -177,12 +179,12 @@ the rest of the arguments are for an actual class being 
applied. See
 (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
+          front-form back-form save-matches match-submode match-face
           &allow-other-keys)
   "Find the first valid region between point and STOP.
-Return \(BEG END FRONT-FORM BACK-FORM SUBMODE BACK-TO) 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
+Return \(BEG END FRONT-FORM BACK-FORM SUBMODE FACE BACK-TO) 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.  BACK-TO is the
 point at which the search should continue if the region is invalid."
   (when (mmm-match-and-verify front start stop front-verify)
@@ -197,13 +199,18 @@ point at which the search should continue if the region 
is invalid."
                             (return-from
                                 mmm-match-region
                               (values nil nil nil nil nil back-to))))
-                       nil)))
+                       nil))
+            (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
                (mmm-format-matches back save-matches)
                beg stop back-verify)
           (let ((end (mmm-match->point (not include-back) back-offset))
                 (back-form (mmm-get-form back-form)))
-            (values beg end front-form back-form submode back-to)))))))
+            (values beg end front-form back-form submode face back-to)))))))
 
 (defun mmm-match->point (beginp offset)
   "Find a point of starting or stopping from the match data.
diff --git a/mmm-region.el b/mmm-region.el
index faebf0b..296a58c 100644
--- a/mmm-region.el
+++ b/mmm-region.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 2000 by Michael Abraham Shulman
 
 ;; Author: Michael Abraham Shulman <address@hidden>
-;; Version: $Id: mmm-region.el,v 1.27 2001/01/08 01:43:21 mas Exp $
+;; Version: $Id: mmm-region.el,v 1.28 2001/01/11 00:56:08 mas Exp $
 
 ;;{{{ GPL
 
@@ -231,13 +231,13 @@ i.e. whether text inserted at the marker should be inside 
the region."
              &allow-other-keys
              )
   "Make a submode region from BEG to END of SUBMODE in FACE.
-FACE defaults to `mmm-default-submode-face'.  FRONT and BACK are
-regexps or functions to match the correct delimiters--see
-`mmm-match-front' and `mmm-match-back'.  BEG-STICKY and END-STICKY
-determine whether the front and back of the region, respectively, are
-sticky with respect to new insertion.  CREATION-HOOK should be a
-function to run after the region is created.  All other keyword
-arguments are stored as properties of the overlay, un-keyword-ified."
+FRONT and BACK are regexps or functions to match the correct
+delimiters--see `mmm-match-front' and `mmm-match-back'.  BEG-STICKY
+and END-STICKY determine whether the front and back of the region,
+respectively, are sticky with respect to new insertion.  CREATION-HOOK
+should be a function to run after the region is created.  All other
+keyword arguments are stored as properties of the overlay,
+un-keyword-ified."
   (setq rest (append rest (list :front front :back back :beg-sticky
                                 beg-sticky :end-sticky end-sticky)))
   (mmm-mode-on)
@@ -267,7 +267,7 @@ arguments are stored as properties of the overlay, 
un-keyword-ified."
                        (copy-tree (cdr (assq submode 
mmm-region-saved-locals-defaults)))))
               ;; These have special meaning to Emacs
               (,mmm-evaporate-property t)
-              (face ,(or face (if submode 'mmm-default-submode-face)))
+              (face ,(mmm-get-face face submode))
               ))
     (save-excursion
       (goto-char (overlay-start ovl))
@@ -282,6 +282,15 @@ arguments are stored as properties of the overlay, 
un-keyword-ified."
     (mmm-update-submode-region)
     ovl))
 
+(defun mmm-get-face (face submode)
+  (case mmm-submode-decoration-level
+    ((0) nil)
+    ((1) (when submode
+           'mmm-default-submode-face))
+    ((2) (or face
+             (when submode
+               'mmm-default-submode-face)))))
+
 ;;}}}
 ;;{{{ Clear Overlays
 
diff --git a/mmm-vars.el b/mmm-vars.el
index 2592831..7584e0f 100644
--- a/mmm-vars.el
+++ b/mmm-vars.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 2000 by Michael Abraham Shulman
 
 ;; Author: Michael Abraham Shulman <address@hidden>
-;; Version: $Id: mmm-vars.el,v 1.33 2001/01/09 01:20:24 mas Exp $
+;; Version: $Id: mmm-vars.el,v 1.34 2001/01/11 00:56:08 mas Exp $
 
 ;;{{{ GPL
 
@@ -171,19 +171,60 @@ are saved as overlay properties.")
 (make-variable-buffer-local 'mmm-region-saved-locals-for-dominant)
 
 ;;}}}
-;;{{{ Default Submode Face
+;;{{{ Submode Faces
 
-(defface mmm-default-submode-face 
-  '(
-    (t (:background "gray85"))
-    )
-  "Face used to indicate submode overlays by default.
-This can be overridden for specific submodes created by any method;
-see the documentation for that method. It is recommended that only the
-background color be set for this face, in order not to mess with
-font-lock too much."
+(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.  None means to use no coloring at all.  Low means to use
+a single face \(`mmm-default-submode-face') for all submode regions,
+\(except for \"non-submode\" regions).  High means to use different
+faces for different types of submode regions, such as initialization
+code, expressions that are output, declarations, and so on.  The
+default face is 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)
 
 ;;}}}
 ;;{{{ Mode Line Format
@@ -436,9 +477,15 @@ 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 argument FACE, if supplied, overrides `mmm-default-submode-face'
-in specifying the display face of the submode regions. It must be a
-valid display face.
+The argument FACE, if supplied, specifies the display face of the
+submode regions under decoration level 2.  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, 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