;; Copyright (C) 1992-1995, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995 Amdahl Corporation.
-;; Copyright (C) 1996 Ben Wing.
+;; Copyright (C) 1996, 2000 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>
(integer :tag "size")))))
:group 'font-lock)
+;;;###autoload
+(defcustom font-lock-fontify-string-delimiters nil
+ "*If non-nil, apply font-lock-string-face to string delimiters as well as
+string text when fontifying."
+ :type 'boolean
+ :group 'font-lock)
\f
;; Fontification variables:
For example, an element of the first form highlights (if not already highlighted):
- \"\\\\<foo\\\\>\" Discrete occurrences of \"foo\" in the value
+ \"\\\\\\=<foo\\\\\\=>\" Discrete occurrences of \"foo\" in the value
of the variable `font-lock-keyword-face'.
(\"fu\\\\(bar\\\\)\" . 1) Substring \"bar\" within all occurrences of
`fubar-match' finds and matches in the value
of `fubar-face'.
- (\"\\\\<anchor\\\\>\" (0 anchor-face) (\"\\\\<item\\\\>\" nil nil (0 item-face)))
+ (\"\\\\\\=<anchor\\\\\\=>\" (0 anchor-face) (\"\\\\\\=<item\\\\\\=>\" nil nil (0 item-face)))
-------------- --------------- ------------ --- --- -------------
| | | | | |
MATCHER | ANCHOR-MATCHER | +------+ MATCH-HIGHLIGHT
;;;###autoload
(make-variable-buffer-local 'font-lock-keywords)
+;;;###autoload
+(defvar font-lock-syntactic-keywords nil
+ "A list of the syntactic keywords to highlight.
+Can be the list or the name of a function or variable whose value is the list.
+See `font-lock-keywords' for a description of the form of this list;
+the differences are listed below. MATCH-HIGHLIGHT should be of the form:
+
+ (MATCH SYNTAX OVERRIDE LAXMATCH)
+
+where SYNTAX can be of the form (SYNTAX-CODE . MATCHING-CHAR), the name of a
+syntax table, or an expression whose value is such a form or a syntax table.
+OVERRIDE cannot be `prepend' or `append'.
+
+For example, an element of the form highlights syntactically:
+
+ (\"\\\\$\\\\(#\\\\)\" 1 (1 . nil))
+
+ a hash character when following a dollar character, with a SYNTAX-CODE of
+ 1 (meaning punctuation syntax). Assuming that the buffer syntax table does
+ specify hash characters to have comment start syntax, the element will only
+ highlight hash characters that do not follow dollar characters as comments
+ syntactically.
+
+ (\"\\\\('\\\\).\\\\('\\\\)\"
+ (1 (7 . ?'))
+ (2 (7 . ?')))
+
+ both single quotes which surround a single character, with a SYNTAX-CODE of
+ 7 (meaning string quote syntax) and a MATCHING-CHAR of a single quote (meaning
+ a single quote matches a single quote). Assuming that the buffer syntax table
+ does not specify single quotes to have quote syntax, the element will only
+ highlight single quotes of the form 'c' as strings syntactically.
+ Other forms, such as foo'bar or 'fubar', will not be highlighted as strings.
+
+This is normally set via `font-lock-defaults'."
+)
+;;;###autoload
+(make-variable-buffer-local 'font-lock-syntactic-keywords)
+
(defvar font-lock-defaults nil
"The defaults font Font Lock mode for the current buffer.
Normally, do not set this directly. If you are writing a major mode,
This is normally set via `font-lock-defaults'.")
(make-variable-buffer-local 'font-lock-syntax-table)
-;; These are used in the FSF version in syntactic font-locking.
-;; We do this all in C.
-;;; These record the parse state at a particular position, always the
-;;; start of a line. Used to make
-;;; `font-lock-fontify-syntactically-region' faster.
-;(defvar font-lock-cache-position nil)
-;(defvar font-lock-cache-state nil)
-;(make-variable-buffer-local 'font-lock-cache-position)
-;(make-variable-buffer-local 'font-lock-cache-state)
+;; These record the parse state at a particular position, always the start of a
+;; line. Used to make `font-lock-fontify-syntactically-region' faster.
+;; Previously, `font-lock-cache-position' was just a buffer position. However,
+;; under certain situations, this occasionally resulted in mis-fontification.
+;; I think the "situations" were deletion with Lazy Lock mode's deferral. sm.
+(defvar font-lock-cache-state nil)
+(defvar font-lock-cache-position nil)
+(make-variable-buffer-local 'font-lock-cache-state)
+(make-variable-buffer-local 'font-lock-cache-position)
;; If this is nil, we only use the beginning of the buffer if we can't use
;; `font-lock-cache-position' and `font-lock-cache-state'.
;; #### 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.
+;; forget to properly quote their faces. I tried just let-binding
+;; them when we eval the face expression, but that failes 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
- "Don't even think of using this.")
+ "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-doc-string-face 'font-lock-doc-string-face
- "Don't even think of using this.")
+ "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-string-face 'font-lock-string-face
- "Don't even think of using this.")
+ "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-keyword-face 'font-lock-keyword-face
- "Don't even think of using this.")
+ "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
- "Don't even think of using this.")
+ "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-variable-name-face 'font-lock-variable-name-face
- "Don't even think of using this.")
+ "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-type-face 'font-lock-type-face
- "Don't even think of using this.")
+ "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
- "Don't even think of using this.")
+ "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-preprocessor-face 'font-lock-preprocessor-face
- "Don't even think of using this.")
+ "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.")
(defconst font-lock-face-list
'(font-lock-comment-face
((or (null maximum-size) (<= (buffer-size) maximum-size))
(font-lock-fontify-buffer))
(font-lock-verbose
- (lprogress-display 'font-lock
- "Fontifying %s... buffer too big." 'abort
- (buffer-name)))))
+ (progress-feedback-with-label
+ 'font-lock
+ "Fontifying %s... buffer too big." 'abort
+ (buffer-name)))))
(font-lock-fontified
(setq font-lock-fontified nil)
(font-lock-unfontify-region (point-min) (point-max))
;;;###autoload
(defun turn-on-font-lock ()
"Unconditionally turn on Font Lock mode."
+ (interactive)
(font-lock-mode 1))
;;;###autoload
(defun turn-off-font-lock ()
"Unconditionally turn off Font Lock mode."
+ (interactive)
(font-lock-mode 0))
;;; FSF has here:
(defsubst font-lock-remove-face (start end)
;; Remove any syntax highlighting on the characters in the range.
(put-nonduplicable-text-property start end 'face nil)
- (put-nonduplicable-text-property start end 'font-lock nil))
+ (put-nonduplicable-text-property start end 'font-lock nil)
+ (if lookup-syntax-properties
+ (put-nonduplicable-text-property start end 'syntax-table nil)))
+
+(defsubst font-lock-set-syntax (start end syntax)
+ ;; Set the face on the characters in the range.
+ (put-nonduplicable-text-property start end 'syntax-table syntax)
+ (put-nonduplicable-text-property start end 'font-lock t))
(defsubst font-lock-any-faces-p (start end)
;; Return non-nil if we've put any syntax highlighting on
(font-lock-mode 0)))
(set (make-local-variable 'font-lock-fontified) t)
(when (and aborted font-lock-verbose)
- (lprogress-display 'font-lock "Fontifying %s... aborted."
- 'abort (buffer-name))))
+ (progress-feedback-with-label 'font-lock "Fontifying %s... aborted."
+ 'abort (buffer-name))))
(run-hooks 'font-lock-after-fontify-buffer-hook)))
(defun font-lock-default-unfontify-buffer ()
;; Use the fontification syntax table, if any.
(if font-lock-syntax-table (set-syntax-table font-lock-syntax-table))
;; Now do the fontification.
- (if font-lock-keywords-only
- (font-lock-unfontify-region beg end)
+ (font-lock-unfontify-region beg end)
+ (when font-lock-syntactic-keywords
+ (font-lock-fontify-syntactic-keywords-region beg end))
+ (unless font-lock-keywords-only
(font-lock-fontify-syntactically-region beg end loudly))
(font-lock-fontify-keywords-region beg end loudly))
;; Clean up.
(defun font-lock-default-unfontify-region (beg end &optional maybe-loudly)
(when (and maybe-loudly font-lock-verbose
(>= (- end beg) font-lock-message-threshold))
- (lprogress-display 'font-lock "Fontifying %s..." 0 (buffer-name)))
+ (progress-feedback-with-label '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)
;; (if (or change-was-deletion (bobp)
;; (= (preceding-char) ?\n))
;; (buffer-syntactic-context-flush-cache))
- (if (and (= beg (point-min))
- (= end (point-max)))
- (font-lock-fontify-buffer)
- (font-lock-fontify-region beg end)))
+ ;; #### This creates some unnecessary progress gauges.
+;; (if (and (= beg (point-min))
+;; (= end (point-max)))
+;; (font-lock-fontify-buffer)
+;; (font-lock-fontify-region beg end)))
+ (font-lock-fontify-region beg end))
font-lock-range-table)))))))
font-lock-pending-extent-table)))
\f
;; Syntactic fontification functions.
-;; Note: Here is the FSF version. Our version is much faster because
-;; of the C support we provide. This may be useful for reference,
-;; however, and perhaps there is something useful here that should
-;; be merged into our version.
-;;
-;(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."
-; (let ((synstart (if comment-start-skip
-; (concat "\\s\"\\|" comment-start-skip)
-; "\\s\""))
-; (comstart (if comment-start-skip
-; (concat "\\s<\\|" comment-start-skip)
-; "\\s<"))
-; state prev prevstate)
-; (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
-; (save-restriction
-; (widen)
-; (goto-char start)
-; ;;
-; ;; Find the state at the `beginning-of-line' before `start'.
-; (if (eq start font-lock-cache-position)
-; ;; Use the cache for the state of `start'.
-; (setq state font-lock-cache-state)
-; ;; Find the state of `start'.
-; (if (null font-lock-beginning-of-syntax-function)
-; ;; Use the state at the previous cache position, if any, or
-; ;; otherwise calculate from `point-min'.
-; (if (or (null font-lock-cache-position)
-; (< start font-lock-cache-position))
-; (setq state (parse-partial-sexp (point-min) start))
-; (setq state (parse-partial-sexp font-lock-cache-position start
-; nil nil font-lock-cache-state)))
-; ;; Call the function to move outside any syntactic block.
-; (funcall font-lock-beginning-of-syntax-function)
-; (setq state (parse-partial-sexp (point) start)))
-; ;; Cache the state and position of `start'.
-; (setq font-lock-cache-state state
-; font-lock-cache-position start))
-; ;;
-; ;; If the region starts inside a string, show the extent of it.
-; (if (nth 3 state)
-; (let ((beg (point)))
-; (while (and (re-search-forward "\\s\"" end 'move)
-; (nth 3 (parse-partial-sexp beg (point)
-; nil nil state))))
-; (put-text-property beg (point) 'face font-lock-string-face)
-; (setq state (parse-partial-sexp beg (point) nil nil state))))
-; ;;
-; ;; Likewise for a comment.
-; (if (or (nth 4 state) (nth 7 state))
-; (let ((beg (point)))
-; (save-restriction
-; (narrow-to-region (point-min) end)
-; (condition-case nil
-; (progn
-; (re-search-backward comstart (point-min) 'move)
-; (forward-comment 1)
-; ;; forward-comment skips all whitespace,
-; ;; so go back to the real end of the comment.
-; (skip-chars-backward " \t"))
-; (error (goto-char end))))
-; (put-text-property beg (point) 'face font-lock-comment-face)
-; (setq state (parse-partial-sexp beg (point) nil nil state))))
-; ;;
-; ;; Find each interesting place between here and `end'.
-; (while (and (< (point) end)
-; (setq prev (point) prevstate state)
-; (re-search-forward synstart end t)
-; (progn
-; ;; Clear out the fonts of what we skip over.
-; (remove-text-properties prev (point) '(face nil))
-; ;; Verify the state at that place
-; ;; so we don't get fooled by \" or \;.
-; (setq state (parse-partial-sexp prev (point)
-; nil nil state))))
-; (let ((here (point)))
-; (if (or (nth 4 state) (nth 7 state))
-; ;;
-; ;; We found a real comment start.
-; (let ((beg (match-beginning 0)))
-; (goto-char beg)
-; (save-restriction
-; (narrow-to-region (point-min) end)
-; (condition-case nil
-; (progn
-; (forward-comment 1)
-; ;; forward-comment skips all whitespace,
-; ;; so go back to the real end of the comment.
-; (skip-chars-backward " \t"))
-; (error (goto-char end))))
-; (put-text-property beg (point) 'face
-; font-lock-comment-face)
-; (setq state (parse-partial-sexp here (point) nil nil state)))
-; (if (nth 3 state)
-; ;;
-; ;; We found a real string start.
-; (let ((beg (match-beginning 0)))
-; (while (and (re-search-forward "\\s\"" end 'move)
-; (nth 3 (parse-partial-sexp here (point)
-; nil nil state))))
-; (put-text-property beg (point) 'face font-lock-string-face)
-; (setq state (parse-partial-sexp here (point)
-; nil nil state))))))
-; ;;
-; ;; Make sure `prev' is non-nil after the loop
-; ;; only if it was set on the very last iteration.
-; (setq prev nil)))
-; ;;
-; ;; 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
;; in add-log, but I think this encompasses more modes.
(string-match "lisp\\|scheme" (symbol-name mode))))
+;; fontify-syntactically-region used to use syntactically-sectionize, which
+;; 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.
+;; -- mct 2000-12-29
(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."
(if font-lock-keywords-only
nil
+
+ ;; #### Shouldn't this just be using 'loudly??
(when (and font-lock-verbose
(>= (- end start) font-lock-message-threshold))
- (lprogress-display 'font-lock "Fontifying %s... (syntactically)" 5
- (buffer-name)))
- (font-lock-unfontify-region start end loudly)
+ (progress-feedback-with-label 'font-lock
+ "Fontifying %s... (syntactically)" 5
+ (buffer-name)))
(goto-char start)
- (if (> end (point-max)) (setq end (point-max)))
- (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
-; ;; event it should be in C for speed --jwz)
-; (save-excursion
-; (goto-char s)
-; (while (prog1 (search-forward "\n" (1- e) 'move)
-; (setq face 'font-lock-comment-face)
-; (setq e (point)))
-; (skip-chars-forward " \t\n")
-; (setq s (point)))
- ))
- (font-lock-set-face s e face)))
- start end)
- )))
+
+ (let ((lisp-like (font-lock-lisp-like major-mode))
+ (cache (marker-position font-lock-cache-position))
+ state string beg depth)
+ ;;
+ ;; Find the state at the `beginning-of-line' before `start'.
+ (if (eq start cache)
+ ;; Use the cache for the state of `start'.
+ (setq state font-lock-cache-state)
+ ;; Find the state of `start'.
+ (if (null font-lock-beginning-of-syntax-function)
+ ;; Use the state at the previous cache position, if any, or
+ ;; otherwise calculate from `point-min'.
+ (if (or (null cache) (< start cache))
+ (setq state (parse-partial-sexp (point-min) start))
+ (setq state (parse-partial-sexp cache start nil nil
+ font-lock-cache-state)))
+ ;; Call the function to move outside any syntactic block.
+ (funcall font-lock-beginning-of-syntax-function)
+ (setq state (parse-partial-sexp (point) start)))
+ ;; Cache the state and position of `start'.
+ (setq font-lock-cache-state state)
+ (set-marker font-lock-cache-position start))
+ ;;
+ ;; If the region starts inside a string or comment, show the extent of it.
+ (when (or (nth 3 state) (nth 4 state))
+ (setq string (nth 3 state) beg (point))
+ (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table))
+ (font-lock-set-face beg (point) (if string
+ font-lock-string-face
+ font-lock-comment-face)))
+ ;;
+ ;; Find each interesting place between here and `end'.
+ (while (and (< (point) end)
+ (progn
+ (setq state (parse-partial-sexp (point) end nil nil state
+ 'syntax-table))
+ (or (nth 3 state) (nth 4 state))))
+ (setq depth (nth 0 state) string (nth 3 state) beg (nth 8 state))
+ (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table))
+ (if string
+ ;; #### It would be nice if we handled Python and other
+ ;; non-Lisp languages with docstrings correctly.
+ (let ((face (if (and lisp-like (= depth 1))
+ 'font-lock-doc-string-face
+ 'font-lock-string-face)))
+ (if font-lock-fontify-string-delimiters
+ (font-lock-set-face beg (point) face)
+ (font-lock-set-face (+ beg 1) (- (point) 1) face)))
+ (font-lock-set-face beg (point)
+ font-lock-comment-face))))))
\f
;;; Additional text property functions.
object)
(setq start next))))
\f
+;;; Syntactic regexp fontification functions (taken from FSF Emacs 20.7.1)
+
+;; These syntactic keyword pass functions are identical to those keyword pass
+;; functions below, with the following exceptions; (a) they operate on
+;; `font-lock-syntactic-keywords' of course, (b) they are all `defun' as speed
+;; is less of an issue, (c) eval of property value does not occur JIT as speed
+;; is less of an issue, (d) OVERRIDE cannot be `prepend' or `append' as it
+;; makes no sense for `syntax-table' property values, (e) they do not do it
+;; LOUDLY as it is not likely to be intensive.
+
+(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'."
+ (let* ((match (nth 0 highlight))
+ (start (match-beginning match)) (end (match-end match))
+ (value (nth 1 highlight))
+ (override (nth 2 highlight)))
+ (unless (numberp (car-safe value))
+ (setq value (eval value)))
+ (cond ((not start)
+ ;; No match but we might not signal an error.
+ (or (nth 3 highlight)
+ (error "No match %d in highlight %S" match highlight)))
+ ((not override)
+ ;; Cannot override existing fontification.
+ (or (map-extents 'extent-property (current-buffer)
+ start end 'syntax-table)
+ (font-lock-set-syntax start end value)))
+ ((eq override t)
+ ;; Override existing fontification.
+ (font-lock-set-syntax start end value))
+ ((eq override 'keep)
+ ;; Keep existing fontification.
+ (font-lock-fillin-text-property start end
+ 'syntax-table 'font-lock value)))))
+
+(defun font-lock-fontify-syntactic-anchored-keywords (keywords limit)
+ "Fontify according to KEYWORDS until LIMIT.
+ KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords',
+ LIMIT can be modified by the value of its PRE-MATCH-FORM."
+ (let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights
+ ;; Evaluate PRE-MATCH-FORM.
+ (pre-match-value (eval (nth 1 keywords))))
+ ;; Set LIMIT to value of PRE-MATCH-FORM or the end of line.
+ (if (and (numberp pre-match-value) (> pre-match-value (point)))
+ (setq limit pre-match-value)
+ (save-excursion (end-of-line) (setq limit (point))))
+ (save-match-data
+ ;; Find an occurrence of `matcher' before `limit'.
+ (while (if (stringp matcher)
+ (re-search-forward matcher limit t)
+ (funcall matcher limit))
+ ;; Apply each highlight to this instance of `matcher'.
+ (setq highlights lowdarks)
+ (while highlights
+ (font-lock-apply-syntactic-highlight (car highlights))
+ (setq highlights (cdr highlights)))))
+ ;; Evaluate POST-MATCH-FORM.
+ (eval (nth 2 keywords))))
+
+(defun font-lock-fontify-syntactic-keywords-region (start end)
+ "Fontify according to `font-lock-syntactic-keywords' between START and END.
+START should be at the beginning of a line."
+;; ;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords.
+ (when (symbolp font-lock-syntactic-keywords)
+ (setq font-lock-syntactic-keywords (font-lock-eval-keywords
+ font-lock-syntactic-keywords)))
+ ;; If `font-lock-syntactic-keywords' is not compiled, compile it.
+ (unless (eq (car font-lock-syntactic-keywords) t)
+ (setq font-lock-syntactic-keywords (font-lock-compile-keywords
+ font-lock-syntactic-keywords)))
+ ;; Get down to business.
+ (let ((case-fold-search font-lock-keywords-case-fold-search)
+ (keywords (cdr font-lock-syntactic-keywords))
+ keyword matcher highlights)
+ (while keywords
+ ;; Find an occurrence of `matcher' from `start' to `end'.
+ (setq keyword (car keywords) matcher (car keyword))
+ (goto-char start)
+ (while (if (stringp matcher)
+ (re-search-forward matcher end t)
+ (funcall matcher end))
+ ;; Apply each highlight to this instance of `matcher', which may be
+ ;; specific highlights or more keywords anchored to `matcher'.
+ (setq highlights (cdr keyword))
+ (while highlights
+ (if (numberp (car (car highlights)))
+ (font-lock-apply-syntactic-highlight (car highlights))
+ (font-lock-fontify-syntactic-anchored-keywords (car highlights)
+ end))
+ (setq highlights (cdr highlights)))
+ )
+ (setq keywords (cdr keywords)))))
+\f
;;; Regexp fontification functions.
(defsubst font-lock-apply-highlight (highlight)
(+ (/ (* (- (point) start) 95) (* (- end start) nkeywords))
(/ (* iter 95) nkeywords) 5))
(when (and loudly (> progress old-progress))
- (lprogress-display 'font-lock "Fontifying %s... (regexps)"
- progress bufname))
+ (progress-feedback-with-label 'font-lock
+ "Fontifying %s... (regexps)"
+ progress bufname))
(setq old-progress progress)
;; Apply each highlight to this instance of `matcher', which may be
;; specific highlights or more keywords anchored to `matcher'.
(setq highlights (cdr highlights))))
(setq iter (1+ iter))
(setq keywords (cdr keywords))))
- (if loudly (lprogress-display 'font-lock "Fontifying %s... " 100 (buffer-name)))))
+ (if loudly
+ (progress-feedback-with-label 'font-lock "Fontifying %s... " 100
+ (buffer-name)))))
\f
;; Various functions.
(t ; Hopefully (MATCHER HIGHLIGHT ...)
keyword)))
+(defun font-lock-eval-keywords (keywords)
+ ;; Evalulate KEYWORDS if a function (funcall) or variable (eval) name.
+ (if (listp keywords)
+ keywords
+ (font-lock-eval-keywords (if (fboundp keywords)
+ (funcall keywords)
+ (eval keywords)))))
+
(defun font-lock-choose-keywords (keywords level)
;; Return LEVELth element of KEYWORDS. A LEVEL of nil is equal to a
;; LEVEL of 0, a LEVEL of t is equal to (1- (length KEYWORDS)).
(font-lock-find-font-lock-defaults major-mode)))
(keywords (font-lock-choose-keywords
(nth 0 defaults) font-lock-maximum-decoration)))
-
+
;; Keywords?
(setq font-lock-keywords (if (fboundp keywords)
(funcall keywords)
(setq font-lock-beginning-of-syntax-function
'beginning-of-defun)))))
+ (setq font-lock-cache-position (make-marker))
(setq font-lock-defaults-computed t)))
\f
;;
;; Control structures. ELisp and CLisp combined.
;;
- ;;(regexp-opt
- ;; '("cond" "if" "while" "let" "let*" "prog" "progn" "prog1"
- ;; "prog2" "progv" "catch" "throw" "save-restriction"
- ;; "save-excursion" "save-window-excursion"
- ;; "save-current-buffer" "with-current-buffer"
- ;; "with-temp-file" "with-temp-buffer" "with-output-to-string"
- ;; "with-string-as-buffer-contents"
- ;; "save-selected-window" "save-match-data" "unwind-protect"
- ;; "condition-case" "track-mouse" "autoload"
- ;; "eval-after-load" "eval-and-compile" "eval-when-compile"
- ;; "when" "unless" "do" "dolist" "dotimes" "flet" "labels"
- ;; "lambda" "return" "return-from"))
(cons
(concat
"(\\("
- "autoload\\|c\\(atch\\|ond\\(ition-case\\)?\\)\\|do\\(list\\|"
- "times\\)?\\|eval-\\(a\\(fter-load\\|nd-compile\\)\\|when-compile\\)\\|"
- "flet\\|if\\|l\\(a\\(bels\\|mbda\\)\\|et\\*?\\)\\|"
- "prog[nv12\\*]?\\|return\\(-from\\)?\\|save-\\(current-buffer\\|"
- "excursion\\|match-data\\|restriction\\|selected-window\\|"
- "window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|un\\(less\\|"
- "wind-protect\\)\\|w\\(h\\(en\\|ile\\)\\|ith-\\(current-buffer\\|"
- "output-to-string\\|string-as-buffer-contents\\|temp-\\(buffer\\|"
- "file\\)\\)\\)"
+ ;; beginning of generated stuff
+ ;; to regenerate, use the regexp-opt below, then delete the outermost
+ ;; grouping, then use the macro below to break up the string.
+ ;; (regexp-opt
+ ;; '("cond" "if" "while" "let" "let*" "prog" "progn" "prog1"
+ ;; "prog2" "progv" "catch" "throw" "save-restriction"
+ ;; "save-excursion" "save-window-excursion"
+ ;; "save-current-buffer" "with-current-buffer"
+ ;; "save-selected-window" "with-selected-window"
+ ;; "save-selected-frame" "with-selected-frame"
+ ;; "with-temp-file" "with-temp-buffer" "with-output-to-string"
+ ;; "with-string-as-buffer-contents"
+ ;; "save-match-data" "unwind-protect" "call-with-condition-handler"
+ ;; "condition-case" "track-mouse" "autoload"
+ ;; "eval-after-load" "eval-and-compile" "eval-when-compile"
+ ;; "when" "unless" "do" "dolist" "dotimes" "flet" "labels"
+ ;; "lambda" "block" "return" "return-from" "loop") t)
+ ;; (setq last-kbd-macro
+ ;; (read-kbd-macro "\" C-7 C-1 <right> C-r \\\\| 3*<right> \" RET"))
+ "autoload\\|block\\|c\\(?:a\\(?:ll-with-condition-handler\\|tch\\)\\|"
+ "ond\\(?:ition-case\\)?\\)\\|do\\(?:list\\|times\\)?\\|"
+ "eval-\\(?:a\\(?:fter-load\\|nd-compile\\)\\|when-compile\\)\\|flet\\|"
+ "if\\|l\\(?:a\\(?:bels\\|mbda\\)\\|et\\*?\\|oop\\)\\|prog[12nv]?\\|"
+ "return\\(?:-from\\)?\\|save-\\(?:current-buffer\\|excursion\\|"
+ "match-data\\|restriction\\|selected-\\(?:frame\\|window\\)\\|"
+ "window-excursion\\)\\|t\\(?:hrow\\|rack-mouse\\)\\|un\\(?:less\\|"
+ "wind-protect\\)\\|w\\(?:h\\(?:en\\|ile\\)\\|ith-\\(?:current-buffer\\|"
+ "output-to-string\\|s\\(?:elected-\\(?:frame\\|window\\)\\|"
+ "tring-as-buffer-contents\\)\\|temp-\\(?:buffer\\|file\\)\\)\\)"
+ ;; end of generated stuff
"\\)\\>") 1)
;;
;; Feature symbols as references.
(c++-keywords
; ("break" "continue" "do" "else" "for" "if" "return" "switch" "while"
; "asm" "catch" "delete" "new" "operator" "sizeof" "this" "throw" "try"
-; "protected" "private" "public")
- (concat "asm\\|break\\|c\\(atch\\|ontinue\\)\\|d\\(elete\\|o\\)\\|"
- "else\\|for\\|if\\|new\\|"
- "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|return\\|"
- "s\\(izeof\\|witch\\)\\|t\\(h\\(is\\|row\\)\\|ry\\)\\|while"))
+; "protected" "private" "public" "const_cast" "dynamic_cast" "reinterpret_cast"
+; "static_cast" "and" "bitor" "or" "xor" "compl" "bitand" "and_eq"
+; "or_eq" "xor_eq" "not" "not_eq" "typeid" "false" "true")
+ (concat "a\\(nd\\(\\|_eq\\)\\|sm\\)\\|"
+ "b\\(it\\(or\\|and\\)\\|reak\\)\\|"
+ "c\\(atch\\|o\\(mpl\\|n\\(tinue\\|st_cast\\)\\)\\)\\|"
+ "d\\(elete\\|o\\|ynamic_cast\\)\\|"
+ "else\\|"
+ "f\\(alse\\|or\\)\\|if\\|"
+ "n\\(ew\\|ot\\(\\|_eq\\)\\)\\|"
+ "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|"
+ "or\\(\\|_eq\\)\\|"
+ "re\\(interpret_cast\\|turn\\)\\|"
+ "s\\(izeof\\|tatic_cast\\|witch\\)\\|"
+ "t\\(h\\(is\\|row\\)\\|r\\(ue\\|y\\)\\|ypeid\\)\\|"
+ "xor\\(\\|_eq\\)\\|while"))
(c++-type-types
; ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum"
; "signed" "unsigned" "short" "long" "int" "char" "float" "double"
; "void" "volatile" "const" "class" "inline" "friend" "bool"
-; "virtual" "complex" "template")
+; "virtual" "complex" "template" "explicit" "mutable" "export" "namespace"
+; "using" "typename" "wchar_t")
(concat "auto\\|bool\\|c\\(har\\|lass\\|o\\(mplex\\|nst\\)\\)\\|"
- "double\\|e\\(num\\|xtern\\)\\|f\\(loat\\|riend\\)\\|"
- "in\\(line\\|t\\)\\|long\\|register\\|"
+ "double\\|"
+ "e\\(num\\|x\\(p\\(licit\\|ort\\)\\|tern\\)\\)\\|"
+ "f\\(loat\\|riend\\)\\|"
+ "in\\(line\\|t\\)\\|long\\|mutable\\|namespace\\|register\\|"
"s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|"
- "t\\(emplate\\|ypedef\\)\\|un\\(ion\\|signed\\)\\|"
- "v\\(irtual\\|o\\(id\\|latile\\)\\)")) ; 11 ()s deep.
+ "t\\(emplate\\|ype\\(def\\|name\\)\\)\\|"
+ "u\\(\\(n\\(ion\\|signed\\)\\|sing\\)\\)\\|"
+ "v\\(irtual\\|o\\(id\\|latile\\)\\)\\|"
+ "wchar_t")) ; 11 ()s deep.
(ctoken "\\(\\sw\\|\\s_\\|[:~*&]\\)+")
)
(setq c-font-lock-keywords-1
"\\|long\\|short\\|void\\)\\>")
"Regexp which should match a primitive type.")
-(let ((capital-letter "A-Z\300-\326\330-\337")
- (letter "a-zA-Z_$\300-\326\330-\366\370-\377")
- (digit "0-9"))
(defvar java-font-lock-identifier-regexp
- (concat "\\<\\([" letter "][" letter digit "]*\\)\\>")
+ (let ((letter "a-zA-Z_$\300-\326\330-\366\370-\377")
+ (digit "0-9"))
+ (concat "\\<\\([" letter "][" letter digit "]*\\)\\>"))
"Regexp which should match all Java identifiers.")
(defvar java-font-lock-class-name-regexp
- (concat "\\<\\([" capital-letter "][" letter digit "]*\\)\\>")
+ (let ((capital-letter "A-Z\300-\326\330-\337")
+ (letter "a-zA-Z_$\300-\326\330-\366\370-\377")
+ (digit "0-9"))
+ (concat "\\<\\([" capital-letter "][" letter digit "]*\\)\\>"))
"Regexp which should match a class or an interface name.
The name is assumed to begin with a capital letter.")
-)
-
(let ((java-modifier-regexp
(concat "\\<\\(abstract\\|const\\|final\\|native\\|"
(list
;; Javadoc tags
- '("@\\(author\\|exception\\|throws\\|deprecated\\|param\\|return\\|see\\|since\\|version\\)\\s "
+ '("@\\(author\\|deprecated\\|exception\\|throws\\|param\\|return\\|see\\|since\\|version\\|serial\\|serialData\\|serialField\\)\\s "
0 font-lock-keyword-face t)
;; Doc tag - Parameter identifiers
3 (if (match-beginning 2) 'bold 'italic) keep))
"Default expressions to highlight in TeX modes.")
-(defconst ksh-font-lock-keywords (purecopy
+(defconst ksh-font-lock-keywords
(list
'("\\(^\\|[^\$\\\]\\)#.*" . font-lock-comment-face)
'("\\<\\(if\\|then\\|else\\|elif\\|fi\\|case\\|esac\\|for\\|do\\|done\\|foreach\\|in\\|end\\|select\\|while\\|repeat\\|time\\|function\\|until\\|exec\\|command\\|coproc\\|noglob\\|nohup\\|nocorrect\\|source\\|autoload\\|alias\\|unalias\\|export\\|set\\|echo\\|eval\\|cd\\|log\\|compctl\\)\\>" . font-lock-keyword-face)
'("\\<\\[\\[.*\\]\\]\\>" . font-lock-type-face)
'("\$\(.*\)" . font-lock-type-face)
- ))
+ )
"Additional expressions to highlight in ksh-mode.")
-(defconst sh-font-lock-keywords (purecopy
+(defconst sh-font-lock-keywords
(list
'("\\(^\\|[^\$\\\]\\)#.*" . font-lock-comment-face)
'("\\<\\(if\\|then\\|else\\|elif\\|fi\\|case\\|esac\\|for\\|do\\|done\\|in\\|while\\|exec\\|export\\|set\\|echo\\|eval\\|cd\\)\\>" . font-lock-keyword-face)
'("\\[.*\\]" . font-lock-type-face)
'("`.*`" . font-lock-type-face)
- ))
+ )
"Additional expressions to highlight in sh-mode.")
\f
projects / chise / xemacs-chise.git- / blobdiff