Commits

Anonymous committed 4c1f2ce

Use defface instead of old backwards-compatibility code when defining faces to cooperate better with other modes.

Comments (0)

Files changed (2)

+2002-09-01  Ville Skyttä  <ville.skytta@xemacs.org>
+
+	* psgml-html.el: Cure antisocial behaviour of defining
+	font-lock-variable-name-face and font-lock-reference-face
+	on load, use html-helper-significant-tag-face and
+	html-helper-link-face instead.  Make these and a couple
+	of others with defface, and put them into psgml-html-faces
+	customization group.
+	(psgml-html): Add psgml-html- prefix.
+	(psgml-html-faces): New customization group.
+	(html-helper-bold-face): New (defface).
+	(html-helper-italic-face): Ditto.
+	(html-helper-underline-face): Ditto.
+	(html-helper-strikethrough-face): New.
+	(html-helper-link-face): New (was font-lock-reference-face).
+	(html-helper-significant-tag-face): New (was
+	font-lock-variable-name-face).
+	(html-font-lock-keywords): Use the new faces.
+
 2002-08-26  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 1.32 released.
   "HTML mode in conjunction with PSGML"
   :tag "Psgml Html"
   :prefix "html-helper-"
+  :prefix "psgml-html-"
   :group 'html
   :group 'psgml)
 
   :type 'sexp
   :group 'psgml-html)
 
+(defgroup psgml-html-faces nil
+  "Faces for highlighting HTML."
+  :prefix "html-helper-"
+  :group 'faces
+  :group 'psgml-html)
+
+(defface html-helper-bold-face '((t (:bold t)))
+  "*Face for highlighting bold text."
+  :group 'psgml-html-faces)
+
+(defface html-helper-italic-face '((t (:italic t)))
+  "*Face for highlighting italic text."
+  :group 'psgml-html-faces)
+
+(defface html-helper-underline-face '((t (:underline t)))
+  "*Face for highlighting underlined text."
+  :group 'psgml-html-faces)
+
+(defface html-helper-strikethrough-face '((t (:strikethru t)))
+  "*Face for highlighting strikethrough text."
+  :group 'psgml-html-faces)
+
+;; Could be underline, but it looks ugly at line breaks.
+(defface html-helper-link-face '((t (:foreground "blue")))
+  "*Face for highlighting link text."
+  :group 'psgml-html-faces)
+
+(defface html-helper-significant-tag-face '((t (:foreground "salmon")))
+  "*Face for highlighting html, body, head, form, input and img tags."
+  :group 'psgml-html-faces)
+
 ;;}}} end of user variables
 ;;{{{ type based keymap and menu variable and function setup
 
 ;;
 ;; We make an effort on handling nested tags intelligently.
 
-;; font-lock compatibility with XEmacs/Lucid and older Emacsen (<19.29).
-;;
-(if running-xemacs
-    ;; XEmacs/Lucid
-    ;; Make needed faces if the user hasn't already done so.
-    ;; Respect X resources (`make-face' uses them when they exist).
-    (let ((change-it
-	   (function (lambda (face)
-		       (or (if (fboundp 'facep)
-			       (facep face)
-			     (memq face (face-list)))
-			   (make-face face))
-		       (not (face-differs-from-default-p face))))))
-      (if (funcall change-it 'html-helper-bold-face)
-	  (copy-face 'bold 'html-helper-bold-face))
-      (if (funcall change-it 'html-helper-italic-face)
-	  (copy-face 'italic 'html-helper-italic-face))
-      (if (funcall change-it 'html-helper-underline-face)
-	  (set-face-underline-p 'html-helper-underline-face t))
-      (if (funcall change-it 'font-lock-variable-name-face)
-	  (set-face-foreground 'font-lock-variable-name-face "salmon"))
-      (if (funcall change-it 'font-lock-reference-face)
-	  (set-face-foreground 'font-lock-reference-face "violet")))
-  ;; Emacs (any version)
-  ;;
-  ;; Note that Emacs evaluates the face entries in `font-lock-keywords',
-  ;; while XEmacs doesn't.  So XEmacs doesn't use the following *variables*,
-  ;; but instead the faces with the same names as the variables.
-  (defvar html-helper-bold-face 'bold
-    "Face used as bold.  Typically `bold'.")
-  (defvar html-helper-italic-face 'italic
-    "Face used as italic.  Typically `italic'.")
-  (defvar html-helper-underline-face 'underline
-    "Face used as underline.  Typically `underline'.")
-  ;;
-  (if (string-lessp "19.28.89" emacs-version)
-      () ; Emacs 19.29 and later
-    ;; Emacs 19.28 and older
-    ;; Define face variables that don't exist until Emacs 19.29.
-    (defvar font-lock-variable-name-face 'font-lock-doc-string-face
-      "Face to use for variable names -- and some HTML keywords.")
-    (defvar font-lock-reference-face 'underline ; Ugly at line breaks
-      "Face to use for references -- including HTML hyperlink texts.")))
-
 ;;;###autoload
 (defvar html-font-lock-keywords
   (let (;; Titles and H1's, like function defs.
      ;; First fontify the text of a HREF anchor.  It may be overridden later.
      ;; Anchors in headings will be made bold, for instance.
      '("<a\\s-+href[^>]*>\\([^>]+\\)</a>"
-       1 font-lock-reference-face t)
+       1 html-helper-link-face t)
      ;; Tag pairs like <b>...</b> etc.
      ;; Cunning repeated fontification to handle common cases of overlap.
      ;; Bold complex --- possibly with arbitrary other non-bold stuff inside.
 	   3 'font-lock-function-name-face t)
      ;; Underline is rarely used. Only handle it when no tags inside.
      '("<u>\\([^<]*\\)</u>" 1 html-helper-underline-face t)
+     ;; Ditto for strikethrough.
+     '("<strike>\\([^<]*\\)</strike>" 1 html-helper-strikethrough-face t)
      ;; Forms, anchors & images (also fontify strings inside)
      '("\\(<\\(form\\|i\\(mg\\|nput\\)\\)\\>[^>]*>\\)"
-       1 font-lock-variable-name-face t)
+       1 html-helper-significant-tag-face t)
      '("</a>" 0 font-lock-keyword-face t)
      '("\\(<a\\b[^>]*>\\)" 1 font-lock-keyword-face t)
      '("=[ \t\n]*\\(\"[^\"]+\"\\)" 1 font-lock-string-face t)
      ;; Large-scale structure keywords (like "program" in Fortran).
      ;;   "<html>" "</html>" "<body>" "</body>" "<head>" "</head>" "</form>"
      '("</?\\(body\\|form\\|h\\(ead\\|tml\\)\\)>"
-       0 font-lock-variable-name-face t)
+       0 html-helper-significant-tag-face t)
      ;; HTML special characters
      '("&[^;\n]*;" 0 font-lock-string-face t)
      ;; SGML things like <!DOCTYPE ...> with possible <!ENTITY...> inside.