X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Ffont-lock.el;h=be8df46297b0f50b5ca6701f9b58568c0088a93e;hb=9dab7627f5aa4b82bc092df9dacb1c401ced0e5e;hp=aba0a227c9a01aa7d05bc24263427ce0aee8a82d;hpb=afa9772e3fcbb4e80e3e4cfd1a40b4fccc6d08b8;p=chise%2Fxemacs-chise.git-

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index aba0a22..be8df46 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -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)
+      )))
 
 ;;; Additional text property functions.