/[auctex]/auctex/font-latex.el
ViewVC logotype

Contents of /auctex/font-latex.el

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5.197 - (show annotations) (download)
Thu Dec 27 19:29:30 2012 UTC (11 years, 4 months ago) by tsdh
Branch: MAIN
CVS Tags: HEAD
Changes since 5.196: +2 -2 lines
* amsmath.el ("amsmath"): Add support for the alignedat
and subarray environments.  Also, add support for the shoveright
and shoveleft macros.
* font-latex.el (font-latex-math-environments): Add "xxalignat"
and "flalign".

1 ;;; font-latex.el --- LaTeX fontification for Font Lock mode.
2
3 ;; Copyright (C) 1996-2009, 2012 Free Software Foundation, Inc.
4
5 ;; Authors: Peter S. Galbraith <psg@debian.org>
6 ;; Simon Marshall <Simon.Marshall@esrin.esa.it>
7 ;; Maintainer: auctex-devel@gnu.org
8 ;; Created: 06 July 1996
9 ;; Keywords: tex, wp, faces
10
11 ;;; This file is not part of GNU Emacs.
12
13 ;; This package is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 3, or (at your option)
16 ;; any later version.
17
18 ;; This package is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
27
28 ;;; Commentary:
29 ;;
30 ;; This package enhances font-lock fontification patterns for LaTeX.
31 ;; font-lock mode is a minor mode that causes your comments to be
32 ;; displayed in one face, strings in another, reserved words in
33 ;; another, and so on.
34 ;;
35 ;; ** Infinite loops !? **
36 ;; If you get an infinite loop, send a bug report!
37 ;; Then set the following in your ~/.emacs file to keep on working:
38 ;; (setq font-latex-do-multi-line nil)
39
40 ;;; Code:
41
42 (require 'font-lock)
43 (require 'tex)
44
45 (eval-when-compile
46 (require 'cl))
47
48 (defgroup font-latex nil
49 "Font-latex text highlighting package."
50 :prefix "font-latex-"
51 :group 'faces
52 :group 'tex
53 :group 'AUCTeX)
54
55 (defgroup font-latex-keywords nil
56 "Keywords for highlighting text in font-latex."
57 :prefix "font-latex-"
58 :group 'font-latex)
59
60 (defgroup font-latex-highlighting-faces nil
61 "Faces for highlighting text in font-latex."
62 :prefix "font-latex-"
63 :group 'font-latex)
64
65 (defvar font-latex-multiline-boundary 5000
66 "Size of region to search for the start or end of a multiline construct.")
67
68 (defvar font-latex-quote-regexp-beg nil
69 "Regexp used to find quotes.")
70 (make-variable-buffer-local 'font-latex-quote-regexp-beg)
71
72 (defvar font-latex-quote-list '(("``" "''") ("<<" ">>" french) ("«" "»" french))
73 "List of quote specifiers for quotation fontification.
74
75 Each element of the list is either a list consisting of two
76 strings to be used as opening and closing quotation marks
77 independently of the value of `font-latex-quotes' or a list with
78 three elements where the first and second element are strings for
79 opening and closing quotation marks and the third element being
80 either the symbol 'german or 'french describing the order of
81 quotes.
82
83 If `font-latex-quotes' specifies a different state, order of the
84 added quotes will be reversed for fontification. For example if
85 '(\"\\\"<\" \"\\\">\" french) is given but `font-latex-quotes'
86 specifies 'german, quotes will be used like \">foo\"< for
87 fontification.")
88
89 (defvar font-latex-quotes-control nil
90 "Internal variable for keeping track if `font-latex-quotes' changed.")
91 (make-variable-buffer-local 'font-latex-quotes-control)
92
93 (defvar font-latex-quotes-internal nil
94 "Internal variable for tracking outcome of automatic detection.
95 If automatic detection is not enabled, it is assigned the value
96 of `font-latex-quotes'.")
97 (make-variable-buffer-local 'font-latex-quotes-internal)
98
99 (defvar font-latex-quotes-fallback 'french
100 "Fallback value for `font-latex-quotes' if automatic detection fails.")
101
102 (defvar font-latex-quote-style-list-french
103 '("french" "frenchb" "frenchle" "frenchpro" "francais" "canadien"
104 "acadian" "italian")
105 "List of styles for which French-style quote matching should be activated.")
106
107 (defvar font-latex-quote-style-list-german
108 '("austrian" "german" "germanb" "naustrian" "ngerman")
109 "List of styles for which German-style quote matching should be activated.")
110
111 (defcustom font-latex-quotes 'auto
112 "Whether to fontify << French quotes >> or >>German quotes<<.
113 Also selects \"<quote\"> versus \">quote\"<.
114
115 If value `auto' is chosen, an attempt is being made in deriving
116 the type of quotation mark matching from document settings like
117 the language option supplied to the babel package.
118
119 If nil, quoted content will not be fontified."
120 :type '(choice (const auto) (const french) (const german) (const nil))
121 :group 'font-latex)
122 (put 'font-latex-quotes 'safe-local-variable
123 '(lambda (x) (memq x '(auto french german nil))))
124
125 (defun font-latex-add-quotes (quotes)
126 "Add QUOTES to `font-latex-quote-list'.
127 QUOTES has to be a list adhering to the format of an element of
128 `font-latex-quote-list'."
129 (setq font-latex-quotes-control nil)
130 (make-local-variable 'font-latex-quote-list)
131 (add-to-list 'font-latex-quote-list quotes))
132
133 (defun font-latex-quotes-set-internal ()
134 "Set `font-latex-quotes-internal' according to `font-latex-quotes'.
135 If `font-latex-quotes' is set to `auto', try to derive the
136 correct value from document properties."
137 (setq font-latex-quotes-internal
138 (if (eq font-latex-quotes 'auto)
139 (or (when (TeX-elt-of-list-member
140 font-latex-quote-style-list-french TeX-active-styles)
141 'french)
142 (when (TeX-elt-of-list-member
143 font-latex-quote-style-list-german TeX-active-styles)
144 'german)
145 font-latex-quotes-fallback)
146 font-latex-quotes)))
147 ;; Update the value of `font-latex-quotes-internal' when the list of
148 ;; styles changes.
149 (add-hook 'TeX-update-style-hook 'font-latex-quotes-set-internal)
150
151 ;; The definitions of the title faces were originally taken from
152 ;; info.el (Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 98, 99,
153 ;; 2000, 2001 Free Software Foundation, Inc.) and adapted to the needs
154 ;; of font-latex.el.
155
156 (defconst font-latex-sectioning-max 5
157 "Highest number for font-latex-sectioning-N-face")
158 (defface font-latex-sectioning-5-face
159 (if (featurep 'xemacs)
160 '((((type tty pc) (class color) (background light))
161 (:foreground "blue4" :bold t))
162 (((type tty pc) (class color) (background dark))
163 (:foreground "yellow" :bold t))
164 (((class color) (background light))
165 (:bold t :foreground "blue4" :family "helvetica"))
166 (((class color) (background dark))
167 (:bold t :foreground "yellow" :family "helvetica"))
168 (t (:bold t :family "helvetica")))
169 '((((type tty pc) (class color) (background light))
170 (:foreground "blue4" :weight bold))
171 (((type tty pc) (class color) (background dark))
172 (:foreground "yellow" :weight bold))
173 (((class color) (background light))
174 (:weight bold :inherit variable-pitch :foreground "blue4"))
175 (((class color) (background dark))
176 (:weight bold :inherit variable-pitch :foreground "yellow"))
177 (t (:weight bold :inherit variable-pitch))))
178 "Face for sectioning commands at level 5."
179 :group 'font-latex-highlighting-faces)
180
181 (defun font-latex-update-sectioning-faces (&optional max height-scale)
182 "Update sectioning commands faces."
183 (unless height-scale
184 (setq height-scale (if (numberp font-latex-fontify-sectioning)
185 font-latex-fontify-sectioning
186 1.1)))
187 (unless max
188 (setq max font-latex-sectioning-max))
189 (dotimes (num max)
190 (let* (;; reverse for XEmacs:
191 (num (- max (1+ num)))
192 (face-name (intern (format "font-latex-sectioning-%s-face" num))))
193 (unless (get face-name 'saved-face) ; Do not touch customized faces.
194 (if (featurep 'xemacs)
195 (let ((size
196 ;; Multiply with .9 because `face-height' returns a value
197 ;; slightly larger than the actual font size.
198 ;; `make-face-size' takes numeric points according to Aidan
199 ;; Kehoe in <16989.15536.613916.678965@parhasard.net> (not
200 ;; documented).
201 (round (* 0.9
202 (face-height 'default)
203 (expt height-scale (- max 1 num))))))
204 ;; (message "%s - %s" face-name size)
205 (make-face-size face-name size))
206 (set-face-attribute face-name nil :height height-scale))))))
207
208 (defcustom font-latex-fontify-sectioning 1.1
209 "Whether to fontify sectioning macros with varying height or a color face.
210
211 If it is a number, use varying height faces. The number is used
212 for scaling starting from `font-latex-sectioning-5-face'. Typically
213 values from 1.05 to 1.3 give best results, depending on your font
214 setup. If it is the symbol `color', use `font-lock-type-face'.
215
216 Caveats: Customizing the scaling factor applies to all sectioning
217 faces unless those face have been saved by customize. Setting
218 this variable directly does not take effect unless you call
219 `font-latex-update-sectioning-faces' or restart Emacs.
220
221 Switching from `color' to a number or vice versa does not take
222 effect unless you call \\[font-lock-fontify-buffer] or restart
223 Emacs."
224 ;; Possibly add some words about XEmacs here. :-(
225 :type '(choice (number :tag "Scale factor")
226 (const color))
227 :initialize 'custom-initialize-default
228 :set (lambda (symbol value)
229 (set-default symbol value)
230 (unless (eq value 'color)
231 (font-latex-update-sectioning-faces font-latex-sectioning-max value)))
232 :group 'font-latex)
233
234 (defun font-latex-make-sectioning-faces (max &optional height-scale)
235 "Build the faces used to fontify sectioning commands."
236 (unless max (setq max font-latex-sectioning-max))
237 (unless height-scale
238 (setq height-scale (if (numberp font-latex-fontify-sectioning)
239 font-latex-fontify-sectioning
240 1.1)))
241 (dotimes (num max)
242 (let* (;; reverse for XEmacs:
243 (num (- max (1+ num)))
244 (face-name (intern (format "font-latex-sectioning-%s-face" num)))
245 (f-inherit (intern (format "font-latex-sectioning-%s-face" (1+ num))))
246 (size (when (featurep 'xemacs)
247 (round (* 0.9 (face-height 'default)
248 (expt height-scale (- max 1 num)))))))
249 (eval
250 `(defface ,face-name
251 (if (featurep 'xemacs)
252 '((t (:size ,(format "%spt" size))))
253 '((t (:height ,height-scale :inherit ,f-inherit))))
254 (format "Face for sectioning commands at level %s.
255
256 Probably you don't want to customize this face directly. Better
257 change the base face `font-latex-sectioning-5-face' or customize the
258 variable `font-latex-fontify-sectioning'." num)
259 :group 'font-latex-highlighting-faces))
260 (when (and (featurep 'xemacs)
261 ;; Do not touch customized faces.
262 (not (get face-name 'saved-face)))
263 (set-face-parent face-name f-inherit)
264 ;; Explicitely set the size again to code around the bug that
265 ;; `set-face-parent' overwrites the original face size.
266 (make-face-size face-name size)))))
267
268 (font-latex-make-sectioning-faces font-latex-sectioning-max)
269
270
271 ;;; Keywords
272
273 (defvar font-latex-keywords-1 nil
274 "Subdued level highlighting for LaTeX modes.")
275
276 (defvar font-latex-keywords-2 nil
277 "High level highlighting for LaTeX modes.")
278
279 (defvar font-latex-built-in-keyword-classes
280 '(("warning"
281 ("nopagebreak" "pagebreak" "newpage" "clearpage" "cleardoublepage"
282 "enlargethispage" "nolinebreak" "linebreak" "newline" "-" "\\" "\\*"
283 "appendix" "displaybreak" "allowdisplaybreaks" "include")
284 'font-latex-warning-face 1 noarg)
285 ("variable"
286 (("setlength" "|{\\{") ("settowidth" "|{\\{") ("settoheight" "{{")
287 ("settodepth" "{{") ("setcounter" "{|{\\")
288 ("addtolength" "|{\\{") ("addtocounter" "{|{\\")
289 ("stepcounter" "{") ("refstepcounter" "{")
290 ("arabic" "{") ("roman" "{") ("Roman" "{") ("alph" "{") ("Alph" "{")
291 ("fnsymbol" "{"))
292 'font-lock-variable-name-face 2 command)
293 ("biblatexnoarg"
294 ("newrefsegment" "mancite" "pno" "ppno" "nopp" "psq" "psqq")
295 'font-lock-variable-name-face 2 noarg)
296 ("biblatex"
297 (("newrefsection" "[") ("ExecuteBibliographyOptions" "[{")
298 ("printbibliography" "[") ("printshorthands" "[") ("printbibheading" "[")
299 ("addbibresource" "[{") ("addglobalbib" "[{") ("addsectionbib" "[{")
300 ("bibbysection" "[") ("bibbysegment" "[") ("bibbycategory" "[")
301 ("DeclareBibliographyCategory" "{") ("addtocategory" "{{") ("defbibenvironment" "{{{{")
302 ("defbibheading" "{[{") ("defbibnote" "{{") ("defbibfilter" "{{") ("defbibcheck" "{{")
303 ("defbibentryset" "{{") ("Cite" "[[{") ("parencite" "*[[{") ("Parencite" "[[{")
304 ("footcite" "[[{") ("footcitetext" "[[{") ("textcite" "[[{") ("Textcite" "[[{")
305 ("smartcite" "[[{") ("Smartcite" "[[{") ("supercite" "{") ("autocite" "*[{{")
306 ("Autocite" "*[{{") ("citeauthor" "[{{") ("Citeauthor" "[{{") ("citetitle" "*[{{")
307 ("citeyear" "*[[{") ("citedate" "*[[{") ("citeurl" "[[{") ("parentext" "{")
308 ("brackettext" "{") ("fullcite" "[[{") ("fullfootcite" "[[{") ("volcite" "[{[[")
309 ("Volcite" "[{[[") ("pvolcite" "[{[[") ("Pvolcite" "[{[[") ("fvolcite" "[{[[")
310 ("ftvolcite" "[{[[") ("svolcite" "[{[[") ("Svolcite" "[{[[") ("tvolcite" "[{[[")
311 ("Tvolcite" "[{[[") ("avolcite" "[{[[") ("Avolcite" "[{[[") ("notecite" "[[{")
312 ("Notecite" "[[{") ("pnotecite" "[[{") ("Pnotecite" "[[{") ("fnotecite" "[[{")
313 ("citename" "[[{[{") ("citelist" "[[{[{") ("citefield" "[[{[{") ("citereset" "*")
314 ("RN" "{") ("Rn" "{") ("DefineBibliographyStrings" "{{") ("DefineBibliographyExtras" "{{")
315 ("UndefineBibliographyExtras" "{{") ("DefineHyphenationExceptions" "{{")
316 ("NewBibliographyString" "{") ("autocites" "(([[{") ("Autocites" "(([[{")
317 ("cites" "(([[{") ("Cites" "(([[{") ("parencites" "(([[{") ("Parencites" "(([[{")
318 ("footcites" "(([[{") ("footcitetexts" "(([[{") ("smartcites" "(([[{")
319 ("Smartcites" "(([[{") ("textcites" "(([[{") ("Textcites" "(([[{") ("supercites" "(([[{"))
320 'font-lock-constant-face 2 command)
321 ("reference"
322 (("nocite" "*{") ("cite" "*[[{") ("label" "{") ("pageref" "{")
323 ("vref" "{") ("eqref" "{") ("ref" "{") ("include" "{")
324 ("input" "{") ("bibliography" "{") ("index" "{") ("glossary" "{")
325 ("footnote" "[{") ("footnotemark" "[") ("footnotetext" "[{"))
326 'font-lock-constant-face 2 command)
327 ("function"
328 (("begin" "{") ("end" "{") ("pagenumbering" "{")
329 ("thispagestyle" "{") ("pagestyle" "{") ("nofiles" "")
330 ("includeonly" "{") ("bibliographystyle" "{") ("documentstyle" "[{")
331 ("documentclass" "[{[") ("newenvironment" "*{[[{{")
332 ("newcommand" "*|{\\[[{") ("newlength" "|{\\")
333 ("newtheorem" "{[{[")
334 ("providecommand" "*|{\\[[{")
335 ("newcounter" "{[") ("renewenvironment" "*{[[{{")
336 ("renewcommand" "*|{\\[[{") ("renewtheorem" "{[{[")
337 ("usepackage" "[{[") ("fbox" "{") ("mbox" "{") ("rule" "[{{")
338 ("vspace" "*{") ("hspace" "*{") ("thinspace" "") ("negthinspace" "")
339 ;; XXX: Should macros without arguments rather be listed in a
340 ;; separate category with 'noarg instead of 'command handling?
341 ("enspace" "") ("enskip" "") ("quad" "") ("qquad" "") ("nonumber" "")
342 ("centering" "") ("TeX" "") ("LaTeX" ""))
343 'font-lock-function-name-face 2 command)
344 ("sectioning-0"
345 (("part" "*[{"))
346 (if (eq font-latex-fontify-sectioning 'color)
347 'font-lock-type-face
348 'font-latex-sectioning-0-face)
349 2 command)
350 ("sectioning-1"
351 (("chapter" "*[{"))
352 (if (eq font-latex-fontify-sectioning 'color)
353 'font-lock-type-face
354 'font-latex-sectioning-1-face)
355 2 command)
356 ("sectioning-2"
357 (("section" "*[{"))
358 (if (eq font-latex-fontify-sectioning 'color)
359 'font-lock-type-face
360 'font-latex-sectioning-2-face)
361 2 command)
362 ("sectioning-3"
363 (("subsection" "*[{"))
364 (if (eq font-latex-fontify-sectioning 'color)
365 'font-lock-type-face
366 'font-latex-sectioning-3-face)
367 2 command)
368 ("sectioning-4"
369 (("subsubsection" "*[{"))
370 (if (eq font-latex-fontify-sectioning 'color)
371 'font-lock-type-face
372 'font-latex-sectioning-4-face)
373 2 command)
374 ("sectioning-5"
375 (("paragraph" "*[{") ("subparagraph" "*[{")
376 ("subsubparagraph" "*[{"))
377 (if (eq font-latex-fontify-sectioning 'color)
378 'font-lock-type-face
379 'font-latex-sectioning-5-face)
380 2 command)
381 ("slide-title" () 'font-latex-slide-title-face 2 command)
382 ("textual"
383 (("item" "[") ("title" "{") ("author" "{") ("date" "{")
384 ("thanks" "{") ("address" "{") ("caption" "[{")
385 ("textsuperscript" "{"))
386 'font-lock-type-face 2 command)
387 ("bold-command"
388 (("textbf" "{") ("textsc" "{") ("textup" "{") ("boldsymbol" "{")
389 ("pmb" "{"))
390 'font-latex-bold-face 1 command)
391 ("italic-command"
392 (("emph" "{") ("textit" "{") ("textsl" "{"))
393 'font-latex-italic-face 1 command)
394 ("math-command"
395 (("ensuremath" "|{\\"))
396 'font-latex-math-face 1 command)
397 ("type-command"
398 (("texttt" "{") ("textsf" "{") ("textrm" "{") ("textmd" "{"))
399 'font-lock-type-face 1 command)
400 ("bold-declaration"
401 ("bf" "bfseries" "sc" "scshape" "upshape")
402 'font-latex-bold-face 1 declaration)
403 ("italic-declaration"
404 ("em" "it" "itshape" "sl" "slshape")
405 'font-latex-italic-face 1 declaration)
406 ("type-declaration"
407 ("tt" "ttfamily" "sf" "sffamily" "rm" "rmfamily" "mdseries"
408 "tiny" "scriptsize" "footnotesize" "small" "normalsize"
409 "large" "Large" "LARGE" "huge" "Huge")
410 'font-lock-type-face 1 declaration))
411 "Built-in keywords and specifications for font locking.
412
413 The first element of each item is the name of the keyword class.
414
415 The second element is a list of keywords (macros without an
416 escape character) to highlight or, if the fifth element is the
417 symbol 'command, a list of lists where the first element of each
418 item is a keyword and the second a string specifying the macro
419 syntax. It can contain \"*\" if the macro has a starred variant,
420 \"[\" for an optional argument, \"{\" for a mandatory argument,
421 and \"\\\" for a macro. A \"|\" means the following two tokens
422 should be regarded as alternatives.
423
424 The third element is the symbol of a face to be used or a Lisp
425 form returning a face symbol.
426
427 The fourth element is the fontification level.
428
429 The fifth element is the type of construct to be matched. It can
430 be one of 'noarg which will match simple macros without
431 arguments (like \"\\foo\"), 'declaration which will match macros
432 inside a TeX group (like \"{\\bfseries foo}\"), or 'command which
433 will match macros of the form \"\\foo[bar]{baz}\".")
434
435 (defcustom font-latex-deactivated-keyword-classes nil
436 "List of strings for built-in keyword classes to be deactivated.
437
438 Valid entries are \"warning\", \"variable\", \"reference\",
439 \"function\" , \"sectioning-0\", \"sectioning-1\", \"sectioning-2\",
440 \"sectioning-3\", \"sectioning-4\", \"sectioning-5\", \"textual\",
441 \"bold-command\", \"italic-command\", \"math-command\", \"type-command\",
442 \"bold-declaration\", \"italic-declaration\", \"type-declaration\".
443
444 You have to restart Emacs for a change of this variable to take effect."
445 :group 'font-latex-keywords
446 :type `(set ,@(mapcar
447 (lambda (spec)
448 `(const :tag ,(concat
449 ;; Name of the keyword class
450 (let ((name (split-string (car spec) "-")))
451 (setcar name (capitalize (car name)))
452 (mapconcat 'identity name " "))
453 " keywords in `"
454 ;; Name of the face
455 (symbol-name (eval (nth 2 spec))) "'.\n"
456 ;; List of keywords
457 (with-temp-buffer
458 (insert " Keywords: "
459 (mapconcat (lambda (x)
460 (if (listp x)
461 (car x)
462 x))
463 (nth 1 spec) ", "))
464 (fill-paragraph nil)
465 (buffer-substring-no-properties
466 (point-min) (point-max))))
467 ,(car spec)))
468 font-latex-built-in-keyword-classes)))
469
470 (defun font-latex-make-match-defun (prefix name face type)
471 "Return a function definition for keyword matching.
472 The variable holding the keywords to match are determined by the
473 strings PREFIX and NAME. The type of matcher is determined by
474 the symbol TYPE.
475
476 This is a helper function for `font-latex-make-built-in-keywords'
477 and `font-latex-make-user-keywords' and not intended for general
478 use."
479 ;; Note: The functions are byte-compiled at the end of font-latex.el.
480 ;; FIXME: Is the cond-clause possible inside of the defun?
481
482 ;; In an earlier version of font-latex the type could be a list like
483 ;; (command 1). This indicated a macro with one argument. Provide
484 ;; a match function in this case but don't actually support it.
485 (cond ((or (eq type 'command) (listp type))
486 (eval `(defun ,(intern (concat prefix name)) (limit)
487 ,(concat "Fontify `" prefix name "' up to LIMIT.
488
489 Generated by `font-latex-make-match-defun'.")
490 (when ,(intern (concat prefix name))
491 (font-latex-match-command-with-arguments
492 ,(intern (concat prefix name))
493 (append
494 (when (boundp ',(intern (concat prefix name
495 "-keywords-local")))
496 ,(intern (concat prefix name "-keywords-local")))
497 ,(intern (concat prefix name "-keywords")))
498 ;; `face' can be a face symbol, a form returning
499 ;; a face symbol, or a list of face attributes.
500 (if (and (listp ,face) (functionp (car ,face)))
501 (eval ,face)
502 ,face)
503 limit)))))
504 ((eq type 'declaration)
505 (eval `(defun ,(intern (concat prefix name)) (limit)
506 ,(concat "Fontify `" prefix name "' up to LIMIT.
507
508 Generated by `font-latex-make-match-defun'.")
509 (when ,(intern (concat prefix name))
510 (font-latex-match-command-in-braces
511 ,(intern (concat prefix name)) limit)))))
512 ((eq type 'noarg)
513 (eval `(defun ,(intern (concat prefix name)) (limit)
514 ,(concat "Fontify `" prefix name "' up to LIMIT.
515
516 Generated by `font-latex-make-match-defun'.")
517 (when ,(intern (concat prefix name))
518 (re-search-forward
519 ,(intern (concat prefix name)) limit t)))))))
520
521 (defun font-latex-keyword-matcher (prefix name face type)
522 "Return a matcher and highlighter as required by `font-lock-keywords'.
523 PREFIX and NAME are strings which are concatenated to form the
524 respective match function. FACE is a face name or a list of text
525 properties that will be applied to the respective part of the
526 match returned by the match function. TYPE is the type of
527 construct to be highlighted. Currently the symbols 'command,
528 'sectioning, 'declaration and 'noarg are valid.
529
530 This is a helper function for `font-latex-make-built-in-keywords'
531 and `font-latex-make-user-keywords' and not intended for general
532 use."
533 ;; In an earlier version of font-latex the type could be a list like
534 ;; (command 1). This indicated a macro with one argument. Provide
535 ;; a matcher in this case but don't actually support it.
536 (cond ((or (eq type 'command) (listp type))
537 `(,(intern (concat prefix name))
538 (0 (font-latex-matched-face 0) append t)
539 (1 (font-latex-matched-face 1) append t)
540 (2 (font-latex-matched-face 2) append t)
541 (3 (font-latex-matched-face 3) append t)
542 (4 (font-latex-matched-face 4) append t)
543 (5 (font-latex-matched-face 5) append t)
544 (6 (font-latex-matched-face 6) append t)
545 (7 (font-latex-matched-face 7) append t)))
546 ((eq type 'noarg)
547 `(,(intern (concat prefix name))
548 ;; Quote a list of face properties but do not to quote a face symbol.
549 (0 ,(if (and (listp face) (not (fboundp (car face))))
550 `',face
551 face))))
552 ((eq type 'declaration)
553 `(,(intern (concat prefix name))
554 (0 'font-latex-warning-face t t)
555 (1 'font-lock-keyword-face append t)
556 (2 ,face append t)))))
557
558 (defun font-latex-make-built-in-keywords ()
559 "Build defuns, defvars and defcustoms for built-in keyword fontification."
560 (dolist (item font-latex-built-in-keyword-classes)
561 (let ((prefix "font-latex-match-")
562 (name (nth 0 item))
563 (keywords (nth 1 item))
564 (face (nth 2 item))
565 (level (nth 3 item))
566 (type (nth 4 item)))
567
568 ;; defvar font-latex-match-*-keywords-local
569 (eval `(defvar ,(intern (concat prefix name "-keywords-local"))
570 ',keywords
571 ,(concat "Buffer-local keywords to add to `"
572 prefix name "-keywords'.
573
574 This must be a list where each element is a list consisting of a
575 keyword string \(not a regular expression\) omitting the leading
576 backslash and a format specifier as. The options for the format
577 specifier are described in the doc string of
578 `font-latex-user-keyword-classes'.
579
580 This is an internal variable which should not be set directly.
581 Use `font-latex-add-keywords' instead.
582
583 Generated by `font-latex-make-built-in-keywords'.")))
584 (eval `(make-variable-buffer-local
585 ',(intern (concat prefix name "-keywords-local"))))
586
587 ;; defun font-latex-match-*-make
588 ;; Note: The functions are byte-compiled at the end of font-latex.el.
589 (eval `(defun ,(intern (concat prefix name "-make")) ()
590 ,(concat "Make or remake the variable `" prefix name "'.
591
592 Generated by `font-latex-make-built-in-keywords'.")
593 (let ((keywords
594 (append
595 (unless (member ,name
596 font-latex-deactivated-keyword-classes)
597 ,(intern (concat prefix name "-keywords-local")))
598 ,(intern (concat prefix name "-keywords"))))
599 multi-char-macros single-char-macros)
600 (dolist (elt keywords)
601 (let ((keyword (if (listp elt) (car elt) elt)))
602 (if (string-match "^[A-Za-z]" keyword)
603 (add-to-list 'multi-char-macros keyword)
604 (add-to-list 'single-char-macros keyword))))
605 (when (or multi-char-macros single-char-macros)
606 (setq ,(intern (concat prefix name))
607 (concat
608 "\\\\\\("
609 (when multi-char-macros
610 (concat
611 "\\(?:" (regexp-opt multi-char-macros) "\\)\\>"))
612 (when single-char-macros
613 (concat
614 (when multi-char-macros "\\|")
615 "\\(?:" (regexp-opt single-char-macros) "\\)"))
616 "\\)"))))))
617
618 ;; defcustom font-latex-match-*-keywords
619 (eval `(defcustom ,(intern (concat prefix name "-keywords")) nil
620 ,(concat "List of keywords "
621 (when (eq type 'command) "and formats ")
622 "for " name " face.\n"
623 (if (eq type 'command)
624 "\
625 Each element has to be a list consisting of the name of a macro
626 omitting the leading backslash and a format specifier as
627 described in the doc string of `font-latex-user-keyword-classes'."
628 "\
629 Each element has to be the name of a macro as a string, omitting
630 the leading backslash.")
631 "\n\n\
632 Setting this variable directly does not take effect; restart
633 Emacs.
634
635 Generated by `font-latex-make-built-in-keywords'.")
636 :type '(repeat (string :tag "Keyword"))
637 :type '(repeat ,(if (eq type 'command)
638 '(list (string :tag "Keyword")
639 (string :tag "Format"))
640 '(string :tag "Keyword")))
641 :set (lambda (symbol value)
642 (set-default symbol value)
643 (funcall ',(intern (concat prefix name "-make"))))
644 :group 'font-latex-keywords))
645
646 ;; defvar font-latex-match-*
647 (eval `(defvar ,(intern (concat prefix name))
648 ,(intern (concat prefix name "-keywords"))))
649 (eval `(make-variable-buffer-local
650 ',(intern (concat prefix name))))
651
652 ;; defun font-latex-match-*
653 (font-latex-make-match-defun prefix name face type)
654
655 ;; Add matchers and highlighters to `font-latex-keywords-{1,2}'.
656 (let ((keywords-entry (font-latex-keyword-matcher
657 prefix name face type)))
658 (add-to-list (intern (concat "font-latex-keywords-"
659 (number-to-string level)))
660 keywords-entry t)
661 (when (= level 1)
662 (add-to-list (intern (concat "font-latex-keywords-2"))
663 keywords-entry t))))))
664 (font-latex-make-built-in-keywords)
665
666 (defcustom font-latex-user-keyword-classes nil
667 "List of user-defined keyword classes for font locking.
668
669 Every keyword class consists of four parts, a name, a list of
670 keywords, a face and a specifier for the type of macro to be
671 highlighted.
672
673 When adding new entries, you have to use unique values for the
674 class names, i.e. they must not clash with names of the built-in
675 keyword classes or other names given by you. Additionally the
676 names must not contain spaces.
677
678 The list of keywords defines which commands and declarations
679 should be covered by the keyword class. A keyword can either be
680 a simple command name omitting the leading backslash or a list
681 consisting of the command name and a string specifying the syntax
682 of the command. The latter is useful if you want to match LaTeX
683 macros with arguments (see below). You can specify the occurence
684 and order of optional (\"[\") and mandatory (\"{\") arguments for
685 each keyword. For example for \"documentclass\" you'd use \"[{\"
686 because the macro has one optional followed by one mandatory
687 argument. Optionally starred macros can be indicated with \"*\".
688 In case an argument is an unbraced macro, use \"\\\". You can
689 also specify two alternative arguments by prefixing them with
690 \"|\". As an example, the specifier for \\newcommand is
691 \"*|{\\=\\[[{\".
692
693 The face argument can either be an existing face or a font
694 specification. (The latter option is not available in XEmacs.)
695
696 There are three alternatives for the class type:
697
698 A value of `command' indicates commands with arguments
699 \(\"\\foo[bar]{baz}\"). The mandatory arguments in curly braces
700 will get the face you specified.
701
702 A value of `declaration' indicates declarations inside of TeX
703 groups (\"{\\foo bar}\"). The content inside the braces,
704 excluding the command, will get the face you specified. In case
705 the braces are missing, the face will be applied to the command
706 itself.
707
708 A value of `noarg' indicates commands without arguments
709 \(\"\\foo\"). The command itself will get the face you
710 specified.
711
712 Setting this variable directly does not take effect;
713 use \\[customize] or restart Emacs."
714 :group 'font-latex-keywords
715 :type `(repeat (list (string :tag "Name")
716 (choice (repeat :tag "Keywords" (string :tag "Keyword"))
717 (repeat
718 :tag "Keywords with specs"
719 (group (string :tag "Keyword")
720 (string :tag "Format specifier"))))
721 ,(if (featurep 'xemacs)
722 '(face :tag "Face name")
723 '(choice (custom-face-edit :tag "Face attributes")
724 (face :tag "Face name")))
725 (choice :tag "Type"
726 ;; Maps to
727 ;;`font-latex-match-command-with-arguments'
728 (const :tag "Command with arguments"
729 command)
730 ;; Maps to
731 ;;`font-latex-match-command-in-braces'
732 (const :tag "Declaration inside TeX group"
733 declaration)
734 ;; Maps to `re-search-forward'
735 (const :tag "Command without arguments"
736 noarg))))
737 :set (lambda (symbol value)
738 (dolist (item value)
739 (when (string-match " " (car item))
740 (error "No spaces allowed in name")))
741 (let (names names-uniq)
742 (dolist (item (append font-latex-built-in-keyword-classes value))
743 (setq names (append names (list (car item)))))
744 (setq names (TeX-sort-strings names))
745 (setq names-uniq (TeX-delete-duplicate-strings names))
746 (dotimes (i (safe-length names-uniq))
747 (unless (string= (nth i names) (nth i names-uniq))
748 (error "Name %S already exists" (nth i names)))))
749 (set-default symbol value)
750 (let ((prefix "font-latex-match-"))
751 (dolist (elt value)
752 (unless (boundp (intern (concat prefix (car elt))))
753 ;; defvar font-latex-match-*
754 (eval `(defvar ,(intern (concat prefix (car elt))) nil)))
755 (let ((keywords (nth 1 elt))
756 single-char-macro-flag)
757 (setq keywords (if (listp (car keywords))
758 (mapcar 'car keywords)
759 keywords))
760 (catch 'single-char
761 (dolist (keyword keywords)
762 (unless (string-match "^[A-Za-z]" keyword)
763 (setq single-char-macro-flag t)
764 (throw 'single-char nil))))
765 (set (intern (concat prefix (car elt)))
766 (when (> (safe-length keywords) 0)
767 (concat "\\\\" (let ((max-specpdl-size 1000))
768 (regexp-opt keywords t))
769 (unless single-char-macro-flag "\\>")))))))))
770
771 (defun font-latex-make-user-keywords ()
772 "Build defuns and defvars for user keyword fontification."
773 (let ((keyword-specs font-latex-user-keyword-classes))
774 (dolist (item keyword-specs)
775 (let ((prefix "font-latex-match-")
776 (name (nth 0 item))
777 (keywords (nth 1 item))
778 (face (nth 2 item))
779 (type (nth 3 item)))
780
781 ;; defvar font-latex-match-*-keywords
782 (eval `(defvar ,(intern (concat prefix name "-keywords")) ',keywords
783 ,(concat "Font-latex keywords for " name " face.
784
785 Generated by `font-latex-make-user-keywords'.")))
786
787 ;; defun font-latex-match-*
788 (eval `(font-latex-make-match-defun prefix name '',face type))
789
790 ;; Add the matcher to `font-latex-keywords-2'.
791 (add-to-list 'font-latex-keywords-2
792 (font-latex-keyword-matcher prefix name face type) t))))
793
794 ;; Add the "fixed" matchers and highlighters.
795 (dolist (item
796 '(("\\(^\\|[^\\]\\)\\(&+\\)" 2 'font-latex-warning-face)
797 ("\\$\\$\\([^$]+\\)\\$\\$" 1 'font-latex-math-face)
798 (font-latex-match-quotation
799 (0 'font-latex-string-face append)
800 (1 'font-latex-warning-face))
801 ;; Hack to remove the verbatim face from the \ in
802 ;; \end{verbatim} and similar. The same hack is used in
803 ;; tex-mode.el.
804 ("^[ \t]*\\(\\\\\\)end"
805 (1 (get-text-property (match-end 1) 'face) t))))
806 (add-to-list 'font-latex-keywords-1 item)
807 (add-to-list 'font-latex-keywords-2 item))
808 (dolist (item
809 '((font-latex-match-math-env
810 (0 'font-latex-warning-face t t)
811 (1 'font-latex-math-face append t))
812 (font-latex-match-math-envII
813 (0 'font-latex-math-face append t))
814 (font-latex-match-simple-command
815 (0 'font-latex-sedate-face append))
816 (font-latex-match-script
817 (1 (font-latex-script (match-beginning 0)) append))))
818 (add-to-list 'font-latex-keywords-2 item t)))
819 (font-latex-make-user-keywords)
820
821 (defun font-latex-add-keywords (keywords class)
822 "Add KEYWORDS to CLASS.
823 KEYWORDS is a list of keywords or keywords with syntax specs.
824 CLASS corresponds to a keyword class and can be one of the
825 symbols 'warning, 'variable, 'reference, 'biblatex, 'function,
826 'sectioning-0, 'sectioning-1, 'sectioning-2, 'sectioning-3,
827 'sectioning-4, 'sectioning-5, 'slide-title, 'textual,
828 'bold-command, 'italic-command, 'math-command, 'type-command,
829 'bold-declaration, 'italic-declaration or 'type-declaration.
830
831 The keywords will be added to the buffer-local list of keywords
832 of the respective keyword class and necessary updates of the font
833 locking machinery will be triggered."
834 (let* ((class (symbol-name class))
835 (list (intern (format "font-latex-match-%s-keywords-local" class))))
836 (dolist (elt keywords)
837 (add-to-list list elt))
838 (funcall (intern (format "font-latex-match-%s-make" class)))
839 (setq font-lock-set-defaults nil)
840 (font-lock-set-defaults)))
841
842 (defvar font-latex-keywords font-latex-keywords-1
843 "Default expressions to highlight in TeX mode.")
844
845
846 ;;; Subscript and superscript
847
848 (defcustom font-latex-fontify-script (not (featurep 'xemacs))
849 "If non-nil, fontify subscript and superscript strings.
850 This feature does not work in XEmacs."
851 :type 'boolean
852 :group 'font-latex)
853 (put 'font-latex-fontify-script 'safe-local-variable 'TeX-booleanp)
854
855 (defcustom font-latex-script-display '((raise -0.3) . (raise 0.3))
856 "Display specification for subscript and superscript content.
857 The car is used for subscript, the cdr is used for superscripts."
858 :group 'font-latex
859 :type '(cons (choice (sexp :tag "Subscript form")
860 (const :tag "No lowering" nil))
861 (choice (sexp :tag "Superscript form")
862 (const :tag "No raising" nil))))
863
864
865 ;;; Syntactic keywords
866
867 (defvar font-latex-syntactic-keywords nil
868 "Syntactic keywords used by `font-latex'.")
869 (make-variable-buffer-local 'font-latex-syntactic-keywords)
870
871 (defvar font-latex-syntactic-keywords-extra nil
872 "List of syntactic keywords to add to `font-latex-syntactic-keywords'.
873 The form should be the same as in `font-lock-syntactic-keywords'.")
874 (make-variable-buffer-local 'font-latex-syntactic-keywords-extra)
875
876 (defun font-latex-set-syntactic-keywords ()
877 "Set the variable `font-latex-syntactic-keywords'.
878 This function can be used to refresh the variable in case other
879 variables influencing its value, like `LaTeX-verbatim-environments',
880 have changed."
881 ;; Checks for non-emptiness of lists added in order to cater for
882 ;; installations where `(regexp-opt-group nil)' would enter a loop.
883 (let ((verb-envs (and (fboundp 'LaTeX-verbatim-environments)
884 (LaTeX-verbatim-environments)))
885 (verb-macros-with-delims
886 (and (fboundp 'LaTeX-verbatim-macros-with-delims)
887 (LaTeX-verbatim-macros-with-delims)))
888 (verb-macros-with-braces
889 (and (fboundp 'LaTeX-verbatim-macros-with-braces)
890 (LaTeX-verbatim-macros-with-braces))))
891 (setq verb-envs (and verb-envs (regexp-opt verb-envs))
892 verb-macros-with-delims (and verb-macros-with-delims
893 (regexp-opt verb-macros-with-delims))
894 verb-macros-with-braces (and verb-macros-with-braces
895 (regexp-opt verb-macros-with-braces))
896 font-latex-syntactic-keywords nil)
897 (unless (= (length verb-envs) 0)
898 (add-to-list 'font-latex-syntactic-keywords
899 `(,(concat "^[ \t]*\\\\begin *{\\(?:" verb-envs
900 "\\)}.*\\(\n\\)")
901 (1 "|" t)))
902 (add-to-list 'font-latex-syntactic-keywords
903 ;; Using the newline character for the syntax
904 ;; property often resulted in fontification
905 ;; problems when text was inserted at the end of
906 ;; the verbatim environment. That's why we now use
907 ;; the starting backslash of \end. There is a hack
908 ;; in `font-latex-make-user-keywords' to remove the
909 ;; spurious fontification of the backslash.
910 `(,(concat "^[ \t]*\\(\\\\\\)end *{\\(?:" verb-envs "\\)}")
911 (1 "|" t))))
912 (unless (= (length verb-macros-with-delims) 0)
913 (add-to-list 'font-latex-syntactic-keywords
914 `(,(concat "\\\\\\(?:" verb-macros-with-delims "\\)"
915 ;; An opening curly brace as delimiter
916 ;; is valid, but allowing it might screw
917 ;; up fontification of stuff like
918 ;; "\url{...} foo \textbf{<--!...}".
919 "\\([^a-z@*\n\f{]\\).*?"
920 ;; Give an escape char at the end of the
921 ;; verbatim construct punctuation syntax.
922 ;; Prevents wrong fontification of stuff
923 ;; like "\verb|foo\|".
924 "\\(" (regexp-quote TeX-esc) "*\\)\\(\\1\\)")
925 (1 "\"") (2 ".") (3 "\""))))
926 (unless (= (length verb-macros-with-braces) 0)
927 (add-to-list 'font-latex-syntactic-keywords
928 `(,(concat "\\\\\\(?:" verb-macros-with-braces "\\)"
929 "\\({\\).*?[^\\]\\(?:\\\\\\\\\\)*\\(}\\)")
930 (1 "|") (2 "|")))))
931 (when font-latex-syntactic-keywords-extra
932 (nconc font-latex-syntactic-keywords font-latex-syntactic-keywords-extra))
933 ;; Cater for docTeX mode.
934 (setq font-latex-doctex-syntactic-keywords
935 (append font-latex-syntactic-keywords
936 ;; For docTeX comment-in-doc.
937 `(("\\(\\^\\)\\^A" (1 (font-latex-doctex-^^A)))))))
938
939
940 ;;; Syntactic fontification
941
942 ;; Copy and adaptation of `tex-font-lock-syntactic-face-function' in
943 ;; `tex-mode.el' of CVS Emacs (March 2004)
944 (defun font-latex-syntactic-face-function (state)
945 (let ((char (nth 3 state)))
946 (cond
947 ((not char) 'font-lock-comment-face)
948 ((eq char ?$) 'font-latex-math-face)
949 (t
950 (when (char-valid-p char)
951 ;; This is a \verb?...? construct. Let's find the end and mark it.
952 (save-excursion
953 (skip-chars-forward (string ?^ char)) ;; Use `end' ?
954 (when (eq (char-syntax (preceding-char)) ?/)
955 (put-text-property (1- (point)) (point) 'syntax-table '(1)))
956 (unless (eobp)
957 (put-text-property (point) (1+ (point)) 'syntax-table '(7)))))
958 'font-latex-verbatim-face))))
959
960
961 ;;; Faces
962
963 (defface font-latex-bold-face
964 (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit bold))
965 ((assq :weight custom-face-attributes) '(:weight bold))
966 (t '(:bold t)))))
967 `((((class grayscale) (background light))
968 (:foreground "DimGray" ,@font))
969 (((class grayscale) (background dark))
970 (:foreground "LightGray" ,@font))
971 (((class color) (background light))
972 (:foreground "DarkOliveGreen" ,@font))
973 (((class color) (background dark))
974 (:foreground "OliveDrab" ,@font))
975 (t (,@font))))
976 "Face used to highlight text to be typeset in bold."
977 :group 'font-latex-highlighting-faces)
978
979 (defface font-latex-italic-face
980 (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit italic))
981 ((assq :slant custom-face-attributes) '(:slant italic))
982 (t '(:italic t)))))
983 `((((class grayscale) (background light))
984 (:foreground "DimGray" ,@font))
985 (((class grayscale) (background dark))
986 (:foreground "LightGray" ,@font))
987 (((class color) (background light))
988 (:foreground "DarkOliveGreen" ,@font))
989 (((class color) (background dark))
990 (:foreground "OliveDrab" ,@font))
991 (t (,@font))))
992 "Face used to highlight text to be typeset in italic."
993 :group 'font-latex-highlighting-faces)
994
995 (defface font-latex-math-face
996 (let ((font (cond ((assq :inherit custom-face-attributes)
997 '(:inherit underline))
998 (t '(:underline t)))))
999 `((((class grayscale) (background light))
1000 (:foreground "DimGray" ,@font))
1001 (((class grayscale) (background dark))
1002 (:foreground "LightGray" ,@font))
1003 (((class color) (background light))
1004 (:foreground "SaddleBrown"))
1005 (((class color) (background dark))
1006 (:foreground "burlywood"))
1007 (t (,@font))))
1008 "Face used to highlight math."
1009 :group 'font-latex-highlighting-faces)
1010
1011 (defface font-latex-sedate-face
1012 '((((class grayscale) (background light)) (:foreground "DimGray"))
1013 (((class grayscale) (background dark)) (:foreground "LightGray"))
1014 (((class color) (background light)) (:foreground "DimGray"))
1015 (((class color) (background dark)) (:foreground "LightGray"))
1016 ;;;(t (:underline t))
1017 )
1018 "Face used to highlight sedate stuff."
1019 :group 'font-latex-highlighting-faces)
1020
1021 (defface font-latex-string-face
1022 (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit italic))
1023 ((assq :slant custom-face-attributes) '(:slant italic))
1024 (t '(:italic t)))))
1025 `((((type tty) (class color))
1026 (:foreground "green"))
1027 (((class grayscale) (background light))
1028 (:foreground "DimGray" ,@font))
1029 (((class grayscale) (background dark))
1030 (:foreground "LightGray" ,@font))
1031 (((class color) (background light))
1032 (:foreground "RosyBrown"))
1033 (((class color) (background dark))
1034 (:foreground "LightSalmon"))
1035 (t (,@font))))
1036 "Face used to highlight strings."
1037 :group 'font-latex-highlighting-faces)
1038
1039 (defface font-latex-warning-face
1040 (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit bold))
1041 ((assq :weight custom-face-attributes) '(:weight bold))
1042 (t '(:bold t)))))
1043 `((((class grayscale)(background light))
1044 (:foreground "DimGray" ,@font))
1045 (((class grayscale)(background dark))
1046 (:foreground "LightGray" ,@font))
1047 (((class color)(background light))
1048 (:foreground "red" ,@font))
1049 (((class color)(background dark))
1050 (:foreground "red" ,@font))
1051 (t (,@font))))
1052 "Face for important keywords."
1053 :group 'font-latex-highlighting-faces)
1054
1055 (defface font-latex-verbatim-face
1056 (let ((font (if (and (assq :inherit custom-face-attributes)
1057 (if (featurep 'xemacs)
1058 (find-face 'fixed-pitch)
1059 (facep 'fixed-pitch)))
1060 '(:inherit fixed-pitch)
1061 '(:family "courier"))))
1062 `((((class grayscale) (background light))
1063 (:foreground "DimGray" ,@font))
1064 (((class grayscale) (background dark))
1065 (:foreground "LightGray" ,@font))
1066 (((class color) (background light))
1067 (:foreground "SaddleBrown" ,@font))
1068 (((class color) (background dark))
1069 (:foreground "burlywood" ,@font))
1070 (t (,@font))))
1071 "Face used to highlight TeX verbatim environments."
1072 :group 'font-latex-highlighting-faces)
1073
1074 (defface font-latex-superscript-face
1075 '((t (:height 0.8)))
1076 "Face used for superscripts."
1077 :group 'font-latex-highlighting-faces)
1078
1079 (defface font-latex-subscript-face
1080 '((t (:height 0.8)))
1081 "Face used for subscripts."
1082 :group 'font-latex-highlighting-faces)
1083
1084 (defface font-latex-slide-title-face
1085 (let* ((scale 1.2)
1086 (size (when (featurep 'xemacs)
1087 (round (* 0.9 (face-height 'default) scale)))))
1088 (if (featurep 'xemacs)
1089 `((t (:bold t :family "helvetica" :size ,size)))
1090 `((t (:inherit (variable-pitch font-lock-type-face)
1091 :weight bold :height ,scale)))))
1092 "Face for slide titles."
1093 :group 'font-latex-highlighting-faces)
1094 (when (featurep 'xemacs)
1095 (set-face-parent 'font-latex-slide-title-face 'font-lock-type-face
1096 nil nil 'append))
1097
1098
1099 ;;; Setup
1100
1101 (defvar font-lock-comment-start-regexp nil
1102 "Regexp to match the start of a comment.")
1103
1104 (defvar font-latex-extend-region-functions nil
1105 "List of functions extending the region for multiline constructs.
1106
1107 Each function should accept two arguments, the begin and end of
1108 the region to be fontified, and return the new region start. If
1109 no extension is necessary, the original region start should be
1110 returned.
1111
1112 All specified functions will be called and the region extended
1113 backwards to the minimum over their return values.")
1114
1115 (defvar font-latex-syntax-alist
1116 ;; Use word syntax for @ because we use \> for matching macros and
1117 ;; we don't want \foo@bar to be found if we search for \foo.
1118 '((?\( . ".") (?\) . ".") (?$ . "\"") (?@ . "w"))
1119 "List of specifiers for the syntax alist of `font-lock-defaults'.")
1120
1121 (defun font-latex-add-to-syntax-alist (list)
1122 "Activate syntactic font locking for the entries in LIST.
1123 The entries are added to `font-latex-syntax-alist' and eventually
1124 end up in `font-lock-defaults'. Each entry in LIST should be a
1125 cons pair as expected by `font-lock-defaults'. The function also
1126 triggers Font Lock to recognize the change."
1127 (make-local-variable 'font-latex-syntax-alist)
1128 (nconc font-latex-syntax-alist list)
1129 ;; FIXME: Are there situations where we need to alter `font-lock-defaults'
1130 ;; directly?
1131 ;; (dolist (entry list)
1132 ;; (setcar (cdddr font-lock-defaults)
1133 ;; (cons entry (cadddr font-lock-defaults))))
1134 ;; Tell font-lock about the update.
1135 (setq font-lock-set-defaults nil)
1136 (font-lock-set-defaults))
1137
1138 ;;;###autoload
1139 (defun font-latex-setup ()
1140 "Setup this buffer for LaTeX font-lock. Usually called from a hook."
1141 (font-latex-set-syntactic-keywords)
1142 ;; Trickery to make $$ fontification be in `font-latex-math-face' while
1143 ;; strings get whatever `font-lock-string-face' has been set to.
1144 (when (fboundp 'built-in-face-specifiers)
1145 ;; Cool patch from Christoph Wedler...
1146 (let (instance)
1147 (mapc (lambda (property)
1148 (setq instance
1149 (face-property-instance 'font-latex-math-face property
1150 nil 0 t))
1151 (if (numberp instance)
1152 (setq instance
1153 (face-property-instance 'default property nil 0)))
1154 (or (numberp instance)
1155 (set-face-property 'font-lock-string-face property
1156 instance (current-buffer))))
1157 (built-in-face-specifiers))))
1158
1159 ;; Activate multi-line fontification facilities if available.
1160 (when (boundp 'font-lock-multiline)
1161 (set (make-local-variable 'font-lock-multiline) t))
1162
1163 ;; Functions for extending the region.
1164 (dolist (elt '(font-latex-extend-region-backwards-command-with-args
1165 font-latex-extend-region-backwards-command-in-braces
1166 font-latex-extend-region-backwards-quotation
1167 font-latex-extend-region-backwards-math-env
1168 font-latex-extend-region-backwards-math-envII))
1169 (add-to-list 'font-latex-extend-region-functions elt))
1170
1171 ;; Tell Font Lock about the support.
1172 (make-local-variable 'font-lock-defaults)
1173 ;; The test for `major-mode' currently only works with docTeX mode
1174 ;; because `TeX-install-font-lock' is called explicitely in
1175 ;; `doctex-mode'. In case other modes have to be distinguished as
1176 ;; well, remove the call to `TeX-install-font-lock' from
1177 ;; `VirTeX-common-initialization' and place it in the different
1178 ;; `xxx-mode' calls instead, but _after_ `major-mode' is set.
1179 (let ((defaults
1180 `((font-latex-keywords font-latex-keywords-1 font-latex-keywords-2)
1181 nil nil ,font-latex-syntax-alist nil))
1182 (variables
1183 '((font-lock-comment-start-regexp . "%")
1184 (font-lock-mark-block-function . mark-paragraph)
1185 (font-lock-fontify-region-function
1186 . font-latex-fontify-region)
1187 (font-lock-unfontify-region-function
1188 . font-latex-unfontify-region))))
1189 ;; Add the mode-dependent stuff to the basic variables defined above.
1190 (if (eq major-mode 'doctex-mode)
1191 (progn
1192 (setcar defaults (append (car defaults)
1193 '(font-latex-doctex-keywords)))
1194 (setq variables
1195 (append variables
1196 '((font-lock-syntactic-face-function
1197 . font-latex-doctex-syntactic-face-function)
1198 (font-lock-syntactic-keywords
1199 . font-latex-doctex-syntactic-keywords)))))
1200 (setq variables
1201 (append variables
1202 '((font-lock-syntactic-face-function
1203 . font-latex-syntactic-face-function)
1204 (font-lock-syntactic-keywords
1205 . font-latex-syntactic-keywords)))))
1206 ;; Cater for the idiosyncrasies of Emacs and XEmacs.
1207 (if (featurep 'xemacs)
1208 (progn
1209 ;; XEmacs does not set these variables via `font-lock-defaults'
1210 ;; but requires them to be set explicitely.
1211 (mapc (lambda (alist)
1212 (set (car alist) (cdr alist))) variables)
1213 ;; Has to be set to t as otherwise syntax properties will not be
1214 ;; be picked up during fontification.
1215 (set (make-local-variable 'lookup-syntax-properties) t))
1216 (setq defaults (append defaults variables)))
1217 ;; Set the defaults.
1218 (setq font-lock-defaults defaults)))
1219
1220 (defun font-latex-jit-lock-force-redisplay (buf start end)
1221 "Compatibility for Emacsen not offering `jit-lock-force-redisplay'."
1222 (if (fboundp 'jit-lock-force-redisplay)
1223 (jit-lock-force-redisplay buf start end)
1224 ;; The following block is an expansion of `jit-lock-force-redisplay'
1225 ;; and involved macros taken from CVS Emacs on 2007-04-28.
1226 (with-current-buffer buf
1227 (let ((modified (buffer-modified-p)))
1228 (unwind-protect
1229 (let ((buffer-undo-list t)
1230 (inhibit-read-only t)
1231 (inhibit-point-motion-hooks t)
1232 (inhibit-modification-hooks t)
1233 deactivate-mark
1234 buffer-file-name
1235 buffer-file-truename)
1236 (put-text-property start end 'fontified t))
1237 (unless modified
1238 (restore-buffer-modified-p nil)))))))
1239
1240 (defun font-latex-fontify-region (beg end &optional loudly)
1241 "Fontify region from BEG to END.
1242 If optional argument is non-nil, print status messages."
1243 (let ((extend-list (delq nil (mapcar (lambda (fun) (funcall fun beg end))
1244 font-latex-extend-region-functions))))
1245 (when extend-list
1246 (let ((orig-beg beg))
1247 (setq beg (apply 'min extend-list))
1248 (when (featurep 'jit-lock)
1249 ;; Stolen from `jit-lock-fontify-now' (2007-04-27) and
1250 ;; adapted. Without this stanza only the line in which a
1251 ;; change happened will refontified. The rest will only be
1252 ;; refontified upon redisplay.
1253 (run-with-timer 0 nil 'font-latex-jit-lock-force-redisplay
1254 (current-buffer) beg orig-beg))))
1255 (font-lock-default-fontify-region beg end loudly)))
1256
1257 ;; Copy and adaption of `tex-font-lock-unfontify-region' from
1258 ;; tex-mode.el in GNU Emacs on 2004-08-04.
1259 ;; (XEmacs passes a third argument to the function.)
1260 (defun font-latex-unfontify-region (beg end &rest ignored)
1261 "Unfontify region from BEG to END."
1262 (font-lock-default-unfontify-region beg end)
1263 ;; XEmacs does not provide `font-lock-extra-managed-props', so
1264 ;; remove the `font-latex-multiline' property manually. (The
1265 ;; property is only added if `font-lock-multiline' is bound.)
1266 (unless (boundp 'font-lock-multiline)
1267 (remove-text-properties beg end '(font-latex-multiline)))
1268 (while (< beg end)
1269 (let ((next (next-single-property-change beg 'display nil end))
1270 (prop (get-text-property beg 'display)))
1271 (if (and (eq (car-safe prop) 'raise)
1272 (member (car-safe (cdr prop))
1273 (list (nth 1 (car font-latex-script-display))
1274 (nth 1 (cdr font-latex-script-display))))
1275 (null (cddr prop)))
1276 (put-text-property beg next 'display nil))
1277 (setq beg next))))
1278
1279 (defadvice font-lock-after-change-function (before font-latex-after-change
1280 activate)
1281 "Extend region for fontification of multiline constructs.
1282 This is only necessary if the editor does not provide multiline
1283 fontification facilities like `font-lock-multiline' itself."
1284 (unless (boundp 'font-lock-multiline)
1285 (let ((ad-beg (ad-get-arg 0))
1286 (ad-end (ad-get-arg 1)))
1287 (save-excursion
1288 (goto-char ad-beg)
1289 (beginning-of-line)
1290 (when (get-text-property (point) 'font-latex-multiline)
1291 (setq ad-beg (previous-single-property-change (point)
1292 'font-latex-multiline))
1293 (when (numberp ad-beg)
1294 (ad-set-arg 0 ad-beg)))
1295 (goto-char ad-end)
1296 (end-of-line)
1297 (when (get-text-property (point) 'font-latex-multiline)
1298 (setq ad-end (next-single-property-change (point)
1299 'font-latex-multiline))
1300 (when (numberp ad-end)
1301 (ad-set-arg 1 ad-end)))))))
1302
1303
1304 ;;; Utility functions
1305
1306 (defun font-latex-find-matching-close (openchar closechar)
1307 "Skip over matching pairs of OPENCHAR and CLOSECHAR.
1308 OPENCHAR is the opening character and CLOSECHAR is the closing
1309 character. Character pairs are usually { } or [ ]. Comments are
1310 ignored during the search."
1311 (let ((parse-sexp-ignore-comments
1312 (not (eq major-mode 'doctex-mode))) ; scan-sexps ignores comments
1313 (init-point (point))
1314 (mycount 1)
1315 (esc-char (or (and (boundp 'TeX-esc) TeX-esc) "\\"))
1316 ;; XXX: Do not look up syntax-table properties since they may
1317 ;; be misleading, e.g. in the case of "{foo}^^A" where the
1318 ;; closing brace gets a comment end syntax.
1319 (parse-sexp-lookup-properties nil))
1320 (or
1321 (condition-case nil
1322 (progn
1323 (goto-char (with-syntax-table
1324 (TeX-search-syntax-table openchar closechar)
1325 (scan-sexps (point) 1)))
1326 ;; No error code. See if closechar is unquoted
1327 (save-excursion
1328 (backward-char 1)
1329 (zerop (mod (skip-chars-backward (regexp-quote esc-char)) 2))))
1330 (error nil))
1331 (save-match-data
1332 (goto-char (1+ init-point))
1333 (while (and (> mycount 0)
1334 (re-search-forward
1335 (string ?\[
1336 ;; closechar might be ]
1337 ;; and therefor must be first in regexp
1338 closechar openchar
1339 ?\])
1340 nil t))
1341 (cond
1342 ((font-latex-commented-outp)
1343 (forward-line 1))
1344 ((save-excursion
1345 (backward-char 1)
1346 (zerop (mod (skip-chars-backward (regexp-quote esc-char))
1347 2)))
1348 (setq mycount (+ mycount
1349 (if (= (preceding-char) openchar) 1 -1)))))))
1350 (if (= mycount 0)
1351 t
1352 (goto-char init-point)
1353 nil))))
1354
1355 (defun font-latex-commented-outp ()
1356 "Return t if comment character is found between bol and point."
1357 (save-excursion
1358 (let ((limit (point))
1359 (esc-char (if (and (boundp 'TeX-esc) TeX-esc) TeX-esc "\\")))
1360 (forward-line 0)
1361 (if (and (eq (char-after) ?\%)
1362 (not (font-latex-faces-present-p 'font-latex-verbatim-face)))
1363 (not (eq major-mode 'doctex-mode))
1364 (catch 'found
1365 (while (progn (skip-chars-forward "^%" limit)
1366 (< (point) limit))
1367 (when (and (save-excursion
1368 (zerop (mod (skip-chars-backward
1369 (regexp-quote esc-char)) 2)))
1370 (not (font-latex-faces-present-p
1371 'font-latex-verbatim-face)))
1372 (throw 'found t))
1373 (forward-char)))))))
1374
1375 (defun font-latex-faces-present-p (faces &optional pos)
1376 "Return t if FACES are present at position POS.
1377 FACES may be a single face or a list of faces.
1378 If POS is omitted, the current position of point is used."
1379 (let* ((faces (if (listp faces) faces (list faces)))
1380 (pos (or pos (point)))
1381 (prop (get-text-property pos 'face))
1382 (prop-list (if (listp prop) prop (list prop))))
1383 (catch 'member
1384 (dolist (item prop-list)
1385 (when (memq item faces)
1386 (throw 'member t))))))
1387
1388 (defun font-latex-forward-comment ()
1389 "Like `forward-comment' but with special provisions for docTeX mode.
1390 In docTeX mode \"%\" at the start of a line will be treated as whitespace."
1391 (if (eq major-mode 'doctex-mode)
1392 ;; XXX: We should probably cater for ^^A as well.
1393 (progn
1394 (while (progn (if (bolp) (skip-chars-forward "%"))
1395 (> (skip-chars-forward " \t\n") 0)))
1396 (when (eq (char-after) ?%)
1397 (beginning-of-line 2)
1398 t))
1399 (forward-comment 1)))
1400
1401 (defun font-latex-put-multiline-property-maybe (beg end)
1402 "Add a multiline property if no equivalent is provided by the editor.
1403 The text property is used to find the start or end of a multiline
1404 construct when unfontifying a region. Emacs adds such a text
1405 property automatically if `font-lock-multiline' is set to t and
1406 extends the region to be unfontified automatically as well.
1407 XEmacs does not do this at the time of this writing."
1408 (unless (boundp 'font-lock-multiline)
1409 (put-text-property beg end 'font-latex-multiline t)))
1410
1411
1412 ;;; Match functions
1413
1414 (defvar font-latex-matched-faces nil
1415 "List of faces corresponding to matches in match data.")
1416
1417 (defun font-latex-matched-face (pos)
1418 "Return face at position POS in `font-latex-matched-faces'."
1419 (nth pos font-latex-matched-faces))
1420
1421 (defvar font-latex-command-with-args-default-spec nil ; "*[{"
1422 "Default specifier for keywords without syntax description.
1423 Set this to nil if verification of command syntax is unwanted.")
1424
1425 (defvar font-latex-command-with-args-opt-arg-delims
1426 '((?[ . ?]) (?< . ?>) (?\( . ?\)))
1427 "List character pairs used as delimiters for optional arguments.")
1428
1429 (defvar font-latex-syntax-error-modes '(latex-mode)
1430 "List of modes where syntax errors in macros should be indicated.")
1431
1432 (defun font-latex-match-command-with-arguments (regexp keywords face limit)
1433 "Search for regexp command KEYWORDS[opt]{arg} before LIMIT.
1434 Returns nil if none of KEYWORDS is found."
1435 (setq font-latex-matched-faces nil)
1436 (catch 'match
1437 (while (re-search-forward regexp limit t)
1438 (unless (font-latex-faces-present-p '(font-lock-comment-face
1439 font-latex-verbatim-face)
1440 (match-beginning 0))
1441 (let* ((beg (match-beginning 0))
1442 end ; Used for multiline text property.
1443 match-data match-beg syntax-error alternative spec
1444 error-indicator-pos
1445 (spec-list (string-to-list
1446 (or (cadr (assoc (match-string 1) keywords))
1447 font-latex-command-with-args-default-spec)))
1448 (parse-sexp-ignore-comments t)) ; scan-sexps ignores comments
1449 (add-to-list 'match-data beg)
1450 (goto-char (match-end 0))
1451 ;; Check for starred macro if first spec is an asterisk.
1452 (when (eq (car spec-list) ?*)
1453 (setq spec-list (cdr spec-list))
1454 (skip-chars-forward "*" (1+ (point))))
1455 ;; Add current point to match data and use keyword face for
1456 ;; region from start to point.
1457 (add-to-list 'match-data (point) t)
1458 (add-to-list 'font-latex-matched-faces 'font-lock-keyword-face)
1459 (setq end (point))
1460 (catch 'break
1461 ;; Walk the list of specs.
1462 (while spec-list
1463 (setq spec (pop spec-list)
1464 error-indicator-pos beg)
1465 (while (and (not (eobp)) (font-latex-forward-comment)))
1466 ;; Alternative
1467 (when (eq spec ?|)
1468 (setq alternative t)
1469 (setq spec (pop spec-list)))
1470 (cond
1471 ;; Macros: \foo
1472 ((eq spec ?\\)
1473 (if (eq (char-after) spec)
1474 (progn
1475 (nconc match-data
1476 (list (point)
1477 (progn
1478 (forward-char)
1479 (if (zerop (skip-chars-forward "A-Za-z@"))
1480 (forward-char) ; Single-char macro.
1481 (skip-chars-forward "*"))
1482 (point))))
1483 (nconc font-latex-matched-faces (list face))
1484 (setq end (max end (point)))
1485 (when alternative (pop spec-list)))
1486 (setq syntax-error t)
1487 (throw 'break nil)))
1488 ;; Mandatory arguments: {...}
1489 ((eq spec ?{)
1490 (if (and (eq (char-after) spec)
1491 (setq match-beg (point))
1492 (font-latex-find-matching-close ?{ ?}))
1493 (progn
1494 (nconc match-data (list (1+ match-beg) (1- (point))))
1495 (nconc font-latex-matched-faces (list face))
1496 (setq end (max end (1- (point))))
1497 (when alternative (pop spec-list)))
1498 (unless alternative
1499 (setq syntax-error t)
1500 (when (and match-beg (= match-beg (point)))
1501 (setq error-indicator-pos match-beg))
1502 (throw 'break nil))))
1503 ;; Optional arguments: [...] and others
1504 ((eq (char-after) spec)
1505 (setq match-beg (point))
1506 (if (font-latex-find-matching-close
1507 spec (cdr (assq
1508 spec
1509 font-latex-command-with-args-opt-arg-delims)))
1510 (progn
1511 (nconc match-data (list (1+ match-beg) (1- (point))))
1512 (nconc font-latex-matched-faces
1513 (list 'font-lock-variable-name-face))
1514 (setq end (max end (1- (point)))))
1515 (setq syntax-error t
1516 error-indicator-pos match-beg)
1517 (throw 'break nil))))
1518 (setq alternative nil)))
1519 (when (and syntax-error (memq major-mode
1520 font-latex-syntax-error-modes))
1521 ;; Add the warning face at the front of the list because
1522 ;; the matcher uses 'append and the face would otherwise
1523 ;; be overridden by the keyword face.
1524 (setq match-data (append (list error-indicator-pos
1525 (1+ error-indicator-pos))
1526 match-data))
1527 (push 'font-latex-warning-face font-latex-matched-faces))
1528 (font-latex-put-multiline-property-maybe beg end)
1529 (store-match-data match-data)
1530 (throw 'match t))))))
1531
1532 (defun font-latex-extend-region-backwards-command-with-args (beg end)
1533 "Return position to extend region backwards for commands with args.
1534 Return nil if region does not have to be extended for a multiline
1535 macro to fit in. The region between the positions BEG and END
1536 marks boundaries for searching for macro ends."
1537 (save-excursion
1538 (goto-char end)
1539 (catch 'extend
1540 (while (TeX-search-backward-unescaped "}" beg t)
1541 (let ((macro-start (TeX-find-macro-start
1542 (max (point-min)
1543 (- beg font-latex-multiline-boundary)))))
1544 (when (and macro-start
1545 (< macro-start beg))
1546 (throw 'extend macro-start))))
1547 nil)))
1548
1549 (defun font-latex-match-command-in-braces (keywords limit)
1550 "Search for command like {\\bfseries fubar} before LIMIT.
1551 Sets `match-data' so that:
1552 subexpression 0 is a warning indicator,
1553 subexpression 1 is the keyword, and
1554 subexpression 2 is the rest in the TeX group.
1555 Returns nil if no command is found."
1556 (catch 'match
1557 (while (re-search-forward keywords limit t)
1558 (unless (font-latex-faces-present-p '(font-lock-comment-face
1559 font-latex-verbatim-face)
1560 (match-beginning 0))
1561 (let ((kbeg (match-beginning 0)) (kend (match-end 1))
1562 (beg (match-end 0))
1563 end cbeg cend
1564 (parse-sexp-ignore-comments t)) ; scan-sexps ignores comments
1565 (goto-char kbeg)
1566 (if (not (eq (preceding-char) ?\{))
1567 ;; Fontify only the keyword (no argument found).
1568 (progn
1569 (setq cbeg kbeg cend kend)
1570 (goto-char (match-end 0))
1571 (store-match-data (list (point) (point)
1572 (point) (point)
1573 cbeg cend))
1574 (throw 'match t))
1575 ;; There's an opening bracket
1576 (save-restriction
1577 ;; Restrict to LIMIT.
1578 (narrow-to-region (point-min) limit)
1579 (forward-char -1) ; Move on the opening bracket
1580 (if (font-latex-find-matching-close ?\{ ?\})
1581 (progn
1582 (font-latex-put-multiline-property-maybe beg (1- (point)))
1583 (store-match-data (list kbeg kbeg
1584 kbeg kend
1585 beg (1- (point)))))
1586 (goto-char kend)
1587 (store-match-data (list (1- kbeg) kbeg
1588 kbeg kend
1589 kend kend)))
1590 (throw 'match t))))))))
1591
1592 (defun font-latex-extend-region-backwards-command-in-braces (beg end)
1593 "Return position to extend region backwards for commands in braces.
1594 Return nil if region does not have to be extended for a multiline
1595 group to fit in. The region between the positions BEG and END
1596 marks boundaries for searching for group ends."
1597 (save-excursion
1598 (goto-char end)
1599 (catch 'extend
1600 (while (TeX-search-backward-unescaped "}" beg t)
1601 (let ((group-start (TeX-find-opening-brace
1602 nil (max (point-min)
1603 (- beg font-latex-multiline-boundary)))))
1604 (when group-start
1605 ;; XXX: Actually we'd have to check if any of the
1606 ;; declaration-type macros can be found right after the
1607 ;; brace. If we don't do this (like now) large regions
1608 ;; may be refontified for no good reason. For checking
1609 ;; the built-in `font-latex-match-*' variables for
1610 ;; declaration-type macros as well as the respective
1611 ;; user-defined variables could be concatenated.
1612 (goto-char group-start)
1613 (when (< group-start beg)
1614 (throw 'extend group-start)))))
1615 nil)))
1616
1617 (defun font-latex-match-simple-command (limit)
1618 "Search for command like \\foo before LIMIT."
1619 (TeX-re-search-forward-unescaped "\\\\[@A-Za-z]+" limit t))
1620
1621 (defun font-latex-match-math-env (limit)
1622 "Match math pattern up to LIMIT.
1623 Used for patterns like:
1624 \\( F = ma \\)
1625 \\[ F = ma \\] but not \\\\ [len]"
1626 (catch 'match
1627 (while (re-search-forward "\\(\\\\(\\)\\|\\(\\\\\\[\\)" limit t)
1628 (unless (save-excursion
1629 (goto-char (match-beginning 0))
1630 ;; \\[ does not start a math environment
1631 (/= (mod (skip-chars-backward "\\\\") 2) 0))
1632 (let ((beg (match-beginning 0))
1633 (open-tag (if (match-beginning 1) "\\(" "\\["))
1634 (close-tag (if (match-beginning 1) "\\)" "\\]")))
1635 ;; Search for both opening and closing tags in order to be
1636 ;; able to avoid erroneously matching stuff like "\(foo \(bar\)".
1637 (if (and (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*\\("
1638 (regexp-quote open-tag) "\\|"
1639 (regexp-quote close-tag) "\\)")
1640 limit 'move)
1641 (string= (match-string 1) close-tag))
1642 ;; Found closing tag.
1643 (progn
1644 (font-latex-put-multiline-property-maybe beg (point))
1645 (store-match-data (list beg beg beg (point))))
1646 ;; Did not find closing tag.
1647 (goto-char (+ beg 2))
1648 (store-match-data (list beg (point) (point) (point))))
1649 (throw 'match t))))))
1650
1651 (defun font-latex-extend-region-backwards-math-env (beg end)
1652 "Return position to extend region backwards for math environments.
1653 Return nil if region does not have to be extended for a multiline
1654 environment to fit in. The region between the positions BEG and
1655 END marks boundaries for searching for environment ends."
1656 (save-excursion
1657 (goto-char end)
1658 (catch 'extend
1659 (while (re-search-backward "\\(\\\\)\\)\\|\\(\\\\]\\)" beg t)
1660 (when (and (zerop (mod (skip-chars-backward "\\\\") 2))
1661 (re-search-backward
1662 (concat "[^\\]\\(?:\\\\\\\\\\)*\\("
1663 (regexp-quote (if (match-beginning 1) "\\(" "\\["))
1664 "\\)")
1665 (- beg font-latex-multiline-boundary) t)
1666 (goto-char (match-beginning 1))
1667 (< (point) beg))
1668 (throw 'extend (point))))
1669 nil)))
1670
1671 (defcustom font-latex-math-environments
1672 '("display" "displaymath" "equation" "eqnarray" "gather" "multline"
1673 "align" "alignat" "xalignat" "xxalignat" "flalign")
1674 "List of math environment names for font locking."
1675 :type '(repeat string)
1676 :group 'font-latex)
1677
1678 (defun font-latex-match-math-envII (limit)
1679 "Match math patterns up to LIMIT.
1680 Used for patterns like:
1681 \\begin{equation}
1682 fontified stuff
1683 \\end{equation}
1684 The \\begin{equation} and \\end{equation} are not fontified here."
1685 (when (re-search-forward (concat "\\\\begin[ \t]*{"
1686 (regexp-opt font-latex-math-environments t)
1687 "\\*?}")
1688 limit t)
1689 (let ((beg (match-end 0)) end)
1690 (if (re-search-forward (concat "\\\\end[ \t]*{"
1691 (regexp-quote
1692 (buffer-substring-no-properties
1693 (match-beginning 1)
1694 (match-end 0))))
1695 ;; XXX: Should this rather be done by
1696 ;; extending the region to be fontified?
1697 (+ limit font-latex-multiline-boundary) 'move)
1698 (setq end (match-beginning 0))
1699 (goto-char beg)
1700 (setq end beg))
1701 (font-latex-put-multiline-property-maybe beg end)
1702 (store-match-data (list beg end))
1703 t)))
1704
1705 (defun font-latex-extend-region-backwards-math-envII (beg end)
1706 "Return position to extend region backwards for math environments.
1707 Return nil if region does not have to be extended for a multiline
1708 environment to fit in. The region between the positions BEG and
1709 END marks boundaries for searching for environment ends."
1710 (save-excursion
1711 (goto-char end)
1712 (catch 'extend
1713 (while (re-search-backward
1714 (concat "\\\\end[ \t]*{"
1715 (regexp-opt font-latex-math-environments t)
1716 "\\*?}") beg t)
1717 (when (and (re-search-backward (concat "\\\\begin[ \t]*{"
1718 (buffer-substring-no-properties
1719 (match-beginning 1)
1720 (match-end 0)))
1721 (- beg font-latex-multiline-boundary) t)
1722 (< (point) beg))
1723 (throw 'extend (point))))
1724 nil)))
1725
1726 (defun font-latex-update-quote-list ()
1727 "Update quote list and regexp if value of `font-latex-quotes' changed."
1728 (unless (eq font-latex-quotes-control font-latex-quotes)
1729 (setq font-latex-quotes-control font-latex-quotes)
1730 (font-latex-quotes-set-internal)
1731 ;; Set order of each entry in `font-latex-quote-list' according to
1732 ;; setting of `font-latex-quotes-internal'.
1733 (let ((tail font-latex-quote-list)
1734 elt)
1735 (while tail
1736 (setq elt (car tail))
1737 (when (and (> (safe-length elt) 2)
1738 (not (eq (nth 2 elt) font-latex-quotes-internal)))
1739 (setcar tail (list (nth 1 elt) (nth 0 elt)
1740 font-latex-quotes-internal)))
1741 (setq tail (cdr tail))))
1742 (setq font-latex-quote-regexp-beg
1743 (regexp-opt (mapcar 'car font-latex-quote-list) t))))
1744
1745 (defun font-latex-match-quotation (limit)
1746 "Match quote patterns up to LIMIT.
1747 Used for patterns like:
1748 ``this is a normal quote'' and these are multilingual quoted strings:
1749 \"< french \"> and \"`german\"' quotes.
1750 The quotes << french >> and 8-bit french are used if `font-latex-quotes' is
1751 set to french, and >>german<< (and 8-bit) are used if set to german."
1752 (when font-latex-quotes
1753 (font-latex-update-quote-list)
1754 ;; Search for matches.
1755 (catch 'match
1756 (while (TeX-re-search-forward-unescaped
1757 font-latex-quote-regexp-beg limit t)
1758 (unless (font-latex-faces-present-p '(font-lock-comment-face
1759 font-latex-verbatim-face
1760 font-latex-math-face)
1761 (match-beginning 0))
1762 (let* ((beg (match-beginning 0))
1763 (after-beg (match-end 0))
1764 (opening-quote (match-string 0))
1765 (closing-quote
1766 (nth 1 (assoc (if (fboundp 'string-make-multibyte)
1767 (string-make-multibyte (match-string 0))
1768 (match-string 0))
1769 font-latex-quote-list)))
1770 (nest-count 0)
1771 (point-of-surrender (+ beg font-latex-multiline-boundary)))
1772 ;; Find closing quote taking nested quotes into account.
1773 (while (progn
1774 (re-search-forward
1775 (concat opening-quote "\\|" closing-quote)
1776 point-of-surrender 'move)
1777 (when (and (< (point) point-of-surrender) (not (eobp)))
1778 (if (string= (match-string 0) opening-quote)
1779 (setq nest-count (1+ nest-count))
1780 (when (/= nest-count 0)
1781 (setq nest-count (1- nest-count)))))))
1782 ;; If no closing quote was found, set the second match which
1783 ;; will be marked with warning color, if one was found, set
1784 ;; the first match which will be marked with string color.
1785 (if (or (= (point) point-of-surrender) (eobp))
1786 (progn
1787 (goto-char after-beg)
1788 (store-match-data (list after-beg after-beg beg after-beg)))
1789 (font-latex-put-multiline-property-maybe beg (point))
1790 (store-match-data (list beg (point) (point) (point))))
1791 (throw 'match t)))))))
1792
1793 (defun font-latex-extend-region-backwards-quotation (beg end)
1794 "Return position to extend region backwards for quotations.
1795 Return nil if region does not have to be extended for a multiline
1796 quotation to fit in. The region between the positions BEG and
1797 END marks boundaries for searching for quotation ends."
1798 (if font-latex-quotes
1799 (progn
1800 (font-latex-update-quote-list)
1801 (let ((regexp-end (regexp-opt (mapcar 'cadr font-latex-quote-list) t)))
1802 (save-excursion
1803 (goto-char end)
1804 (catch 'extend
1805 (while (re-search-backward regexp-end beg t)
1806 (let ((closing-quote (match-string 0))
1807 (nest-count 0)
1808 (point-of-surrender (- beg font-latex-multiline-boundary))
1809 opening-quote)
1810 (catch 'found
1811 (dolist (elt font-latex-quote-list)
1812 (when (string= (cadr elt) closing-quote)
1813 (setq opening-quote (car elt))
1814 (throw 'found nil))))
1815 ;; Find opening quote taking nested quotes into account.
1816 (while (progn
1817 (re-search-backward (concat opening-quote "\\|"
1818 closing-quote)
1819 point-of-surrender 'move)
1820 (when (and (> (point) point-of-surrender)
1821 (not (bobp)))
1822 (if (string= (match-string 0) closing-quote)
1823 (setq nest-count (1+ nest-count))
1824 (when (/= nest-count 0)
1825 (setq nest-count (1- nest-count)))))))
1826 (when (< (point) beg)
1827 (throw 'extend (point)))))
1828 nil))))
1829 nil))
1830
1831 (defun font-latex-match-script (limit)
1832 "Match subscript and superscript patterns up to LIMIT."
1833 (when (and font-latex-fontify-script
1834 (re-search-forward "[_^] *\\([^\n\\{}]\\|\
1835 \\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|\\({\\)\\)" limit t))
1836 (if (font-latex-faces-present-p '(font-latex-subscript-face
1837 font-latex-superscript-face))
1838 ;; Apply subscript and superscript highlighting only once in
1839 ;; order to prevent the font size becoming too small. We set
1840 ;; an empty match to do that.
1841 (let ((point (point)))
1842 (store-match-data (list point point point point)))
1843 (when (match-end 3)
1844 (let ((beg (match-beginning 3))
1845 (end (TeX-find-closing-brace
1846 ;; Don't match groups spanning more than one line
1847 ;; in order to avoid visually wrong indentation in
1848 ;; subsequent lines.
1849 nil (line-end-position))))
1850 (store-match-data (if end
1851 (list (match-beginning 0) end beg end)
1852 (list beg beg beg beg))))))
1853 t))
1854
1855 ;; Copy and adaption of `tex-font-lock-suscript' from tex-mode.el in
1856 ;; GNU Emacs on 2004-07-07.
1857 (defun font-latex-script (pos)
1858 "Return face and display spec for subscript and superscript content."
1859 (when (and (font-latex-faces-present-p 'font-latex-math-face pos)
1860 (not (font-latex-faces-present-p '(font-lock-constant-face
1861 font-lock-builtin-face
1862 font-lock-comment-face
1863 font-latex-verbatim-face) pos))
1864 ;; Check for backslash quoting
1865 (not (let ((odd nil)
1866 (pos pos))
1867 (while (eq (char-before pos) ?\\)
1868 (setq pos (1- pos) odd (not odd)))
1869 odd)))
1870 ;; Adding other text properties than `face' is supported by
1871 ;; `font-lock-apply-highlight' in CVS Emacsen since 2001-10-28.
1872 ;; With the introduction of this feature the variable
1873 ;; `font-lock-extra-managed-props' was introduced and serves here
1874 ;; for feature checking. XEmacs (CVS and 21.4.15) currently
1875 ;; (2004-08-18) does not support this feature.
1876 (let ((extra-props-flag (boundp 'font-lock-extra-managed-props)))
1877 (if (eq (char-after pos) ?_)
1878 (if extra-props-flag
1879 `(face font-latex-subscript-face display
1880 ,(car font-latex-script-display))
1881 'font-latex-subscript-face)
1882 (if extra-props-flag
1883 `(face font-latex-superscript-face display
1884 ,(cdr font-latex-script-display))
1885 'font-latex-superscript-face)))))
1886
1887
1888 ;;; docTeX
1889
1890 (defvar font-latex-doctex-preprocessor-face
1891 'font-latex-doctex-preprocessor-face
1892 "Face used to highlight preprocessor directives in docTeX mode.")
1893
1894 (defface font-latex-doctex-preprocessor-face
1895 '((t (:inherit (font-latex-doctex-documentation-face
1896 font-lock-builtin-face ; Emacs 21 does not provide
1897 ; the preprocessor face.
1898 font-lock-preprocessor-face))))
1899 "Face used to highlight preprocessor directives in docTeX mode."
1900 :group 'font-latex-highlighting-faces)
1901
1902 (defvar font-latex-doctex-documentation-face
1903 'font-latex-doctex-documentation-face
1904 "Face used to highlight the documentation in docTeX mode.")
1905
1906 (defface font-latex-doctex-documentation-face
1907 '((((class mono)) (:inverse-video t))
1908 (((class grayscale) (background dark)) (:background "#333"))
1909 (((class color) (background dark)) (:background "#333"))
1910 (t (:background "#eeeeee")))
1911 "Face used to highlight the documentation parts in docTeX mode."
1912 :group 'font-latex-highlighting-faces)
1913
1914 (defvar font-latex-doctex-keywords
1915 (append font-latex-keywords-2
1916 '(("^%<[^>]*>" (0 font-latex-doctex-preprocessor-face t)))))
1917
1918 ;; Set and updated in `font-latex-set-syntactic-keywords'.
1919 (defvar font-latex-doctex-syntactic-keywords nil)
1920
1921 ;; Copy and adaptation of `doctex-font-lock-^^A' in `tex-mode.el' of
1922 ;; CVS Emacs (March 2004)
1923 (defun font-latex-doctex-^^A ()
1924 (if (eq (char-after (line-beginning-position)) ?\%)
1925 (progn
1926 (put-text-property
1927 (1- (match-beginning 1)) (match-beginning 1) 'syntax-table
1928 (if (= (1+ (line-beginning-position)) (match-beginning 1))
1929 ;; The `%' is a single-char comment, which Emacs
1930 ;; syntax-table can't deal with. We could turn it
1931 ;; into a non-comment, or use `\n%' or `%^' as the comment.
1932 ;; Instead, we include it in the ^^A comment.
1933 ;; COMPATIBILITY for Emacs 20 and XEmacs
1934 (eval-when-compile (if (fboundp 'string-to-syntax)
1935 (string-to-syntax "< b")
1936 '(2097163)))
1937 ;; COMPATIBILITY for Emacs 20 and XEmacs
1938 (eval-when-compile (if (fboundp 'string-to-syntax)
1939 (string-to-syntax ">")
1940 '(12)))))
1941 (let ((end (line-end-position)))
1942 (if (< end (point-max))
1943 (put-text-property end (1+ end) 'syntax-table
1944 ;; COMPATIBILITY for Emacs 20 and XEmacs
1945 (eval-when-compile
1946 (if (fboundp 'string-to-syntax)
1947 (string-to-syntax "> b")
1948 '(2097164))))))
1949 ;; COMPATIBILITY for Emacs 20 and XEmacs
1950 (eval-when-compile (if (fboundp 'string-to-syntax)
1951 (string-to-syntax "< b")
1952 '(2097163))))))
1953
1954 ;; Copy and adaptation of `doctex-font-lock-syntactic-face-function'
1955 ;; in `tex-mode.el' of CVS Emacs (March 2004)
1956 (defun font-latex-doctex-syntactic-face-function (state)
1957 ;; Mark docTeX documentation, which is parsed as a style A comment
1958 ;; starting in column 0.
1959 (if (or (nth 3 state) (nth 7 state)
1960 (not (memq (char-before (nth 8 state))
1961 '(?\n nil))))
1962 ;; Anything else is just as for LaTeX.
1963 (font-latex-syntactic-face-function state)
1964 font-latex-doctex-documentation-face))
1965
1966
1967 ;;; Installation in non-AUCTeX LaTeX mode
1968
1969 (add-hook 'latex-mode-hook 'font-latex-setup)
1970 ;; If font-latex is loaded using a latex-mode-hook, then the add-hook above
1971 ;; won't be called this time around. Check for this now:
1972 (if (eq major-mode 'latex-mode)
1973 (font-latex-setup))
1974
1975
1976 ;;; Byte-compilation of generated functions
1977
1978 (when (byte-code-function-p
1979 (symbol-function 'font-latex-make-built-in-keywords))
1980 (dolist (elt font-latex-built-in-keyword-classes)
1981 (let ((name (nth 0 elt)))
1982 (byte-compile (intern (concat "font-latex-match-" name)))
1983 (byte-compile (intern (concat "font-latex-match-" name "-make"))))))
1984
1985
1986 ;; Provide ourselves:
1987 (provide 'font-latex)
1988
1989 ;; Local Variables:
1990 ;; coding: iso-8859-1
1991 ;; End:
1992
1993 ;;; font-latex.el ends here

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26