;; 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
font-lock-preprocessor-face
font-lock-warning-face))
-;; #### There should be an emulation for the old font-lock-use-*
-;; settings!
-
(defface font-lock-comment-face
'((((class color) (background dark)) (:foreground "gray80"))
+ ;; blue4 is hardly different from black on windows.
+ (((class color) (background light) (type mswindows)) (:foreground "blue"))
(((class color) (background light)) (:foreground "blue4"))
(((class grayscale) (background light))
(:foreground "DimGray" :bold t :italic t))
'((((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
'((((class color) (background dark)) (:foreground "cyan"))
+ ;; red4 is hardly different from black on windows.
+ (((class color) (background light) (type mswindows)) (:foreground "red"))
(((class color) (background light)) (:foreground "red4"))
(((class grayscale) (background light)) (:foreground "LightGray" :bold t))
(((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
(defface font-lock-function-name-face
'((((class color) (background dark)) (:foreground "aquamarine"))
+ ;; brown4 is hardly different from black on windows.
+ ;; I changed it to red because IMO it's pointless and ugly to
+ ;; use a million slightly different colors for niggly syntactic
+ ;; differences. --ben
+ (((class color) (background light) (type mswindows)) (:foreground "red"))
(((class color) (background light)) (:foreground "brown4"))
(t (:bold t :underline t)))
"Font Lock mode face used to highlight function names."
((or (null maximum-size) (<= (buffer-size) maximum-size))
(font-lock-fontify-buffer))
(font-lock-verbose
- (lmessage 'command "Fontifying %s... buffer too big."
- (buffer-name)))))
+ (lprogress-display 'font-lock
+ "Fontifying %s... buffer too big." 'abort
+ (buffer-name)))))
(font-lock-fontified
(setq font-lock-fontified nil)
(remove-hook 'before-revert-hook 'font-lock-revert-setup t)
(condition-case nil
(save-excursion
(font-lock-fontify-region (point-min) (point-max)))
- (quit
+ (t
(setq aborted t)))
(or was-on ; turn it off if it was off.
(font-lock-mode 0)))
(set (make-local-variable 'font-lock-fontified) t)
(when (and aborted font-lock-verbose)
- (lmessage 'command "Fontifying %s... aborted." (buffer-name))))
+ (lprogress-display 'font-lock "Fontifying %s... aborted." 'abort (buffer-name))))
(run-hooks 'font-lock-after-fontify-buffer-hook))
(defun font-lock-default-unfontify-buffer ()
(defun font-lock-default-unfontify-region (beg end &optional maybe-loudly)
(when (and maybe-loudly font-lock-verbose
(>= (- end beg) font-lock-message-threshold))
- (lmessage 'progress "Fontifying %s..." (buffer-name)))
+ (lprogress-display 'font-lock "Fontifying %s..." 0 (buffer-name)))
(let ((modified (buffer-modified-p))
(buffer-undo-list t) (inhibit-read-only t)
buffer-file-name buffer-file-truename)
; ;; 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."
nil
(when (and font-lock-verbose
(>= (- end start) font-lock-message-threshold))
- (lmessage 'progress "Fontifying %s... (syntactically...)"
- (buffer-name)))
+ (lprogress-display 'font-lock "Fontifying %s... (syntactically)" 5
+ (buffer-name)))
(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
; (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.
(keywords (cdr (if (eq (car-safe font-lock-keywords) t)
font-lock-keywords
(font-lock-compile-keywords))))
- (bufname (buffer-name)) (count 0)
+ (bufname (buffer-name)) (count 5)
keyword matcher highlights)
;;
;; Fontify each item in `font-lock-keywords' from `start' to `end'.
(while keywords
- (when loudly (lmessage 'progress "Fontifying %s... (regexps..%s)"
- bufname
- (make-string (setq count (1+ count)) ?.)))
+ (when loudly (lprogress-display 'font-lock "Fontifying %s... (regexps)"
+ (setq count (+ count 5)) bufname))
;;
;; Find an occurrence of `matcher' from `start' to `end'.
(setq keyword (car keywords) matcher (car keyword))
(font-lock-fontify-anchored-keywords (car highlights) end))
(setq highlights (cdr highlights))))
(setq keywords (cdr keywords))))
- (if loudly (lmessage 'progress "Fontifying %s... done." (buffer-name)))))
+ (if loudly (lprogress-display 'font-lock "Fontifying %s... " 100 (buffer-name)))))
\f
;; Various functions.
(lazy-lock-after-fontify-buffer))))
;; If the buffer is about to be reverted, it won't be fontified afterward.
-(defun font-lock-revert-setup ()
- (setq font-lock-fontified nil))
+;(defun font-lock-revert-setup ()
+; (setq font-lock-fontified nil))
;; If the buffer has just been reverted, normally that turns off
;; Font Lock mode. So turn the mode back on if necessary.
;; 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 ())
+;; which is wasteful at best.
+;;(defun font-lock-revert-cleanup ())
+
+;; <andy@xemacs.org> 12-10-99. This still does not work right, I think
+;; after change functions will still get us. The simplest thing to do
+;; is unconditionally turn-off font-lock before revert (and thus nuke
+;; all hooks) and then turn it on again afterwards. This also happens
+;; to be much faster because fontifying from scratch is better than
+;; trying to do incremental changes for the whole buffer.
+
+(defalias 'font-lock-revert-cleanup 'turn-on-font-lock)
+(defalias 'font-lock-revert-setup 'turn-off-font-lock)
\f
;; Various functions.
'("\\<\\(false\\|null\\|true\\)\\>" (1 font-lock-keyword-face))
;; Class names:
- (list (concat "\\<class\\>\\s *" java-font-lock-identifier-regexp)
- 1 'font-lock-function-name-face)
+ (list (concat "\\<\\(class\\|interface\\)\\>\\s *"
+ java-font-lock-identifier-regexp)
+ 2 'font-lock-function-name-face)
;; Package declarations:
(list (concat "\\<\\(package\\|import\\)\\>\\s *"
(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
("\\<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 "
+ ;; Javadoc tags
+ '("@\\(author\\|exception\\|throws\\|deprecated\\|param\\|return\\|see\\|since\\|version\\)\\s "
0 font-lock-keyword-face t)
;; Doc tag - Parameter identifiers
1 'font-lock-variable-name-face t)
;; Doc tag - Exception types
- (list (concat "@exception\\ s*"
+ (list (concat "@\\(exception\\|throws\\)\\s +"
java-font-lock-identifier-regexp)
- '(1 (if (equal (char-after (match-end 0)) ?.)
+ '(2 (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 - Cross-references, usually to methods
'("@see\\s +\\(\\S *[^][ \t\n\r\f(){},.;:]\\)"
1 font-lock-function-name-face t)
-
+
+ ;; Doc tag - docRoot (1.3)
+ '("\\({ *@docRoot *}\\)"
+ 0 font-lock-keyword-face t)
+ ;; Doc tag - beaninfo, unofficial but widely used, even by Sun
+ '("\\(@beaninfo\\)"
+ 0 font-lock-keyword-face t)
+ ;; Doc tag - Links
+ '("{ *@link\\s +\\([^}]+\\)}"
+ 0 font-lock-keyword-face t)
+ ;; Doc tag - Links
+ '("{ *@link\\s +\\(\\(\\S +\\)\\|\\(\\S +\\s +\\S +\\)\\) *}"
+ 1 font-lock-function-name-face t)
+
)))
)
projects / chise / xemacs-chise.git- / blobdiff