Re: font-lock-face-attributes is broken

[Dan Nicolaescu]

Glenn Morris <address@hidden> writes:

  > The font-lock-face-attributes mechanism for setting font-lock face
  > props, described as obsolete but respected (eg in NEWS), is broken. I
  > think it's because font-lock.el is now loaded at startup, so that
  > font-lock-function-name-face etc are defined before ~/.emacs gets
  > parsed. Hence the custom-declare-face in the font-lock-face-attributes
  > parsing code in font-lock.el does nothing.
  > 
  > Sniff, time to move it from obsolete to non-existant?

Can you please try the attached patch and see if it gives good
results?
The patch moves the code that dealt with font-lock-face-attributes to
startup.el, and it calls face-set-spec instead of custom-declare-face
because custom-declare-face does not change a face declared with
defface.

Index: startup.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/startup.el,v
retrieving revision 1.384
diff -c -3 -p -r1.384 startup.el
*** startup.el  4 Nov 2005 02:15:49 -0000       1.384
--- startup.el  4 Nov 2005 04:44:48 -0000
*************** or `CVS', and any subdirectory that cont
*** 958,963 ****
--- 958,995 ----
                                        (or mail-host-address
                                            (system-name)))))
  
+     ;; Originally face attributes were specified via
+     ;; `font-lock-face-attributes'.  Users then changed the default
+     ;; face attributes by setting that variable.  However, we try and
+     ;; be back-compatible and respect its value if set except for
+     ;; faces where M-x customize has been used to save changes for the
+     ;; face.
+     (when (boundp 'font-lock-face-attributes)
+       (let ((face-attributes font-lock-face-attributes))
+       (while face-attributes
+         (let* ((face-attribute (pop face-attributes))
+                (face (car face-attribute)))
+           ;; Rustle up a `defface' SPEC from a
+           ;; `font-lock-face-attributes' entry.
+           (unless (get face 'saved-face)
+             (let ((foreground (nth 1 face-attribute))
+                   (background (nth 2 face-attribute))
+                   (bold-p (nth 3 face-attribute))
+                   (italic-p (nth 4 face-attribute))
+                   (underline-p (nth 5 face-attribute))
+                   face-spec)
+               (when foreground
+                 (setq face-spec (cons ':foreground (cons foreground 
face-spec))))
+               (when background
+                 (setq face-spec (cons ':background (cons background 
face-spec))))
+               (when bold-p
+                 (setq face-spec (append '(:weight bold) face-spec)))
+               (when italic-p
+                 (setq face-spec (append '(:slant italic) face-spec)))
+               (when underline-p
+                 (setq face-spec (append '(:underline t) face-spec)))
+               (face-spec-set face (list (list t face-spec)) nil)))))))
+ 
      ;; If parameter have been changed in the init file which influence
      ;; face realization, clear the face cache so that new faces will
      ;; be realized.
Index: faces.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/faces.el,v
retrieving revision 1.340
diff -c -3 -p -r1.340 faces.el
*** faces.el    1 Nov 2005 07:19:07 -0000       1.340
--- faces.el    4 Nov 2005 04:44:48 -0000
*************** FRAME is the frame whose frame-local fac
*** 1448,1454 ****
  do it on all frames.  See `defface' for information about SPEC.
  If SPEC is nil, do nothing."
    (let ((attrs (face-spec-choose spec frame)))
!     (when attrs
        (face-spec-reset-face face frame))
      (while attrs
        (let ((attribute (car attrs))
--- 1448,1454 ----
  do it on all frames.  See `defface' for information about SPEC.
  If SPEC is nil, do nothing."
    (let ((attrs (face-spec-choose spec frame)))
!     (when spec
        (face-spec-reset-face face frame))
      (while attrs
        (let ((attribute (car attrs))
Index: font-lock.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/font-lock.el,v
retrieving revision 1.281
diff -c -3 -p -r1.281 font-lock.el
*** font-lock.el        3 Nov 2005 22:29:43 -0000       1.281
--- font-lock.el        4 Nov 2005 04:44:48 -0000
*************** Sets various variables using `font-lock-
*** 1646,1682 ****
  
  ;;; Colour etc. support.
  
! ;; Originally face attributes were specified via `font-lock-face-attributes'.
! ;; Users then changed the default face attributes by setting that variable.
! ;; However, we try and be back-compatible and respect its value if set except
! ;; for faces where M-x customize has been used to save changes for the face.
! (when (boundp 'font-lock-face-attributes)
!   (let ((face-attributes font-lock-face-attributes))
!     (while face-attributes
!       (let* ((face-attribute (pop face-attributes))
!            (face (car face-attribute)))
!       ;; Rustle up a `defface' SPEC from a `font-lock-face-attributes' entry.
!       (unless (get face 'saved-face)
!         (let ((foreground (nth 1 face-attribute))
!               (background (nth 2 face-attribute))
!               (bold-p (nth 3 face-attribute))
!               (italic-p (nth 4 face-attribute))
!               (underline-p (nth 5 face-attribute))
!               face-spec)
!           (when foreground
!             (setq face-spec (cons ':foreground (cons foreground face-spec))))
!           (when background
!             (setq face-spec (cons ':background (cons background face-spec))))
!           (when bold-p
!             (setq face-spec (append '(:weight bold) face-spec)))
!           (when italic-p
!             (setq face-spec (append '(:slant italic) face-spec)))
!           (when underline-p
!             (setq face-spec (append '(:underline t) face-spec)))
!           (custom-declare-face face (list (list t face-spec)) nil)))))))
! 
! ;; But now we do it the custom way.  Note that `defface' will not overwrite 
any
! ;; faces declared above via `custom-declare-face'.
  (defface font-lock-comment-face
    '((((class grayscale) (background light))
       (:foreground "DimGray" :weight bold :slant italic))
--- 1646,1653 ----
  
  ;;; Colour etc. support.
  
! ;; Note that `defface' will not overwrite any faces declared above via
! ;; `custom-declare-face'.
  (defface font-lock-comment-face
    '((((class grayscale) (background light))
       (:foreground "DimGray" :weight bold :slant italic))