;; Copyright (C) 1992-1995, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995 Amdahl Corporation.
-;; Copyright (C) 1996, 2000 Ben Wing.
+;; Copyright (C) 1996, 2000, 2001 Ben Wing.
;; Author: Jamie Zawinski <jwz@jwz.org>, for the LISPM Preservation Society.
;; Minimally merged with FSF 19.34 by Barry Warsaw <bwarsaw@python.org>
(symbol :tag "name"))
(radio :tag "Decoration"
(const :tag "default" nil)
- (const :tag "maximum" t)
+ (const :tag "maximum" t)
(integer :tag "level" 1)))))
:group 'font-lock)
;; #### barf gag retch. Horrid FSF lossage that we need to
;; keep around for compatibility with font-lock-keywords that
;; forget to properly quote their faces. I tried just let-binding
-;; them when we eval the face expression, but that failes because
+;; them when we eval the face expression, but that fails because
;; some files actually use the variables directly in their init code
;; without quoting them. --ben
(defvar font-lock-comment-face 'font-lock-comment-face
It is present only for horrid FSF compatibility reasons.
The corresponding face should be set using `edit-faces' or the
`set-face-*' functions.")
+;; GNU compatibility
+(define-compatible-variable-alias
+ 'font-lock-doc-face 'font-lock-doc-string-face)
(defvar font-lock-string-face 'font-lock-string-face
"This variable should not be set.
It is present only for horrid FSF compatibility reasons.
It is present only for horrid FSF compatibility reasons.
The corresponding face should be set using `edit-faces' or the
`set-face-*' functions.")
+(defvar font-lock-builtin-face 'font-lock-builtin-face
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
(defvar font-lock-function-name-face 'font-lock-function-name-face
"This variable should not be set.
It is present only for horrid FSF compatibility reasons.
It is present only for horrid FSF compatibility reasons.
The corresponding face should be set using `edit-faces' or the
`set-face-*' functions.")
+(defvar font-lock-constant-face 'font-lock-constant-face
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
(defvar font-lock-reference-face 'font-lock-reference-face
"This variable should not be set.
It is present only for horrid FSF compatibility reasons.
font-lock-string-face
font-lock-doc-string-face
font-lock-keyword-face
+ font-lock-builtin-face
font-lock-function-name-face
font-lock-variable-name-face
font-lock-type-face
+ font-lock-constant-face
font-lock-reference-face
font-lock-preprocessor-face
font-lock-warning-face))
"Font Lock mode face used to highlight keywords."
:group 'font-lock-faces)
+(defface font-lock-builtin-face
+ '((((class color) (background light)) (:foreground "Purple"))
+ (((class color) (background dark)) (:foreground "Cyan"))
+ (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+ (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+ (t (:bold t)))
+ "Font Lock mode face used to highlight builtins."
+:group 'font-lock-faces)
+
(defface font-lock-function-name-face
'((((class color) (background dark)) (:foreground "aquamarine"))
;; brown4 is hardly different from black on windows.
"Font Lock mode face used to highlight types."
:group 'font-lock-faces)
+(defface font-lock-constant-face
+ '((((class color) (background light)) (:foreground "CadetBlue"))
+ (((class color) (background dark)) (:foreground "Aquamarine"))
+ (((class grayscale) (background light))
+ (:foreground "LightGray" :bold t :underline t))
+ (((class grayscale) (background dark))
+ (:foreground "Gray50" :bold t :underline t))
+ (t (:bold t :underline t)))
+ "Font Lock mode face used to highlight constants and labels."
+:group 'font-lock-faces)
+
(defface font-lock-reference-face
'((((class color) (background dark)) (:foreground "cadetblue2"))
(((class color) (background light)) (:foreground "red3"))
"Font Lock mode face used to highlight references."
:group 'font-lock-faces)
-;; #### FSF has font-lock-builtin-face.
-
(defface font-lock-preprocessor-face
'((((class color) (background dark)) (:foreground "steelblue1"))
(((class color) (background light)) (:foreground "blue3"))
"Font Lock Mode face used to highlight preprocessor conditionals."
:group 'font-lock-faces)
-;; #### Currently unused
(defface font-lock-warning-face
'((((class color) (background light)) (:foreground "Red" :bold t))
(((class color) (background dark)) (:foreground "Pink" :bold t))
font-lock-maximum-size
(cdr (or (assq major-mode font-lock-maximum-size)
(assq t font-lock-maximum-size))))))
- ;; Font-lock mode will refuse to turn itself on if in batch mode, or if
- ;; the current buffer is "invisible". The latter is because packages
- ;; sometimes put their temporary buffers into some particular major mode
- ;; to get syntax tables and variables and whatnot, but we don't want the
- ;; fact that the user has font-lock-mode on a mode hook to slow these
- ;; things down.
- (if (or noninteractive (eq (aref (buffer-name) 0) ?\ ))
- (setq on-p nil))
- (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp...
+ ;; Font-lock mode will refuse to turn itself on if in batch mode
+ ;; to avoid potential (probably not actual, though) slowdown. We
+ ;; used to try to "be nice" by avoiding doing this in temporary
+ ;; buffers. But with the deferral code we don't need this, and it
+ ;; definitely screws some things up.
+ (if (noninteractive)
(setq on-p nil))
(cond (on-p
(make-local-hook 'after-change-functions)
(defun font-lock-after-change-function (beg end old-len)
(when font-lock-mode
;; treat deletions as if the following character (or previous, if
- ;; there is no following) were inserted. this is a bit of a hack
+ ;; there is no following) were inserted. (also use the previous
+ ;; character at end of line. this avoids a problem when you
+ ;; insert a comment on the line before a line of code: if we use
+ ;; the following char, then when you hit backspace, the following
+ ;; line of code turns the comment color.) this is a bit of a hack
;; but allows us to use text properties for everything.
(if (= beg end)
- (cond ((/= end (point-max)) (setq end (1+ end)))
+ (cond ((not (save-excursion (goto-char end) (eolp)))
+ (setq end (1+ end)))
((/= beg (point-min)) (setq beg (1- beg)))
(t nil)))
(put-text-property beg end 'font-lock-pending t)
;; was supposedly much faster than the FSF version because it was written in
;; C. However, the FSF version uses parse-partial-sexp, which is also
;; written in C, and the benchmarking I did showed the
-;; syntactically-sectionize code to be slower overall. So here's the FSF
-;; version, modified to support font-lock-doc-string-face.
+;; syntactically-sectionize code to be slower overall. So here's the
+;; FSF version, modified to support font-lock-doc-string-face.
;; -- mct 2000-12-29
+;; #### Andy conditionally reverted Matt's change when we were experimenting
+;; with making lookup-syntax-properties an optional feature. I don't see how
+;; this code relates to lookup-syntax-properties, though. I wonder if the
+;; bug is in our (?) version of parse-partial-sexp. Andy says no. Of course,
+;; Matt benchmarked ... WTF knows? sjt 2002-09-28
(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."
+START should be at the beginning of a line. Optional argument LOUDLY
+is currently ignored."
(if font-lock-keywords-only
nil
(defun font-lock-apply-syntactic-highlight (highlight)
"Apply HIGHLIGHT following a match.
- HIGHLIGHT should be of the form MATCH-HIGHLIGHT,
- see `font-lock-syntactic-keywords'."
+HIGHLIGHT should be of the form MATCH-HIGHLIGHT,
+see `font-lock-syntactic-keywords'."
(let* ((match (nth 0 highlight))
(start (match-beginning match)) (end (match-end match))
(value (nth 1 highlight))
(font-lock-apply-syntactic-highlight (car highlights))
(font-lock-fontify-syntactic-anchored-keywords (car highlights)
end))
- (setq highlights (cdr highlights)))
- )
+ (setq highlights (cdr highlights))))
(setq keywords (cdr keywords)))))
\f
;;; Regexp fontification functions.
START should be at the beginning of a line."
(let ((loudly (and font-lock-verbose
(>= (- end start) font-lock-message-threshold))))
+ (unless (eq (car-safe font-lock-keywords) t)
+ (setq font-lock-keywords
+ (font-lock-compile-keywords font-lock-keywords)))
(let* ((case-fold-search font-lock-keywords-case-fold-search)
- (keywords (cdr (if (eq (car-safe font-lock-keywords) t)
- font-lock-keywords
- (font-lock-compile-keywords))))
+ (keywords (cdr font-lock-keywords))
(bufname (buffer-name))
(progress 5) (old-progress 5)
(iter 0)
\f
;; Various functions.
-(defun font-lock-compile-keywords (&optional keywords)
- ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD
- ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string.
- (let ((keywords (or keywords font-lock-keywords)))
- (setq font-lock-keywords
- (if (eq (car-safe keywords) t)
- keywords
- (cons t (mapcar 'font-lock-compile-keyword keywords))))))
+(defun font-lock-compile-keywords (keywords)
+ "Compile KEYWORDS (a list) and return the list of compiled keywords.
+Each keyword has the form (MATCHER HIGHLIGHT ...). See `font-lock-keywords'."
+ (if (eq (car-safe keywords) t)
+ keywords
+ (cons t (mapcar 'font-lock-compile-keyword keywords))))
(defun font-lock-compile-keyword (keyword)
(cond ((nlistp keyword) ; Just MATCHER
keyword)))
(defun font-lock-eval-keywords (keywords)
- ;; Evalulate KEYWORDS if a function (funcall) or variable (eval) name.
+ "Evaluate KEYWORDS if a function (funcall) or variable (eval) name."
(if (listp keywords)
keywords
(font-lock-eval-keywords (if (fboundp keywords)
projects / chise / xemacs-chise.git.1 / blobdiff