;;; font-lock.el --- Electric font lock mode
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: jwz, then rms, then sm
;; Maintainer: FSF
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
This is normally set via `font-lock-add-keywords' and
`font-lock-remove-keywords'.")
+(put 'font-lock-keywords-alist 'risky-local-variable t)
(defvar font-lock-removed-keywords-alist nil
"Alist of `font-lock-keywords' elements to be removed for major modes.
;; contain the new keywords.
(font-lock-update-removed-keyword-alist mode keywords how))
(t
+ (when (and font-lock-mode
+ (not (or font-lock-keywords font-lock-defaults)))
+ ;; The major mode has not set any keywords, so when we enabled
+ ;; font-lock-mode it only enabled the font-core.el part, not the
+ ;; font-lock-mode-internal. Try again.
+ (font-lock-mode -1)
+ (set (make-local-variable 'font-lock-defaults) '(nil t))
+ (font-lock-mode 1))
;; Otherwise set or add the keywords now.
;; This is a no-op if it has been done already in this buffer
;; for the correct major mode.
;; If the keywords were compiled before, compile them again.
(if was-compiled
(setq font-lock-keywords
- (font-lock-compile-keywords font-lock-keywords t)))))))
+ (font-lock-compile-keywords font-lock-keywords)))))))
(defun font-lock-update-removed-keyword-alist (mode keywords how)
"Update `font-lock-removed-keywords-alist' when adding new KEYWORDS to MODE."
;; If the keywords were compiled before, compile them again.
(if was-compiled
(setq font-lock-keywords
- (font-lock-compile-keywords font-lock-keywords t)))))))
+ (font-lock-compile-keywords font-lock-keywords)))))))
\f
;;; Font Lock Support mode.
(setq font-lock-beg (or (previous-single-property-change
font-lock-beg 'font-lock-multiline)
(point-min))))
- ;;
+ ;;
(when (get-text-property font-lock-end 'font-lock-multiline)
(setq changed t)
(setq font-lock-end (or (text-property-any font-lock-end (point-max)
'font-lock-multiline nil)
(point-max))))
changed))
-
-
+
(defun font-lock-extend-region-wholelines ()
"Move fontification boundaries to beginning of lines."
(let ((changed nil))
(goto-char font-lock-beg)
- (unless (bolp) (setq changed t font-lock-beg (line-beginning-position)))
+ (unless (bolp)
+ (setq changed t font-lock-beg (line-beginning-position)))
(goto-char font-lock-end)
- (unless (bolp) (setq changed t font-lock-end (line-beginning-position 2)))
+ (unless (bolp)
+ (unless (eq font-lock-end
+ (setq font-lock-end (line-beginning-position 2)))
+ (setq changed t)))
changed))
(defun font-lock-default-fontify-region (beg end loudly)
;; number of lines.
;; (setq beg (progn (goto-char beg) (line-beginning-position))
;; end (progn (goto-char end) (line-beginning-position 2)))
- )
+ (unless (eq end (point-max))
+ ;; Rounding up to a whole number of lines should include the
+ ;; line right after `end'. Typical case: the first char of
+ ;; the line was deleted. Or a \n was inserted in the middle
+ ;; of a line.
+ (setq end (1+ end))))
(font-lock-fontify-region beg end)))))
(defvar jit-lock-start) (defvar jit-lock-end)
(setq beg (or (previous-single-property-change
beg 'font-lock-multiline)
(point-min))))
- (setq end (or (text-property-any end (point-max)
- 'font-lock-multiline nil)
- (point-max)))
+ (when (< end (point-max))
+ (setq end
+ (if (get-text-property end 'font-lock-multiline)
+ (or (text-property-any end (point-max)
+ 'font-lock-multiline nil)
+ (point-max))
+ ;; Rounding up to a whole number of lines should include the
+ ;; line right after `end'. Typical case: the first char of
+ ;; the line was deleted. Or a \n was inserted in the middle
+ ;; of a line.
+ (1+ end))))
;; Finally, pre-enlarge the region to a whole number of lines, to try
;; and anticipate what font-lock-default-fontify-region will do, so as to
;; avoid double-redisplay.
(when (memq 'font-lock-extend-region-wholelines
font-lock-extend-region-functions)
(goto-char beg)
- (forward-line 0)
- (setq jit-lock-start (min jit-lock-start (point)))
+ (setq jit-lock-start (min jit-lock-start (line-beginning-position)))
(goto-char end)
- (forward-line 1)
- (setq jit-lock-end (max jit-lock-end (point)))))))
+ (setq jit-lock-end
+ (max jit-lock-end
+ (if (bolp) (point) (line-beginning-position 2))))))))
(defun font-lock-fontify-block (&optional arg)
"Fontify some lines the way `font-lock-fontify-buffer' would.
;; 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)))
+ font-lock-syntactic-keywords
+ t)))
;; Get down to business.
(let ((case-fold-search font-lock-keywords-case-fold-search)
(keywords (cddr font-lock-syntactic-keywords))
LOUDLY, if non-nil, allows progress-meter bar."
(unless (eq (car font-lock-keywords) t)
(setq font-lock-keywords
- (font-lock-compile-keywords font-lock-keywords t)))
+ (font-lock-compile-keywords font-lock-keywords)))
(let ((case-fold-search font-lock-keywords-case-fold-search)
(keywords (cddr font-lock-keywords))
(bufname (buffer-name)) (count 0)
\f
;; Various functions.
-(defun font-lock-compile-keywords (keywords &optional regexp)
+(defun font-lock-compile-keywords (keywords &optional syntactic-keywords)
"Compile KEYWORDS into the form (t KEYWORDS COMPILED...)
Here each COMPILED is of the form (MATCHER HIGHLIGHT ...) as shown in the
`font-lock-keywords' doc string.
-If REGEXP is non-nil, it means these keywords are used for
-`font-lock-keywords' rather than for `font-lock-syntactic-keywords'."
+If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for
+`font-lock-syntactic-keywords' rather than for `font-lock-keywords'."
(if (not font-lock-set-defaults)
;; This should never happen. But some external packages sometimes
;; call font-lock in unexpected and incorrect ways. It's important to
(setq keywords
(cons t (cons keywords
(mapcar 'font-lock-compile-keyword keywords))))
- (if (and regexp
- (eq (or syntax-begin-function
- font-lock-beginning-of-syntax-function)
- 'beginning-of-defun)
+ (if (and (not syntactic-keywords)
+ (let ((beg-function
+ (or font-lock-beginning-of-syntax-function
+ syntax-begin-function)))
+ (or (eq beg-function 'beginning-of-defun)
+ (get beg-function 'font-lock-syntax-paren-check)))
(not beginning-of-defun-function))
;; Try to detect when a string or comment contains something that
;; looks like a defun and would thus confuse font-lock.
;; Now compile the keywords.
(unless (eq (car font-lock-keywords) t)
(setq font-lock-keywords
- (font-lock-compile-keywords font-lock-keywords t))))))
+ (font-lock-compile-keywords font-lock-keywords))))))
\f
;;; Colour etc. support.
"\\(advice\\|alias\\|generic\\|macro\\*?\\|method\\|"
"setf\\|subst\\*?\\|un\\*?\\|"
"ine-\\(condition\\|"
- "\\(?:derived\\|\\(?:global-\\)?minor\\|generic\\)-mode\\|"
+ "\\(?:derived\\|\\(?:global\\(?:ized\\)?-\\)?minor\\|generic\\)-mode\\|"
"method-combination\\|setf-expander\\|skeleton\\|widget\\|"
"function\\|\\(compiler\\|modify\\|symbol\\)-macro\\)\\)\\|"
;; Variable declarations.
"condition-case" "track-mouse"
"eval-after-load" "eval-and-compile" "eval-when-compile"
"eval-when" "eval-at-startup" "eval-next-after-load"
- "with-category-table"
+ "with-case-table" "with-category-table"
"with-current-buffer" "with-electric-help"
"with-local-quit" "with-no-warnings"
"with-output-to-string" "with-output-to-temp-buffer"
;; that do not occur in strings. The associated regexp matches one
;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to
;; avoid highlighting, for example, `\\(' in `\\\\('.
- (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?:\\)?\\|[|)]\\)\\)" bound t)
+ (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t)
(unless (match-beginning 2)
(let ((face (get-text-property (1- (point)) 'face)))
(when (or (and (listp face)
HCoop / bpt / emacs.git / blobdiff