diff lisp/font-lock.el @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 7d59cb494b73
children a86b2b5e0111
line wrap: on
line diff
--- a/lisp/font-lock.el	Mon Aug 13 11:12:06 2007 +0200
+++ b/lisp/font-lock.el	Mon Aug 13 11:13:30 2007 +0200
@@ -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 @@
   '((((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 @@
 ;    ;; 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 @@
     (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 @@
 ;		       (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.
 
@@ -2444,11 +2461,11 @@
 		  (goto-char (match-end 1))
 		  (goto-char (match-end 0))
 		  (1 font-lock-variable-name-face))))))
-
+	
   ;; Modifier keywords and Java doc tags
   (setq java-font-lock-keywords-3
 	(append
-
+ 
 	 '(
 	   ;; Feature scoping:
 	   ;; These must come first or the Modifiers from keywords-1 will
@@ -2458,11 +2475,11 @@
 	   ("\\<protected\\>" 0 font-lock-preprocessor-face)
 	   ("\\<public\\>"    0 font-lock-reference-face))
 	 java-font-lock-keywords-2
-
+ 
 	 (list
 
 	  ;; Java doc tags
-	  '("@\\(author\\|exception\\|param\\|return\\|see\\|version\\)\\s "
+	  '("@\\(author\\|exception\\|throws\\|deprecated\\|param\\|return\\|see\\|since\\|version\\)\\s "
 	    0 font-lock-keyword-face t)
 
 	  ;; Doc tag - Parameter identifiers
@@ -2470,7 +2487,17 @@
 		1 'font-lock-variable-name-face t)
 
 	  ;; Doc tag - Exception types
-	  (list (concat "@exception\\ s*"
+	  (list (concat "@exception\\s +"
+			java-font-lock-identifier-regexp)
+		'(1 (if (equal (char-after (match-end 0)) ?.)
+			font-lock-reference-face font-lock-type-face) t)
+		(list (concat "\\=\\." java-font-lock-identifier-regexp)
+		      '(goto-char (match-end 0)) nil
+		      '(1 (if (equal (char-after (match-end 0)) ?.)
+			      'font-lock-reference-face 'font-lock-type-face) t)))
+    
+	  ;; Doc tag - Exception types
+	  (list (concat "@exception\\s +"
 			java-font-lock-identifier-regexp)
 		'(1 (if (equal (char-after (match-end 0)) ?.)
 			font-lock-reference-face font-lock-type-face) t)
@@ -2482,7 +2509,14 @@
 	  ;; Doc tag - Cross-references, usually to methods 
 	  '("@see\\s +\\(\\S *[^][ \t\n\r\f(){},.;:]\\)"
 	    1 font-lock-function-name-face t)
-
+    
+	  ;; Doc tag - Links
+	  '("{@link\\s +\\([^}]*\\)}"
+	    0 font-lock-keyword-face t)
+	  ;; Doc tag - Links
+	  '("{@link\\s +\\(\\S +\\s +\\S +\\)}"
+	    1 font-lock-function-name-face t)
+    
 	  )))
   )