[Emacs-diffs] emacs/lisp ChangeLog facemenu.el textmodes/sgml...

[Chong Yidong]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Chong Yidong <cyd>      09/10/31 21:52:56

Modified files:
        lisp           : ChangeLog facemenu.el 
        lisp/textmodes : sgml-mode.el tex-mode.el 

Log message:
        * textmodes/sgml-mode.el (sgml-mode-facemenu-add-face-function):
        Support face colors.
        
        * textmodes/tex-mode.el (tex-facemenu-add-face-function): New
        function.  Support face colors (Bug#1168).
        (tex-common-initialization): Use it.
        
        * facemenu.el (facemenu-enable-faces-p): Enable facemenu if the
        mode allows it (Bug#1168).

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16538&r2=1.16539
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/facemenu.el?cvsroot=emacs&r1=1.110&r2=1.111
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/textmodes/sgml-mode.el?cvsroot=emacs&r1=1.144&r2=1.145
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/textmodes/tex-mode.el?cvsroot=emacs&r1=1.228&r2=1.229

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16538
retrieving revision 1.16539
diff -u -b -r1.16538 -r1.16539
--- ChangeLog   31 Oct 2009 20:16:50 -0000      1.16538
+++ ChangeLog   31 Oct 2009 21:52:53 -0000      1.16539
@@ -1,3 +1,15 @@
+2009-10-31  Chong Yidong  <address@hidden>
+
+       * textmodes/sgml-mode.el (sgml-mode-facemenu-add-face-function):
+       Support face colors.
+
+       * textmodes/tex-mode.el (tex-facemenu-add-face-function): New
+       function.  Support face colors (Bug#1168).
+       (tex-common-initialization): Use it.
+
+       * facemenu.el (facemenu-enable-faces-p): Enable facemenu if the
+       mode allows it (Bug#1168).
+
 2009-10-31  Juri Linkov  <address@hidden>
 
        * facemenu.el (list-colors-display): Don't mark buffer as

Index: facemenu.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/facemenu.el,v
retrieving revision 1.110
retrieving revision 1.111
diff -u -b -r1.110 -r1.111
--- facemenu.el 31 Oct 2009 20:16:55 -0000      1.110
+++ facemenu.el 31 Oct 2009 21:52:56 -0000      1.111
@@ -187,7 +187,10 @@
 
 ;;; Condition for enabling menu items that set faces.
 (defun facemenu-enable-faces-p ()
-  (not (and font-lock-mode font-lock-defaults)))
+  ;; Enable the facemenu if facemenu-add-face-function is defined
+  ;; (e.g. in Tex-mode and SGML mode), or if font-lock is off.
+  (or (not (and font-lock-mode font-lock-defaults))
+      facemenu-add-face-function))
 
 (defvar facemenu-special-menu
   (let ((map (make-sparse-keymap "Special")))

Index: textmodes/sgml-mode.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/textmodes/sgml-mode.el,v
retrieving revision 1.144
retrieving revision 1.145
diff -u -b -r1.144 -r1.145
--- textmodes/sgml-mode.el      24 Oct 2009 03:45:53 -0000      1.144
+++ textmodes/sgml-mode.el      31 Oct 2009 21:52:56 -0000      1.145
@@ -397,12 +397,24 @@
     (comment-indent-new-line soft)))
 
 (defun sgml-mode-facemenu-add-face-function (face end)
-  (if (setq face (cdr (assq face sgml-face-tag-alist)))
-      (progn
-       (setq face (funcall skeleton-transformation-function face))
-       (setq facemenu-end-add-face (concat "</" face ">"))
-       (concat "<" face ">"))
-    (error "Face not configured for %s mode" (format-mode-line mode-name))))
+  (let ((tag-face (cdr (assq face sgml-face-tag-alist))))
+    (cond (tag-face
+          (setq tag-face (funcall skeleton-transformation-function tag-face))
+          (setq facemenu-end-add-face (concat "</" tag-face ">"))
+          (concat "<" tag-face ">"))
+         ((and (consp face)
+               (consp (car face))
+               (null  (cdr face))
+               (memq (caar face) '(:foreground :background)))
+          (setq facemenu-end-add-face "</span>")
+          (format "<span style=\"%s:%s\">"
+                  (if (eq (caar face) :foreground)
+                      "color"
+                    "background-color")
+                  (cadr (car face))))
+         (t
+          (error "Face not configured for %s mode"
+                 (format-mode-line mode-name))))))
 
 (defun sgml-fill-nobreak ()
   ;; Don't break between a tag name and its first argument.

Index: textmodes/tex-mode.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/textmodes/tex-mode.el,v
retrieving revision 1.228
retrieving revision 1.229
diff -u -b -r1.228 -r1.229
--- textmodes/tex-mode.el       31 Oct 2009 02:38:42 -0000      1.228
+++ textmodes/tex-mode.el       31 Oct 2009 21:52:56 -0000      1.229
@@ -860,6 +860,19 @@
     ,@tex-face-alist)
   "Alist of face and LaTeX font name for facemenu.")
 
+(defun tex-facemenu-add-face-function (face end)
+  (or (cdr (assq face tex-face-alist))
+      (or (and (consp face)
+              (consp (car face))
+              (null  (cdr face))
+              (eq major-mode 'latex-mode)
+              ;; This actually requires the `color' LaTeX package.
+              (cond ((eq (caar face) :foreground)
+                     (format "{\\color{%s} " (cadr (car face))))
+                    ((eq (caar face) :background)
+                     (format "\\colorbox{%s}{" (cadr (car face))))))
+         (error "Face %s not configured for %s mode" face mode-name))))
+
 ;; This would be a lot simpler if we just used a regexp search,
 ;; but then it would be too slow.
 (defun tex-guess-mode ()
@@ -1131,9 +1144,7 @@
   (set (make-local-variable 'compare-windows-whitespace)
        'tex-categorize-whitespace)
   (set (make-local-variable 'facemenu-add-face-function)
-       (lambda (face end)
-        (or (cdr (assq face tex-face-alist))
-            (error "Face %s not configured for %s mode" face mode-name))))
+       'tex-facemenu-add-face-function)
   (set (make-local-variable 'facemenu-end-add-face) "}")
   (set (make-local-variable 'facemenu-remove-face-function) t)
   (set (make-local-variable 'font-lock-defaults)