Merge from emacs-24 branch; up to 2012-05-01T18:47:23Z!rgm@gnu.org
[bpt/emacs.git] / lisp / font-lock.el
index 6902ce9..f3e313e 100644 (file)
@@ -1,6 +1,6 @@
 ;;; font-lock.el --- Electric font lock mode
 
-;; Copyright (C) 1992-201 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski
 ;;     Richard Stallman
@@ -67,7 +67,7 @@
 ;;
 ;; The syntactic keyword pass places `syntax-table' text properties in the
 ;; buffer according to the variable `font-lock-syntactic-keywords'.  It is
-;; necessary because Emacs' syntax table is not powerful enough to describe all
+;; necessary because Emacs's syntax table is not powerful enough to describe all
 ;; the different syntactic constructs required by the sort of people who decide
 ;; that a single quote can be syntactic or not depending on the time of day.
 ;; (What sort of person could decide to overload the meaning of a quote?)
 ;;; Code:
 
 (require 'syntax)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 ;; Define core `font-lock' group.
 (defgroup font-lock '((jit-lock custom-group))
 ;; User variables.
 
 (defcustom font-lock-maximum-size 256000
-  "Maximum size of a buffer for buffer fontification.
-Only buffers less than this can be fontified when Font Lock mode is turned on.
+  "Maximum buffer size for unsupported buffer fontification.
+When `font-lock-support-mode' is nil, only buffers smaller than
+this are fontified.  This variable has no effect if a Font Lock
+support mode (usually `jit-lock-mode') is enabled.
+
 If nil, means size is irrelevant.
 If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
 where MAJOR-MODE is a symbol or t (meaning the default).  For example:
@@ -248,6 +251,7 @@ for buffers in Rmail mode, and size is irrelevant otherwise."
                                      (const :tag "none" nil)
                                      (integer :tag "size")))))
   :group 'font-lock)
+(make-obsolete-variable 'font-lock-maximum-size nil "24.1")
 
 (defcustom font-lock-maximum-decoration t
   "Maximum decoration level for fontification.
@@ -290,7 +294,7 @@ If a number, only buffers greater than this size have fontification messages."
 ;; and they give users another mechanism for changing face appearance.
 ;; We now allow a FACENAME in `font-lock-keywords' to be any expression that
 ;; returns a face.  So the easiest thing is to continue using these variables,
-;; rather than sometimes evaling FACENAME and sometimes not.  sm.
+;; rather than sometimes evalling FACENAME and sometimes not.  sm.
 
 ;; Note that in new code, in the vast majority of cases there is no
 ;; need to create variables that specify face names.  Simply using
@@ -488,11 +492,11 @@ This is normally set via `font-lock-add-keywords' and
 `font-lock-remove-keywords'.")
 
 (defvar font-lock-keywords-only nil
-  "*Non-nil means Font Lock should not fontify comments or strings.
+  "Non-nil means Font Lock should not fontify comments or strings.
 This is normally set via `font-lock-defaults'.")
 
 (defvar font-lock-keywords-case-fold-search nil
-  "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.
+  "Non-nil means the patterns in `font-lock-keywords' are case-insensitive.
 This is set via the function `font-lock-set-defaults', based on
 the CASE-FOLD argument of `font-lock-defaults'.")
 (make-variable-buffer-local 'font-lock-keywords-case-fold-search)
@@ -552,7 +556,7 @@ If this is nil, the major mode's syntax table is used.
 This is normally set via `font-lock-defaults'.")
 
 (defvar font-lock-beginning-of-syntax-function nil
-  "*Non-nil means use this function to move back outside all constructs.
+  "Non-nil means use this function to move back outside all constructs.
 When called with no args it should move point backward to a place which
 is not in a string or comment and not within any bracket-pairs (or else,
 a place such that any bracket-pairs outside it can be ignored for Emacs
@@ -567,7 +571,7 @@ This is normally set via `font-lock-defaults'.")
                         'syntax-begin-function "23.3" 'set)
 
 (defvar font-lock-mark-block-function nil
-  "*Non-nil means use this function to mark a block of text.
+  "Non-nil means use this function to mark a block of text.
 When called with no args it should leave point at the beginning of any
 enclosing textual block and mark at the end.
 This is normally set via `font-lock-defaults'.")
@@ -609,9 +613,6 @@ Major/minor modes can set this variable if they know which option applies.")
 ;; Font Lock mode.
 
 (eval-when-compile
-  ;;
-  ;; We don't do this at the top-level as we only use non-autoloaded macros.
-  (require 'cl)
   ;;
   ;; Borrowed from lazy-lock.el.
   ;; We use this to preserve or protect things when modifying text properties.
@@ -625,13 +626,24 @@ Major/minor modes can set this variable if they know which option applies.")
   ;; Shut up the byte compiler.
   (defvar font-lock-face-attributes))  ; Obsolete but respected if set.
 
-(defun font-lock-mode-internal (arg)
-  ;; Turn on Font Lock mode.
-  (when arg
-    (add-hook 'after-change-functions 'font-lock-after-change-function t t)
-    (font-lock-set-defaults)
-    (font-lock-turn-on-thing-lock)
-    ;; Fontify the buffer if we have to.
+(defun font-lock-specified-p (mode)
+  "Return non-nil if the current buffer is ready for fontification.
+The MODE argument, if non-nil, means Font Lock mode is about to
+be enabled."
+  (or font-lock-defaults
+      (and (boundp 'font-lock-keywords)
+          font-lock-keywords)
+      (and mode
+          (boundp 'font-lock-set-defaults)
+          font-lock-set-defaults
+          font-lock-major-mode
+          (not (eq font-lock-major-mode major-mode)))))
+
+(defun font-lock-initial-fontify ()
+  ;; The first fontification after turning the mode on.  This must
+  ;;  only be called after the mode hooks have been run.
+  (when (and font-lock-mode
+            (font-lock-specified-p t))
     (let ((max-size (font-lock-value-in-major-mode font-lock-maximum-size)))
       (cond (font-lock-fontified
             nil)
@@ -639,7 +651,14 @@ Major/minor modes can set this variable if they know which option applies.")
             (font-lock-fontify-buffer))
            (font-lock-verbose
             (message "Fontifying %s...buffer size greater than font-lock-maximum-size"
-                     (buffer-name))))))
+                     (buffer-name)))))))
+
+(defun font-lock-mode-internal (arg)
+  ;; Turn on Font Lock mode.
+  (when arg
+    (add-hook 'after-change-functions 'font-lock-after-change-function t t)
+    (font-lock-set-defaults)
+    (font-lock-turn-on-thing-lock))
   ;; Turn off Font Lock mode.
   (unless font-lock-mode
     (remove-hook 'after-change-functions 'font-lock-after-change-function t)
@@ -895,10 +914,10 @@ The value of this variable is used when Font Lock mode is turned on."
 (declare-function lazy-lock-mode "lazy-lock")
 
 (defun font-lock-turn-on-thing-lock ()
-  (case (font-lock-value-in-major-mode font-lock-support-mode)
-    (fast-lock-mode (fast-lock-mode t))
-    (lazy-lock-mode (lazy-lock-mode t))
-    (jit-lock-mode
+  (pcase (font-lock-value-in-major-mode font-lock-support-mode)
+    (`fast-lock-mode (fast-lock-mode t))
+    (`lazy-lock-mode (lazy-lock-mode t))
+    (`jit-lock-mode
      ;; Prepare for jit-lock
      (remove-hook 'after-change-functions
                   'font-lock-after-change-function t)
@@ -977,7 +996,7 @@ The value of this variable is used when Font Lock mode is turned on."
 ;; rules one way and C code another.  Neat!
 ;;
 ;; A further reason to use the fontification indirection feature is when the
-;; default syntactual fontification, or the default fontification in general,
+;; default syntactic fontification, or the default fontification in general,
 ;; is not flexible enough for a particular major mode.  For example, perhaps
 ;; comments are just too hairy for `font-lock-fontify-syntactically-region' to
 ;; cope with.  You need to write your own version of that function, e.g.,
@@ -1018,14 +1037,20 @@ The region it returns may start or end in the middle of a line.")
   (funcall font-lock-unfontify-buffer-function))
 
 (defun font-lock-fontify-region (beg end &optional loudly)
+  "Fontify the text between BEG and END.
+If LOUDLY is non-nil, print status messages while fontifying.
+This works by calling `font-lock-fontify-region-function'."
   (font-lock-set-defaults)
   (funcall font-lock-fontify-region-function beg end loudly))
 
 (defun font-lock-unfontify-region (beg end)
+  "Unfontify the text between BEG and END.
+This works by calling `font-lock-unfontify-region-function'."
   (save-buffer-state
     (funcall font-lock-unfontify-region-function beg end)))
 
 (defun font-lock-default-fontify-buffer ()
+  "Fontify the whole buffer using `font-lock-fontify-region-function'."
   (let ((verbose (if (numberp font-lock-verbose)
                     (> (buffer-size) font-lock-verbose)
                   font-lock-verbose)))
@@ -1045,6 +1070,7 @@ The region it returns may start or end in the middle of a line.")
          (quit (font-lock-unfontify-buffer)))))))
 
 (defun font-lock-default-unfontify-buffer ()
+  "Unfontify the whole buffer using `font-lock-unfontify-region-function'."
   ;; Make sure we unfontify etc. in the whole buffer.
   (save-restriction
     (widen)
@@ -1114,6 +1140,9 @@ Put first the functions more likely to cause a change and cheaper to compute.")
     changed))
 
 (defun font-lock-default-fontify-region (beg end loudly)
+  "Fontify the text between BEG and END.
+If LOUDLY is non-nil, print status messages while fontifying.
+This function is the default `font-lock-fontify-region-function'."
   (save-buffer-state
     ;; Use the fontification syntax table, if any.
     (with-syntax-table (or font-lock-syntax-table (syntax-table))
@@ -1162,6 +1191,8 @@ This is used by `font-lock-default-unfontify-region' to decide
 what properties to clear before refontifying a region.")
 
 (defun font-lock-default-unfontify-region (beg end)
+  "Unfontify the text between BEG and END.
+This function is the default `font-lock-unfontify-region-function'."
   (remove-list-of-text-properties
    beg end (append
            font-lock-extra-managed-props
@@ -1620,7 +1651,7 @@ LOUDLY, if non-nil, allows progress-meter bar."
     ;; Fontify each item in `font-lock-keywords' from `start' to `end'.
     (while keywords
       (if loudly (message "Fontifying %s... (regexps..%s)" bufname
-                         (make-string (incf count) ?.)))
+                         (make-string (cl-incf count) ?.)))
       ;;
       ;; Find an occurrence of `matcher' from `start' to `end'.
       (setq keyword (car keywords) matcher (car keyword))
@@ -1726,7 +1757,7 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for
         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)
@@ -1843,22 +1874,22 @@ Sets various variables using `font-lock-defaults' and
 ;; `custom-declare-face'.
 (defface font-lock-comment-face
   '((((class grayscale) (background light))
-     (:foreground "DimGray" :weight bold :slant italic))
+     :foreground "DimGray" :weight bold :slant italic)
     (((class grayscale) (background dark))
-     (:foreground "LightGray" :weight bold :slant italic))
+     :foreground "LightGray" :weight bold :slant italic)
     (((class color) (min-colors 88) (background light))
-     (:foreground "Firebrick"))
+     :foreground "Firebrick")
     (((class color) (min-colors 88) (background dark))
-     (:foreground "chocolate1"))
+     :foreground "chocolate1")
     (((class color) (min-colors 16) (background light))
-     (:foreground "red"))
+     :foreground "red")
     (((class color) (min-colors 16) (background dark))
-     (:foreground "red1"))
+     :foreground "red1")
     (((class color) (min-colors 8) (background light))
-     (:foreground "red"))
+     :foreground "red")
     (((class color) (min-colors 8) (background dark))
-     (:foreground "yellow"))
-    (t (:weight bold :slant italic)))
+     :foreground "yellow")
+    (t :weight bold :slant italic))
   "Font Lock mode face used to highlight comments."
   :group 'font-lock-faces)
 
@@ -1868,14 +1899,14 @@ Sets various variables using `font-lock-defaults' and
   :group 'font-lock-faces)
 
 (defface font-lock-string-face
-  '((((class grayscale) (background light)) (:foreground "DimGray" :slant italic))
-    (((class grayscale) (background dark)) (:foreground "LightGray" :slant italic))
-    (((class color) (min-colors 88) (background light)) (:foreground "VioletRed4"))
-    (((class color) (min-colors 88) (background dark)) (:foreground "LightSalmon"))
-    (((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
-    (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
-    (((class color) (min-colors 8)) (:foreground "green"))
-    (t (:slant italic)))
+  '((((class grayscale) (background light)) :foreground "DimGray" :slant italic)
+    (((class grayscale) (background dark))  :foreground "LightGray" :slant italic)
+    (((class color) (min-colors 88) (background light)) :foreground "VioletRed4")
+    (((class color) (min-colors 88) (background dark))  :foreground "LightSalmon")
+    (((class color) (min-colors 16) (background light)) :foreground "RosyBrown")
+    (((class color) (min-colors 16) (background dark))  :foreground "LightSalmon")
+    (((class color) (min-colors 8)) :foreground "green")
+    (t :slant italic))
   "Font Lock mode face used to highlight strings."
   :group 'font-lock-faces)
 
@@ -1885,86 +1916,81 @@ Sets various variables using `font-lock-defaults' and
   :group 'font-lock-faces)
 
 (defface font-lock-keyword-face
-  '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
-    (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
-    (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
-    (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
-    (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
-    (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
-    (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
-    (t (:weight bold)))
+  '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
+    (((class grayscale) (background dark))  :foreground "DimGray" :weight bold)
+    (((class color) (min-colors 88) (background light)) :foreground "Purple")
+    (((class color) (min-colors 88) (background dark))  :foreground "Cyan1")
+    (((class color) (min-colors 16) (background light)) :foreground "Purple")
+    (((class color) (min-colors 16) (background dark))  :foreground "Cyan")
+    (((class color) (min-colors 8)) :foreground "cyan" :weight bold)
+    (t :weight bold))
   "Font Lock mode face used to highlight keywords."
   :group 'font-lock-faces)
 
 (defface font-lock-builtin-face
-  '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
-    (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
-    (((class color) (min-colors 88) (background light)) (:foreground "dark slate blue"))
-    (((class color) (min-colors 88) (background dark)) (:foreground "LightSteelBlue"))
-    (((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
-    (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
-    (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
-    (t (:weight bold)))
+  '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
+    (((class grayscale) (background dark))  :foreground "DimGray" :weight bold)
+    (((class color) (min-colors 88) (background light)) :foreground "dark slate blue")
+    (((class color) (min-colors 88) (background dark))  :foreground "LightSteelBlue")
+    (((class color) (min-colors 16) (background light)) :foreground "Orchid")
+    (((class color) (min-colors 16) (background dark)) :foreground "LightSteelBlue")
+    (((class color) (min-colors 8)) :foreground "blue" :weight bold)
+    (t :weight bold))
   "Font Lock mode face used to highlight builtins."
   :group 'font-lock-faces)
 
 (defface font-lock-function-name-face
-  '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
-    (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
-    (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
-    (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
-    (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
-    (t (:inverse-video t :weight bold)))
+  '((((class color) (min-colors 88) (background light)) :foreground "Blue1")
+    (((class color) (min-colors 88) (background dark))  :foreground "LightSkyBlue")
+    (((class color) (min-colors 16) (background light)) :foreground "Blue")
+    (((class color) (min-colors 16) (background dark))  :foreground "LightSkyBlue")
+    (((class color) (min-colors 8)) :foreground "blue" :weight bold)
+    (t :inverse-video t :weight bold))
   "Font Lock mode face used to highlight function names."
   :group 'font-lock-faces)
 
 (defface font-lock-variable-name-face
   '((((class grayscale) (background light))
-     (:foreground "Gray90" :weight bold :slant italic))
+     :foreground "Gray90" :weight bold :slant italic)
     (((class grayscale) (background dark))
-     (:foreground "DimGray" :weight bold :slant italic))
-    (((class color) (min-colors 88) (background light)) (:foreground "sienna"))
-    (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
-    (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
-    (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
-    (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
-    (t (:weight bold :slant italic)))
+     :foreground "DimGray" :weight bold :slant italic)
+    (((class color) (min-colors 88) (background light)) :foreground "sienna")
+    (((class color) (min-colors 88) (background dark))  :foreground "LightGoldenrod")
+    (((class color) (min-colors 16) (background light)) :foreground "DarkGoldenrod")
+    (((class color) (min-colors 16) (background dark))  :foreground "LightGoldenrod")
+    (((class color) (min-colors 8)) :foreground "yellow" :weight light)
+    (t :weight bold :slant italic))
   "Font Lock mode face used to highlight variable names."
   :group 'font-lock-faces)
 
 (defface font-lock-type-face
-  '((((class grayscale) (background light)) (:foreground "Gray90" :weight bold))
-    (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
-    (((class color) (min-colors 88) (background light)) (:foreground "ForestGreen"))
-    (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
-    (((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
-    (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
-    (((class color) (min-colors 8)) (:foreground "green"))
-    (t (:weight bold :underline t)))
+  '((((class grayscale) (background light)) :foreground "Gray90" :weight bold)
+    (((class grayscale) (background dark))  :foreground "DimGray" :weight bold)
+    (((class color) (min-colors 88) (background light)) :foreground "ForestGreen")
+    (((class color) (min-colors 88) (background dark))  :foreground "PaleGreen")
+    (((class color) (min-colors 16) (background light)) :foreground "ForestGreen")
+    (((class color) (min-colors 16) (background dark))  :foreground "PaleGreen")
+    (((class color) (min-colors 8)) :foreground "green")
+    (t :weight bold :underline t))
   "Font Lock mode face used to highlight type and classes."
   :group 'font-lock-faces)
 
 (defface font-lock-constant-face
   '((((class grayscale) (background light))
-     (:foreground "LightGray" :weight bold :underline t))
+     :foreground "LightGray" :weight bold :underline t)
     (((class grayscale) (background dark))
-     (:foreground "Gray50" :weight bold :underline t))
-    (((class color) (min-colors 88) (background light)) (:foreground "dark cyan"))
-    (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
-    (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
-    (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
-    (((class color) (min-colors 8)) (:foreground "magenta"))
-    (t (:weight bold :underline t)))
+     :foreground "Gray50" :weight bold :underline t)
+    (((class color) (min-colors 88) (background light)) :foreground "dark cyan")
+    (((class color) (min-colors 88) (background dark))  :foreground "Aquamarine")
+    (((class color) (min-colors 16) (background light)) :foreground "CadetBlue")
+    (((class color) (min-colors 16) (background dark))  :foreground "Aquamarine")
+    (((class color) (min-colors 8)) :foreground "magenta")
+    (t :weight bold :underline t))
   "Font Lock mode face used to highlight constants and labels."
   :group 'font-lock-faces)
 
 (defface font-lock-warning-face
-  '((((class color) (min-colors 88) (background light)) (:foreground "Red1" :weight bold))
-    (((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold))
-    (((class color) (min-colors 16) (background light)) (:foreground "Red1" :weight bold))
-    (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold))
-    (((class color) (min-colors 8)) (:foreground "red"))
-    (t (:inverse-video t :weight bold)))
+  '((t :inherit error))
   "Font Lock mode face used to highlight warnings."
   :group 'font-lock-faces)
 
@@ -2255,13 +2281,13 @@ in which C preprocessor directives are used. e.g. `asm-mode' and
      `(;; Control structures.  Emacs Lisp forms.
        (,(concat
          "(" (regexp-opt
-              '("cond" "if" "while" "while-no-input" "let" "let*"
-                "prog" "progn" "progv" "prog1" "prog2" "prog*"
-                "inline" "lambda" "save-restriction" "save-excursion"
-                "save-selected-window" "save-window-excursion"
-                "save-match-data" "save-current-buffer"
+              '("cond" "if" "while" "while-no-input" "let" "let*" "letrec"
+                "pcase" "pcase-let" "pcase-let*" "prog" "progn" "progv"
+                 "prog1" "prog2" "prog*" "inline" "lambda"
+                 "save-restriction" "save-excursion" "save-selected-window"
+                 "save-window-excursion" "save-match-data" "save-current-buffer"
                 "combine-after-change-calls" "unwind-protect"
-                "condition-case" "condition-case-no-debug"
+                "condition-case" "condition-case-unless-debug"
                 "track-mouse" "eval-after-load" "eval-and-compile"
                 "eval-when-compile" "eval-when" "eval-next-after-load"
                 "with-case-table" "with-category-table"
@@ -2272,7 +2298,7 @@ in which C preprocessor directives are used. e.g. `asm-mode' and
                 "with-selected-window" "with-selected-frame"
                 "with-silent-modifications" "with-syntax-table"
                 "with-temp-buffer" "with-temp-file" "with-temp-message"
-                "with-timeout" "with-timeout-handler") t)
+                "with-timeout" "with-timeout-handler" "with-wrapper-hook") t)
          "\\>")
          .  1)
        ;; Control structures.  Common Lisp forms.