X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Ffont-lock.el;h=be8df46297b0f50b5ca6701f9b58568c0088a93e;hb=9dab7627f5aa4b82bc092df9dacb1c401ced0e5e;hp=91446fdb42c6023690d9a60c4849f050f6408c2e;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910;p=chise%2Fxemacs-chise.git- diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 91446fd..be8df46 100644 --- 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 , for the LISPM Preservation Society. +;; Author: Jamie Zawinski , for the LISPM Preservation Society. ;; Minimally merged with FSF 19.34 by Barry Warsaw ;; Then (partially) synched with FSF 19.30, leading to: ;; Next Author: RMS @@ -128,8 +128,8 @@ ;; - Keep the faces distinct from each other as far as possible. ;; i.e., (a) above. ;; - Make the face attributes fit the concept as far as possible. -;; i.e., function names might be a bold colour such as blue, comments might -;; be a bright colour such as red, character strings might be brown, because, +;; i.e., function names might be a bold color such as blue, comments might +;; be a bright color such as red, character strings might be brown, because, ;; err, strings are brown (that was not the reason, please believe me). ;; - Don't use a non-nil OVERRIDE unless you have a good reason. ;; Only use OVERRIDE for special things that are easy to define, such as the @@ -375,7 +375,7 @@ MATCH-ANCHORED should be of the form: Where MATCHER is as for MATCH-HIGHLIGHT with one exception; see below. PRE-MATCH-FORM and POST-MATCH-FORM are evaluated before the first, and after the last, instance MATCH-ANCHORED's MATCHER is used. Therefore they can be -used to initialise before, and cleanup after, MATCHER is used. Typically, +used to initialize before, and cleanup after, MATCHER is used. Typically, PRE-MATCH-FORM is used to move to some position relative to the original MATCHER, before starting with MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might be used to move, before resuming with MATCH-ANCHORED's parent's MATCHER. @@ -533,8 +533,7 @@ This is normally set via `font-lock-defaults'.") :type 'boolean :initialize 'custom-initialize-default :require 'font-lock - :set '(lambda (var val) - (font-lock-mode (or val 0))) + :set #'(lambda (var val) (font-lock-mode (or val 0))) ) (defvar font-lock-fontified nil) ; whether we have hacked this buffer @@ -612,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 @@ -1073,8 +1076,9 @@ This can take a while for large buffers." ;; region as fontified; otherwise, the same error might get signaled ;; after every command. (unwind-protect - ;; buffer may be deleted. - (if (buffer-live-p (extent-object font-lock-old-extent)) + ;; buffer/extent may be deleted. + (if (and (extent-live-p font-lock-old-extent) + (buffer-live-p (extent-object font-lock-old-extent))) (save-excursion (set-buffer (extent-object font-lock-old-extent)) (font-lock-after-change-function-1 @@ -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. @@ -1536,7 +1553,12 @@ START should be at the beginning of a line." ;; If the buffer has just been reverted, normally that turns off ;; Font Lock mode. So turn the mode back on if necessary. -(defalias 'font-lock-revert-cleanup 'turn-on-font-lock) +;; sb 1999-03-03 -- The above comment no longer appears to be operative as +;; the first call to normal-mode *will* restore the font-lock state and +;; this call forces a second font-locking to occur when reverting a buffer, +;; which is wasteful at best. +;(defalias 'font-lock-revert-cleanup 'turn-on-font-lock) +(defun font-lock-revert-cleanup ()) ;; Various functions. @@ -2439,11 +2461,11 @@ The name is assumed to begin with a capital letter.") (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 @@ -2453,11 +2475,11 @@ The name is assumed to begin with a capital letter.") ("\\" 0 font-lock-preprocessor-face) ("\\" 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 @@ -2465,7 +2487,17 @@ The name is assumed to begin with a capital letter.") 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) @@ -2477,7 +2509,14 @@ The name is assumed to begin with a capital letter.") ;; 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) + ))) )