;; 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>
(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:
;;;###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'.
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)
(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
;; 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.
next redisplay cycle, avoiding excessive fontification when many
buffer modifications are performed or a buffer is reverted.")
-(defvar font-lock-pending-extent-table (make-hash-table :weakness 'key))
+;; list of buffers in which there is a pending change.
+(defvar font-lock-pending-buffer-table (make-hash-table :weakness 'key))
+;; table used to keep track of ranges needing fontification.
(defvar font-lock-range-table (make-range-table))
(defun font-lock-pre-idle-hook ()
(condition-case font-lock-error
- (if (> (hash-table-count font-lock-pending-extent-table) 0)
+ (if (> (hash-table-count font-lock-pending-buffer-table) 0)
(font-lock-fontify-pending-extents))
(error (warn "Error caught in `font-lock-pre-idle-hook': %s"
font-lock-error))))
(defun font-lock-after-change-function (beg end old-len)
(when font-lock-mode
- (let ((ex (make-extent beg end)))
- (set-extent-property ex 'detachable nil)
- (set-extent-property ex 'end-open nil)
- (let ((exs (gethash (current-buffer) font-lock-pending-extent-table)))
- (push ex exs)
- (puthash (current-buffer) exs font-lock-pending-extent-table)))
+ ;; treat deletions as if the following character (or previous, if
+ ;; 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 ((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)
+ (puthash (current-buffer) t font-lock-pending-buffer-table)
(if font-lock-always-fontify-immediately
(font-lock-fontify-pending-extents))))
;; only one buffer and one contiguous region!
(save-match-data
(maphash
- #'(lambda (buffer exs)
+ #'(lambda (buffer dummy)
;; remove first, to avoid infinite reprocessing if error
- (remhash buffer font-lock-pending-extent-table)
+ (remhash buffer font-lock-pending-buffer-table)
(when (buffer-live-p buffer)
(clear-range-table font-lock-range-table)
(with-current-buffer buffer
(save-excursion
(save-restriction
- ;; if we don't widen, then the C code will fail to
- ;; realize that we're inside a comment.
+ ;; if we don't widen, then the C code in
+ ;; syntactically-sectionize will fail to realize that
+ ;; we're inside a comment. #### We don't actually use
+ ;; syntactically-sectionize any more. Do we still
+ ;; need the widen?
(widen)
(let ((zmacs-region-stays
zmacs-region-stays)) ; protect from change!
- (mapc
- #'(lambda (ex)
- ;; paranoia.
- (when (and (extent-live-p ex)
- (not (extent-detached-p ex)))
- ;; first expand the ranges to full lines, because
- ;; that is what will be fontified; then use a
- ;; range table to merge the ranges.
- (let* ((beg (extent-start-position ex))
- (end (extent-end-position ex))
- (beg (progn (goto-char beg)
- (beginning-of-line)
- (point)))
- (end (progn (goto-char end)
- (forward-line 1)
- (point))))
- (detach-extent ex)
- (put-range-table beg end t
- font-lock-range-table))))
- exs)
+ (map-extents
+ #'(lambda (ex dummy-maparg)
+ ;; first expand the ranges to full lines,
+ ;; because that is what will be fontified;
+ ;; then use a range table to merge the
+ ;; ranges. (we could also do this simply using
+ ;; text properties. the range table code was
+ ;; here from a previous version of this code
+ ;; and works just as well.)
+ (let* ((beg (extent-start-position ex))
+ (end (extent-end-position ex))
+ (beg (progn (goto-char beg)
+ (beginning-of-line)
+ (point)))
+ (end (progn (goto-char end)
+ (forward-line 1)
+ (point))))
+ (put-range-table beg end t
+ font-lock-range-table)))
+ nil nil nil nil nil 'font-lock-pending t)
+ ;; clear all pending extents first in case of error below.
+ (put-text-property (point-min) (point-max)
+ 'font-lock-pending nil)
(map-range-table
#'(lambda (beg end val)
- ;; Maybe flush the internal cache used by
- ;; syntactically-sectionize. (It'd be nice if this
- ;; was more automatic.) Any deletions mean the
- ;; cache is invalid, and insertions at beginning or
- ;; end of line mean that the bol cache might be
- ;; invalid.
- ;; #### This code has been commented out for some time
- ;; now and is bit-rotting. Someone should look into
- ;; this.
-;; (if (or change-was-deletion (bobp)
-;; (= (preceding-char) ?\n))
-;; (buffer-syntactic-context-flush-cache))
- ;; #### This creates some unnecessary progress gauges.
+ ;; 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)))
+ font-lock-pending-buffer-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))
(progress-feedback-with-label '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)))
- (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)
(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
(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