XEmacs 21.2.24 "Hecate".

[chise/xemacs-chise.git.1] / lisp / font-lock.el

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index d71c4fa..be8df46 100644 (file)
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -4,7 +4,7 @@
 ;; Copyright (C) 1995 Amdahl Corporation.
 ;; Copyright (C) 1996 Ben Wing.
 
-;; Author: Jamie Zawinski <jwz@netscape.com>, for the LISPM Preservation Society.
+;; Author: Jamie Zawinski <jwz@jwz.org>, for the LISPM Preservation Society.
 ;; Minimally merged with FSF 19.34 by Barry Warsaw <bwarsaw@python.org>
 ;; Then (partially) synched with FSF 19.30, leading to:
 ;; Next Author: RMS
@@ -611,7 +611,11 @@ This is normally set via `font-lock-defaults'.")
   '((((class color) (background dark)) (:foreground "light coral"))
     (((class color) (background light)) (:foreground "green4"))
     (t (:bold t)))
-  "Font Lock mode face used to highlight documentation strings."
+  "Font Lock mode face used to highlight documentation strings.
+This is currently supported only in Lisp-like modes, which are those
+with \"lisp\" or \"scheme\" in their name.  You can explicitly make
+a mode Lisp-like by putting a non-nil `font-lock-lisp-like' property
+on the major mode's symbol."
   :group 'font-lock-faces)
 
 (defface font-lock-keyword-face
@@ -1284,6 +1288,16 @@ This can take a while for large buffers."
 ;    ;; Clean up.
 ;    (and prev (remove-text-properties prev end '(face nil)))))
 
+(defun font-lock-lisp-like (mode)
+  ;; Note: (or (get mode 'font-lock-lisp-like) (string-match ...)) is
+  ;; not enough because the property needs to be able to specify a nil
+  ;; value.
+  (if (plist-member (symbol-plist mode) 'font-lock-lisp-like)
+      (get mode 'font-lock-lisp-like)
+    ;; If the property is not specified, guess.  Similar logic exists
+    ;; in add-log, but I think this encompasses more modes.
+    (string-match "lisp\\|scheme" (symbol-name mode))))
+
 (defun font-lock-fontify-syntactically-region (start end &optional loudly)
   "Put proper face on each string and comment between START and END.
 START should be at the beginning of a line."
@@ -1296,21 +1310,24 @@ START should be at the beginning of a line."
     (font-lock-unfontify-region start end loudly)
     (goto-char start)
     (if (> end (point-max)) (setq end (point-max)))
-    (syntactically-sectionize
-      #'(lambda (s e context depth)
-         (let (face)
-           (cond ((eq context 'string)
-                  ;;#### Should only do this is Lisp-like modes!
-                  (setq face
-                        (if (= depth 1)
-                            ;; really we should only use this if
-                            ;;  in position 3 depth 1, but that's
-                            ;;  too expensive to compute.
-                            'font-lock-doc-string-face
-                          'font-lock-string-face)))
-                 ((or (eq context 'comment)
-                      (eq context 'block-comment))
-                  (setq face 'font-lock-comment-face)
+    (let ((lisp-like (font-lock-lisp-like major-mode)))
+      (syntactically-sectionize
+       #'(lambda (s e context depth)
+          (let (face)
+            (cond ((eq context 'string)
+                   (setq face
+                         ;; #### It would be nice if we handled
+                         ;; Python and other non-Lisp languages with
+                         ;; docstrings correctly.
+                         (if (and lisp-like (= depth 1))
+                             ;; really we should only use this if
+                             ;;  in position 3 depth 1, but that's
+                             ;;  too expensive to compute.
+                             'font-lock-doc-string-face
+                           'font-lock-string-face)))
+                  ((or (eq context 'comment)
+                       (eq context 'block-comment))
+                   (setq face 'font-lock-comment-face)
 ;               ;; Don't fontify whitespace at the beginning of lines;
 ;               ;;  otherwise comment blocks may not line up with code.
 ;               ;; (This is sometimes a good idea, sometimes not; in any
@@ -1323,9 +1340,9 @@ START should be at the beginning of a line."
 ;                     (skip-chars-forward " \t\n")
 ;                     (setq s (point)))
                   ))
-           (font-lock-set-face s e face)))
-      start end)
-    ))
+            (font-lock-set-face s e face)))
+       start end)
+      )))
 \f
 ;;; Additional text property functions.