diff options
Diffstat (limited to 'elpa/auctex-13.1.3/font-latex.el')
| -rw-r--r-- | elpa/auctex-13.1.3/font-latex.el | 2314 |
1 files changed, 2314 insertions, 0 deletions
diff --git a/elpa/auctex-13.1.3/font-latex.el b/elpa/auctex-13.1.3/font-latex.el new file mode 100644 index 0000000..c49a698 --- /dev/null +++ b/elpa/auctex-13.1.3/font-latex.el @@ -0,0 +1,2314 @@ +;;; font-latex.el --- LaTeX fontification for Font Lock mode. -*- lexical-binding: t; -*- + +;; Copyright (C) 1996-2022 Free Software Foundation, Inc. + +;; Authors: Peter S. Galbraith <psg@debian.org> +;; Simon Marshall <Simon.Marshall@esrin.esa.it> +;; Maintainer: auctex-devel@gnu.org +;; Created: 06 July 1996 +;; Keywords: tex, wp, faces + +;;; This file is not part of GNU Emacs. + +;; This package is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This package is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; This package enhances font-lock fontification patterns for LaTeX. +;; font-lock mode is a minor mode that causes your comments to be +;; displayed in one face, strings in another, reserved words in +;; another, and so on. + +;;; Code: + +(require 'font-lock) +(require 'tex) + +(eval-when-compile + (require 'cl-lib)) + +(defgroup font-latex nil + "Font-latex text highlighting package." + :prefix "font-latex-" + :group 'faces + :group 'tex + :group 'AUCTeX) + +(defgroup font-latex-keywords nil + "Keywords for highlighting text in font-latex." + :prefix "font-latex-" + :group 'font-latex) + +(defgroup font-latex-highlighting-faces nil + "Faces for highlighting text in font-latex." + :prefix "font-latex-" + :group 'font-latex) + +(defvar font-latex-multiline-boundary 5000 + "Size of region to search for the start or end of a multiline construct.") + +(defvar font-latex-quote-regexp-beg nil + "Regexp used to find quotes.") +(make-variable-buffer-local 'font-latex-quote-regexp-beg) + +(defvar font-latex-quote-list '(("``" "''") ("<<" ">>" french) ("«" "»" french)) + "List of quote specifiers for quotation fontification. + +Each element of the list is either a list consisting of two +strings to be used as opening and closing quotation marks +independently of the value of `font-latex-quotes' or a list with +three elements where the first and second element are strings for +opening and closing quotation marks and the third element being +either the symbol `german' or `french' describing the order of +quotes. + +If `font-latex-quotes' specifies a different state, order of the +added quotes will be reversed for fontification. For example if +'(\"\\\"<\" \"\\\">\" french) is given but `font-latex-quotes' +specifies `german', quotes will be used like \">foo\"< for +fontification.") + +(defvar font-latex-quotes-control nil + "Internal variable for keeping track if `font-latex-quotes' changed.") +(make-variable-buffer-local 'font-latex-quotes-control) + +(defvar font-latex-quotes-internal nil + "Internal variable for tracking outcome of automatic detection. +If automatic detection is not enabled, it is assigned the value +of `font-latex-quotes'.") +(make-variable-buffer-local 'font-latex-quotes-internal) + +(defvar font-latex-quotes-fallback 'french + "Fallback value for `font-latex-quotes' if automatic detection fails.") + +(defvar font-latex-quote-style-list-french + '("french" "frenchb" "frenchle" "frenchpro" "francais" "canadien" + "acadian" "italian") + "List of styles for which French-style quote matching should be activated.") + +(defvar font-latex-quote-style-list-german + '("austrian" "german" "germanb" "naustrian" "ngerman") + "List of styles for which German-style quote matching should be activated.") + +(defcustom font-latex-quotes 'auto + "Whether to fontify << French quotes >> or >>German quotes<<. +Also selects \"<quote\"> versus \">quote\"<. + +If value `auto' is chosen, an attempt is being made in deriving +the type of quotation mark matching from document settings like +the language option supplied to the babel package. + +If nil, quoted content will not be fontified." + :type '(choice (const auto) (const french) (const german) (const nil)) + :group 'font-latex) +(put 'font-latex-quotes 'safe-local-variable + (lambda (x) (memq x '(auto french german nil)))) + +(defun font-latex-add-quotes (quotes) + "Add QUOTES to `font-latex-quote-list'. +QUOTES has to be a list adhering to the format of an element of +`font-latex-quote-list'." + (setq font-latex-quotes-control nil) + (add-to-list (make-local-variable 'font-latex-quote-list) quotes)) + +(defun font-latex-quotes-set-internal () + "Set `font-latex-quotes-internal' according to `font-latex-quotes'. +If `font-latex-quotes' is set to `auto', try to derive the +correct value from document properties." + (setq font-latex-quotes-internal + (if (eq font-latex-quotes 'auto) + (or (when (TeX-elt-of-list-member + font-latex-quote-style-list-french TeX-active-styles) + 'french) + (when (TeX-elt-of-list-member + font-latex-quote-style-list-german TeX-active-styles) + 'german) + font-latex-quotes-fallback) + font-latex-quotes))) +;; Update the value of `font-latex-quotes-internal' when the list of +;; styles changes. +(add-hook 'TeX-update-style-hook #'font-latex-quotes-set-internal) + +;; The definitions of the title faces were originally taken from +;; info.el (Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 98, 99, +;; 2000, 2001 Free Software Foundation, Inc.) and adapted to the needs +;; of font-latex.el. + +(defconst font-latex-sectioning-max 5 + "Highest number for font-latex-sectioning-N-face") +(defface font-latex-sectioning-5-face + '((((type tty pc) (class color) (background light)) + (:foreground "blue4" :weight bold)) + (((type tty pc) (class color) (background dark)) + (:foreground "yellow" :weight bold)) + (((class color) (background light)) + (:weight bold :inherit variable-pitch :foreground "blue4")) + (((class color) (background dark)) + (:weight bold :inherit variable-pitch :foreground "yellow")) + (t (:weight bold :inherit variable-pitch))) + "Face for sectioning commands at level 5." + :group 'font-latex-highlighting-faces) + +(defcustom font-latex-fontify-sectioning 1.1 + "Whether to fontify sectioning macros with varying height or a color face. + +If it is a number, use varying height faces. The number is used +for scaling starting from `font-latex-sectioning-5-face'. Typically +values from 1.05 to 1.3 give best results, depending on your font +setup. If it is the symbol `color', use `font-lock-type-face'. + +Caveats: Customizing the scaling factor applies to all sectioning +faces unless those face have been saved by customize. Setting +this variable directly does not take effect unless you call +`font-latex-update-sectioning-faces' or restart Emacs. + +Switching from `color' to a number or vice versa does not take +effect unless you call \\[font-lock-fontify-buffer] or restart +Emacs." + :type '(choice (number :tag "Scale factor") + (const color)) + :initialize #'custom-initialize-default + :set (lambda (symbol value) + (set-default symbol value) + (unless (eq value 'color) + (font-latex-update-sectioning-faces font-latex-sectioning-max value))) + :group 'font-latex) + +(defun font-latex-update-sectioning-faces (&optional max height-scale) + "Update sectioning commands faces." + (unless height-scale + (setq height-scale (if (numberp font-latex-fontify-sectioning) + ;; Make sure `height-scale' is a floating point + ;; number because `set-face-attribute' treats + ;; integers differently from floating points. + (float font-latex-fontify-sectioning) + 1.1))) + (unless max + (setq max font-latex-sectioning-max)) + (dotimes (num max) + (let* (;; reverse for XEmacs: + (num (- max (1+ num))) + (face-name (intern (format "font-latex-sectioning-%s-face" num)))) + (unless (get face-name 'saved-face) ; Do not touch customized faces. + (set-face-attribute face-name nil :height height-scale))))) + +(defun font-latex-make-sectioning-faces (max &optional height-scale) + "Build the faces used to fontify sectioning commands." + (unless max (setq max font-latex-sectioning-max)) + (unless height-scale + (setq height-scale (if (numberp font-latex-fontify-sectioning) + ;; Make sure `height-scale' is a floating point + ;; number because the integer type is treated + ;; differently. + (float font-latex-fontify-sectioning) + 1.1))) + (dotimes (num max) + (let* ((num (- max (1+ num))) + (face-name (intern (format "font-latex-sectioning-%s-face" num))) + (f-inherit (intern (format "font-latex-sectioning-%s-face" (1+ num))))) + (eval + `(defface ,face-name + '((t (:height ,height-scale :inherit ,f-inherit))) + (format "Face for sectioning commands at level %s. + +Probably you don't want to customize this face directly. Better +change the base face `font-latex-sectioning-5-face' or customize the +variable `font-latex-fontify-sectioning'." ',num) + :group 'font-latex-highlighting-faces) + t)))) + +(font-latex-make-sectioning-faces font-latex-sectioning-max) + + +;;; Keywords + +(eval-and-compile +(defconst font-latex-built-in-keyword-classes + '(("warning" + ("nopagebreak" "pagebreak" "newpage" "clearpage" "cleardoublepage" + "enlargethispage" "nolinebreak" "linebreak" "newline" "-" "\\" "\\*" + "appendix" "displaybreak" "allowdisplaybreaks" "tabularnewline" "include" + "backmatter" "frontmatter" "mainmatter" + "makeatletter" "makeatother" "newblock" "suppressfloats" "endinput") + font-latex-warning-face 1 noarg) + ("variable" + (("setlength" "|{\\{") ("settowidth" "|{\\{") ("settoheight" "{{") + ("settodepth" "{{") ("setcounter" "{|{\\") + ("addtolength" "|{\\{") ("addtocounter" "{|{\\") + ("stepcounter" "{") ("refstepcounter" "{") + ("counterwithin" "*[{{") ("counterwithout" "*[{{") + ("arabic" "{") ("roman" "{") ("Roman" "{") ("alph" "{") ("Alph" "{") + ("fnsymbol" "{")) + font-lock-variable-name-face 2 command) + ("biblatexnoarg" + ("newrefsegment" "mancite" "pno" "ppno" "nopp" "psq" "psqq") + font-lock-variable-name-face 2 noarg) + ("biblatex" + (;; 3.2.2 Setting Package Options + ("ExecuteBibliographyOptions" "[{") + ;; 3.7.1 Resources + ("addbibresource" "[{") ("addglobalbib" "[{") ("addsectionbib" "[{") + ;; 3.7.2 The Bibliography + ("printbibliography" "[") ("bibbysection" "[") ("bibbysegment" "[") + ("bibbycategory" "[") ("printbibheading" "[") + ;; 3.7.3 Bibliography Lists + ("printbiblist" "[{") ("printshorthands" "[") + ;; 3.7.4 Bibliography Sections + ("newrefsection" "[") + ;; 3.7.6 Bibliography Categories + ("DeclareBibliographyCategory" "{") ("addtocategory" "{{") + ;; 3.7.7 Bibliography Headings and Environments + ("defbibenvironment" "{{{{") ("defbibheading" "{[{") + ;; 3.7.8 Bibliography Notes + ("defbibnote" "{{") + ;; 3.7.9 Bibliography Filters and Checks + ("defbibfilter" "{{") ("defbibcheck" "{{") + ;; 3.7.10 Reference Contexts + ("DeclareRefcontext" "{{") ("newrefcontext" "[{") + ("assignrefcontextkeyws" "*[{") ("assignrefcontextcats" "*[{") + ("assignrefcontextentries" "*[{") + ;; 3.7.11 Dynamic Entry Sets + ("defbibentryset" "{{") + ;; 3.8.1 Standard Commands + ("Cite" "[[{") + ("parencite" "*[[{") ("Parencite" "[[{") + ("footcite" "[[{") ("footcitetext" "[[{") + ;; 3.8.2 Style-specific Commands + ("textcite" "[[{") ("Textcite" "[[{") + ("smartcite" "[[{") ("Smartcite" "[[{") + ("supercite" "{") + ;; 3.8.3 Qualified Citation Lists + ;; For qualified lists, fontify at least 2 mandatory arguments + ("cites" "(([[{[[{") ("Cites" "(([[{[[{") + ("parencites" "(([[{[[{") ("Parencites" "(([[{[[{") + ("footcites" "(([[{[[{") ("footcitetexts" "(([[{[[{") + ("smartcites" "(([[{[[{") ("Smartcites" "(([[{[[{") + ("textcites" "(([[{[[{") ("Textcites" "(([[{[[{") + ("supercites" "(([[{[[{") + ;; 3.8.4 Style-independent Commands + ("autocite" "*[[{") ("Autocite" "*[[{") + ("autocites" "(([[{[[{") ("Autocites" "(([[{[[{") + ;; 3.8.5 Text Commands + ("citeauthor" "*[[{") ("Citeauthor" "*[[{") ("citetitle" "*[[{") + ("citeyear" "*[[{") ("citedate" "*[[{") + ("citeurl" "[[{") ("parentext" "{") + ("brackettext" "{") + ;; 3.8.6 Special Commands + ("fullcite" "[[{") ("footfullcite" "[[{") + ("volcite" "[{[{") ("Volcite" "[{[{") + ("volcites" "(([{[{[{[{") ("Volcites" "(([{[{[{[{") + ("pvolcite" "[{[{") ("Pvolcite" "[{[{") + ("pvolcites" "(([{[{[{[{") ("Pvolcites" "(([{[{[{[{") + ("fvolcite" "[{[{") ("ftvolcite" "[{[{") + ("fvolcites" "(([{[{[{[{") ("Fvolcites" "(([{[{[{[{") + ("svolcite" "[{[{") ("Svolcite" "[{[{") + ("svolcites" "(([{[{[{[{") ("Svolcites" "(([{[{[{[{") + ("tvolcite" "[{[{") ("Tvolcite" "[{[{") + ("tvolcites" "(([{[{[{[{") ("Tvolcites" "(([{[{[{[{") + ("avolcite" "[{[{") ("Avolcite" "[{[{") + ("avolcites" "(([{[{[{[{") ("Avolcites" "(([{[{[{[{") + ("notecite" "[[{") ("Notecite" "[[{") + ("pnotecite" "[[{") ("Pnotecite" "[[{") + ("fnotecite" "[[{") + ;; 3.8.7 Low-level Commands + ("citename" "[[{[{") ("citelist" "[[{[{") ("citefield" "[[{[{") + ;; 3.8.8 Miscellaneous Commands + ("citereset" "*") ("RN" "{") ("Rn" "{") + ;; 3.9 Localization Commands + ("DefineBibliographyStrings" "{{") ("DefineBibliographyExtras" "{{") + ("UndefineBibliographyExtras" "{{") ("DefineHyphenationExceptions" "{{") + ("NewBibliographyString" "{")) + font-lock-constant-face 2 command) + ("reference" + (("nocite" "*{") ("cite" "*[[{") ("label" "{") ("pageref" "{") + ("vref" "*{") ("eqref" "{") ("ref" "{") ("Ref" "{") + ("footref" "{") ("include" "{") ("input" "{") + ("bibliography" "{") ("index" "{") ("glossary" "{") + ("footnote" "[{") ("footnotemark" "[") ("footnotetext" "[{") + ("marginpar" "[{") ("chaptermark" "{") ("sectionmark" "{") + ("subsectionmark" "{") ("subsubsectionmark" "{") + ("paragraphmark" "{") ("subparagraphmark" "{")) + font-lock-constant-face 2 command) + ("function" + (("begin" "{") ("end" "{") ("pagenumbering" "{") + ("thispagestyle" "{") ("pagestyle" "{") ("nofiles" "") + ("includeonly" "{") ("bibliographystyle" "{") ("documentstyle" "[{") + ("documentclass" "[{[") ("newenvironment" "*{[[{{") + ("newcommand" "*|{\\[[{") ("newlength" "|{\\") + ("newtheorem" "{[{[") + ("providecommand" "*|{\\[[{") + ("newcounter" "{[") ("renewenvironment" "*{[[{{") + ("renewcommand" "*|{\\[[{") ("renewtheorem" "{[{[") + ("usepackage" "[{[") ("RequirePackage" "[{[") + ("fbox" "{") ("mbox" "{") ("rule" "[{{") + ("framebox" "|[([{") ("makebox" "|[([{") ("newsavebox" "|{\\") + ("parbox" "[[[{{") ("savebox" "|{\\|[([{") ("sbox" "|{\\{") + ("usebox" "|{\\") + ("cline" "{") ("extracolsep" "{") ("multicolumn" "{{{") + ("linethickness" "{") ("multiput" "(({{") ("put" "({") + ("qbezier" "[(((") ("raisebox" "{[[{") + ("addvspace" "{") ("vspace" "*{") ("hspace" "*{") + ("addcontentsline" "{{{") ("addtocontents" "{{") + ("labelformat" "{{") + ("AddToHook" "{[{") ("RemoveFromHook" "{[") ("AddToHookNext" "{{") + ("ProvidesClass" "{[") ("ProvidesPackage" "{[") ("ProvidesFile" "{[") + ;; XXX: Should macros without arguments rather be listed in a + ;; separate category with 'noarg instead of 'command handling? + ("enspace" "") ("enskip" "") ("quad" "") ("qquad" "") ("nonumber" "") + ("bigskip" "") ("medskip" "") ("smallskip" "") + ("thinspace" "") ("negthinspace" "") + ("thicklines" "") ("thinlines" "") + ("noindent" "") ("hline" "") ("ldots" "") + ("centering" "") ("raggedright" "") ("raggedleft" "") + ("TeX" "") ("LaTeX" "") ("LaTeXe" "") + ("normalfont" "") ("normalshape" "") + ("tableofcontents" "") ("listoffigures" "") ("listoftables" "")) + font-lock-function-name-face 2 command) + ("sectioning-0" + (("part" "*[{")) + (if (eq font-latex-fontify-sectioning 'color) + 'font-lock-type-face + 'font-latex-sectioning-0-face) + 2 command) + ("sectioning-1" + (("chapter" "*[{")) + (if (eq font-latex-fontify-sectioning 'color) + 'font-lock-type-face + 'font-latex-sectioning-1-face) + 2 command) + ("sectioning-2" + (("section" "*[{")) + (if (eq font-latex-fontify-sectioning 'color) + 'font-lock-type-face + 'font-latex-sectioning-2-face) + 2 command) + ("sectioning-3" + (("subsection" "*[{")) + (if (eq font-latex-fontify-sectioning 'color) + 'font-lock-type-face + 'font-latex-sectioning-3-face) + 2 command) + ("sectioning-4" + (("subsubsection" "*[{")) + (if (eq font-latex-fontify-sectioning 'color) + 'font-lock-type-face + 'font-latex-sectioning-4-face) + 2 command) + ("sectioning-5" + (("paragraph" "*[{") ("subparagraph" "*[{") + ("subsubparagraph" "*[{")) + (if (eq font-latex-fontify-sectioning 'color) + 'font-lock-type-face + 'font-latex-sectioning-5-face) + 2 command) + ("slide-title" () font-latex-slide-title-face 2 command) + ("textual" + (("item" "[") ("bibitem" "[{") ("title" "{") ("author" "{") ("date" "{") + ("thanks" "{") ("address" "{") ("caption" "[{") + ("textsuperscript" "{") ("textsubscript" "{") ("verb" "*")) + font-lock-type-face 2 command) + ("bold-command" + (("textbf" "{") ("textsc" "{") ("textssc" "{") ("textulc" "{") + ("textup" "{") ("textsw" "{") ("boldsymbol" "{") ("pmb" "{") + ("mathbf" "{")) + font-latex-bold-face 1 command) + ("italic-command" + (("emph" "{") ("textit" "{") ("textsl" "{") ("mathit" "{")) + font-latex-italic-face 1 command) + ("math-command" + (("ensuremath" "|{\\")) + font-latex-math-face 1 command) + ("type-command" + (("texttt" "{") ("textsf" "{") ("textrm" "{") ("textmd" "{") + ("textnormal" "{") ("oldstylenums" "{") ("legacyoldstylenums" "{") + ("mathrm" "{") ("mathsf" "{") ("mathtt" "{")) + font-lock-type-face 1 command) + ("bold-declaration" + ("bf" "bfseries" "sc" "scshape" "sscshape" "ulcshape" "upshape" "swshape") + font-latex-bold-face 1 declaration) + ("italic-declaration" + ("em" "it" "itshape" "sl" "slshape") + font-latex-italic-face 1 declaration) + ("type-declaration" + ("tt" "ttfamily" "sf" "sffamily" "rm" "rmfamily" "mdseries" + "tiny" "scriptsize" "footnotesize" "small" "normalsize" + "large" "Large" "LARGE" "huge" "Huge") + font-lock-type-face 1 declaration)) + "Built-in keywords and specifications for font locking. + +The first element of each item is the name of the keyword class. + +The second element is a list of keywords (macros without an +escape character) to highlight or, if the fifth element is the +symbol `command', a list of lists where the first element of each +item is a keyword and the second a string specifying the macro +syntax. It can contain \"*\" if the macro has a starred variant, +\"[\" for an optional argument, \"{\" for a mandatory argument, +and \"\\\" for a macro. A \"|\" means the following two tokens +should be regarded as alternatives. + +The third element is the symbol of a face to be used or a Lisp +form returning a face symbol. + +The fourth element is the fontification level. + +The fifth element is the type of construct to be matched. It can +be one of `noarg' which will match simple macros without +arguments (like \"\\foo\"), `declaration' which will match macros +inside a TeX group (like \"{\\bfseries foo}\"), or `command' which +will match macros of the form \"\\foo[bar]{baz}\".")) + +(defcustom font-latex-deactivated-keyword-classes nil + "List of strings for built-in keyword classes to be deactivated. + +Valid entries are \"warning\", \"variable\", \"biblatexnoarg\", +\"biblatex\", \"reference\", \"function\" , \"sectioning-0\", +\"sectioning-1\", \"sectioning-2\", \"sectioning-3\", +\"sectioning-4\", \"sectioning-5\", \"slide-title\", \"textual\", +\"bold-command\", \"italic-command\", \"math-command\", +\"type-command\", \"bold-declaration\", \"italic-declaration\", +\"type-declaration\". + +You have to restart Emacs for a change of this variable to take effect." + :group 'font-latex-keywords + :type `(set ,@(mapcar + (lambda (spec) + `(const :tag ,(concat + ;; Name of the keyword class + (let ((name (split-string (car spec) "-"))) + (setcar name (capitalize (car name))) + (mapconcat #'identity name " ")) + " keywords in `" + ;; Name of the face + (symbol-name + (let ((face (nth 2 spec))) + (if (symbolp face) face (eval face t)))) + "'.\n" + ;; List of keywords + (with-temp-buffer + (insert " Keywords: " + (mapconcat (lambda (x) + (if (listp x) + (car x) + x)) + (nth 1 spec) ", ")) + (fill-paragraph nil) + (buffer-string))) + ,(car spec))) + font-latex-built-in-keyword-classes))) + +(eval-and-compile +(defun font-latex--make-match-defun (prefix name face type) + "Return a function definition for keyword matching. +The variable holding the keywords to match are determined by the +strings PREFIX and NAME. The type of matcher is determined by +the symbol TYPE. + +This is a helper function for `font-latex-make-built-in-keywords' +and `font-latex-make-user-keywords' and not intended for general +use." + ;; FIXME: Is the cond-clause possible inside of the defun? + + ;; In an earlier version of font-latex the type could be a list like + ;; (command 1). This indicated a macro with one argument. Provide + ;; a match function in this case but don't actually support it. + (cond ((or (eq type 'command) (listp type)) + `(defun ,(intern (concat prefix name)) (limit) + ,(concat "Fontify `" prefix name "' up to LIMIT. + +Generated by `font-latex--make-match-defun'.") + (when ,(intern (concat prefix name)) + (font-latex-match-command-with-arguments + ,(intern (concat prefix name)) + (append + (when (boundp ',(intern (concat prefix name + "-keywords-local"))) + ,(intern (concat prefix name "-keywords-local"))) + ,(intern (concat prefix name "-keywords"))) + ;; `face' can be a face symbol, a form returning + ;; a face symbol, or a list of face attributes. + ,(if (and (listp face) (fboundp (car face))) + face + `',face) + limit)))) + ((eq type 'declaration) + `(defun ,(intern (concat prefix name)) (limit) + ,(concat "Fontify `" prefix name "' up to LIMIT. + +Generated by `font-latex--make-match-defun'.") + (when ,(intern (concat prefix name)) + (font-latex-match-command-in-braces + ,(intern (concat prefix name)) limit)))) + ((eq type 'noarg) + `(defun ,(intern (concat prefix name)) (limit) + ,(concat "Fontify `" prefix name "' up to LIMIT. + +Generated by `font-latex--make-match-defun'.") + (when ,(intern (concat prefix name)) + (re-search-forward + ,(intern (concat prefix name)) limit t)))))) + +(defun font-latex-keyword-matcher (prefix name face type) + "Return a matcher and highlighter as required by `font-lock-keywords'. +PREFIX and NAME are strings which are concatenated to form the +respective match function. FACE is a face name or a list of face +attributes that will be applied to the respective part of the +match returned by the match function. A lisp form returning a +face name or a list of face attributes is also valid for FACE. +TYPE is the type of construct to be highlighted. Currently the +symbols `command', `declaration' and `noarg' are valid. + +This is a helper function for `font-latex-make-built-in-keywords' +and `font-latex-make-user-keywords' and not intended for general +use." + ;; Quote a list of face attributes and a face symbol + ;; but do not quote a form returning such value. + (unless (and (listp face) (fboundp (car face))) + (setq face `',face)) + + ;; In an earlier version of font-latex the type could be a list like + ;; (command 1). This indicated a macro with one argument. Provide + ;; a matcher in this case but don't actually support it. + (cond ((or (eq type 'command) (listp type)) + `(,(intern (concat prefix name)) + (0 (font-latex-matched-face 0) append t) + (1 (font-latex-matched-face 1) append t) + (2 (font-latex-matched-face 2) append t) + (3 (font-latex-matched-face 3) append t) + (4 (font-latex-matched-face 4) append t) + (5 (font-latex-matched-face 5) append t) + (6 (font-latex-matched-face 6) append t) + (7 (font-latex-matched-face 7) append t) + (8 (font-latex-matched-face 8) append t) + (9 (font-latex-matched-face 9) append t) + (10 (font-latex-matched-face 10) append t) + (11 (font-latex-matched-face 11) append t))) + ((eq type 'noarg) + `(,(intern (concat prefix name)) + (0 ,face))) + ((eq type 'declaration) + `(,(intern (concat prefix name)) + (0 'font-latex-warning-face t t) + (1 'font-lock-keyword-face append t) + (2 ,face append t)))))) + +(defmacro font-latex-make-built-in-keywords () + "Build defuns, defvars and defcustoms for built-in keyword fontification." + (let ((flks '()) + (defs '())) + (dolist (item font-latex-built-in-keyword-classes) + (let ((prefix "font-latex-match-") + (name (nth 0 item)) + (keywords (nth 1 item)) + (face (nth 2 item)) + (level (nth 3 item)) + (type (nth 4 item))) + + ;; defvar font-latex-match-*-keywords-local + (push `(defvar-local ,(intern (concat prefix name "-keywords-local")) + ',keywords + ,(concat "Buffer-local keywords to add to `" + prefix name "-keywords'.\n\n" + (if (eq type 'command) + "\ +This must be a list where each element is a list consisting of a +keyword string \(not a regular expression\) omitting the leading +backslash and a format specifier as described in the doc string of +`font-latex-user-keyword-classes'." + "\ +This must be a list where each element is a keyword string \(not a +regular expression\) omitting the leading backslash.") + + "\n\n\ +This is an internal variable which should not be set directly. +Use `font-latex-add-keywords' instead. + +Generated by `font-latex-make-built-in-keywords'.")) + defs) + + ;; defvar font-latex-match-* + ;; We make this variable buffer local later, but don't use + ;; `defvar-local' here because it shouldn't have nil as its + ;; default value. Its true default value is set by + ;; through font-latex-match-*-make in :set specification of + ;; defcustom of font-latex-match-*-keywords below. It's + ;; only after that this variable can be buffer local. + (push `(defvar ,(intern (concat prefix name)) nil + ,(concat "Regular expression to match " name + " keywords. + +Generated by `font-latex-make-built-in-keywords'")) + defs) + + ;; This defvar (without value) is here just to suppress compiler + ;; warnings. Its true definition is done by defcustom following + ;; the next defun because its :set function depends on the + ;; function defined by that defun. + (push `(defvar ,(intern (concat prefix name "-keywords"))) + defs) + + ;; defun font-latex-match-*-make + (push `(defun ,(intern (concat prefix name "-make")) () + ,(concat "Make or remake the variable `" prefix name "'. + +Generated by `font-latex-make-built-in-keywords'.") + (let ((keywords + (append + (unless (member ,name + font-latex-deactivated-keyword-classes) + ,(intern (concat prefix name "-keywords-local"))) + ,(intern (concat prefix name "-keywords")))) + multi-char-macros single-char-macros) + (dolist (elt keywords) + (let ((keyword (if (listp elt) (car elt) elt))) + (if (string-match "^[A-Za-z]" keyword) + (push keyword multi-char-macros) + (push keyword single-char-macros)))) + (when (or multi-char-macros single-char-macros) + (setq ,(intern (concat prefix name)) + (concat + "\\\\\\(" + (when multi-char-macros + (concat + "\\(?:" (regexp-opt multi-char-macros) "\\)\\>")) + (when single-char-macros + (concat + (when multi-char-macros "\\|") + "\\(?:" (regexp-opt single-char-macros) "\\)")) + "\\)"))))) + defs) + + ;; defcustom font-latex-match-*-keywords + (push `(defcustom ,(intern (concat prefix name "-keywords")) nil + ,(concat "List of keywords " + (when (eq type 'command) "and formats ") + "for " name " face.\n" + (if (eq type 'command) + "\ +Each element has to be a list consisting of the name of a macro +omitting the leading backslash and a format specifier as +described in the doc string of `font-latex-user-keyword-classes'." + "\ +Each element has to be the name of a macro as a string, omitting +the leading backslash.") + "\n\n\ +Setting this variable directly does not take effect; restart +Emacs. + +Generated by `font-latex-make-built-in-keywords'.") + :type '(repeat ,(if (eq type 'command) + '(list (string :tag "Keyword") + (string :tag "Format")) + '(string :tag "Keyword"))) + :set (lambda (symbol value) + (set-default symbol value) + (funcall ',(intern (concat prefix name "-make")))) + :group 'font-latex-keywords) + defs) + + ;; Now that font-latex-match-* has attained proper default + ;; value, make it buffer local. + (push `(make-variable-buffer-local ',(intern (concat prefix name))) + defs) + + ;; defun font-latex-match-* + (push (font-latex--make-match-defun prefix name face type) defs) + + ;; Add matchers and highlighters to `font-latex-keywords-{1,2}'. + (let ((keywords-entry (font-latex-keyword-matcher + prefix name face type))) + (push (cons level keywords-entry) flks)))) + `(progn + ,@(nreverse defs) + (defvar font-latex-keywords-1 + ',(nreverse (delq nil (mapcar (lambda (x) (if (eq 1 (car x)) (cdr x))) + flks))) + "Subdued level highlighting for LaTeX modes.") + (defvar font-latex-keywords-2 + ',(nreverse (mapcar #'cdr flks)) + "High level highlighting for LaTeX modes.")))) + +(font-latex-make-built-in-keywords) + +(defcustom font-latex-user-keyword-classes nil + "List of user-defined keyword classes for font locking. + +Every keyword class consists of four parts, a name, a list of +keywords, a face and a specifier for the type of macro to be +highlighted. + +When adding new entries, you have to use unique values for the +class names, that is, they must not clash with names of the +built-in keyword classes or other names given by you. +Additionally the names must not contain spaces. + +The list of keywords defines which commands and declarations +should be covered by the keyword class. A keyword can either be +a simple command name omitting the leading backslash or a list +consisting of the command name and a string specifying the syntax +of the command. The latter is useful if you want to match LaTeX +macros with arguments (see below). You can specify the occurence +and order of optional (\"[\") and mandatory (\"{\") arguments for +each keyword. For example for \"documentclass\" you'd use \"[{\" +because the macro has one optional followed by one mandatory +argument. Optionally starred macros can be indicated with \"*\". +In case an argument is an unbraced macro, use \"\\\". You can +also specify two alternative arguments by prefixing them with +\"|\". As an example, the specifier for \\newcommand is +\"*|{\\=\\[[{\". + +The face argument can either be an existing face or a face +attribute. + +There are three alternatives for the class type: + +A value of `command' indicates commands with arguments +\(\"\\foo[bar]{baz}\"). The mandatory arguments in curly braces +will get the face you specified. + +A value of `declaration' indicates declarations inside of TeX +groups (\"{\\foo bar}\"). The content inside the braces, +excluding the command, will get the face you specified. In case +the braces are missing, the face will be applied to the command +itself. + +A value of `noarg' indicates commands without arguments +\(\"\\foo\"). The command itself will get the face you +specified. + +Setting this variable directly does not take effect; +restart Emacs." + :group 'font-latex-keywords + :type '(repeat (list (string :tag "Name") + (choice (repeat :tag "Keywords" (string :tag "Keyword")) + (repeat + :tag "Keywords with specs" + (group (string :tag "Keyword") + (string :tag "Format specifier")))) + (choice (face :tag "Face name") + (custom-face-edit :tag "Face attributes")) + (choice :tag "Type" + ;; Maps to + ;;`font-latex-match-command-with-arguments' + (const :tag "Command with arguments" + command) + ;; Maps to + ;;`font-latex-match-command-in-braces' + (const :tag "Declaration inside TeX group" + declaration) + ;; Maps to `re-search-forward' + (const :tag "Command without arguments" + noarg)))) + :set (lambda (symbol value) + (dolist (item value) + (when (string-match " " (car item)) + (error "No spaces allowed in name"))) + (let (names names-uniq) + (dolist (item (append font-latex-built-in-keyword-classes value)) + (setq names (append names (list (car item))))) + (setq names (TeX-sort-strings names)) + (setq names-uniq (TeX-delete-duplicate-strings names)) + (dotimes (i (safe-length names-uniq)) + (unless (string= (nth i names) (nth i names-uniq)) + (error "Name %S already exists" (nth i names))))) + (set-default symbol value) + (let ((prefix "font-latex-match-")) + (dolist (elt value) + (unless (boundp (intern (concat prefix (car elt)))) + ;; defvar font-latex-match-* + (eval `(defvar ,(intern (concat prefix (car elt))) nil + ,(concat "Regular expression to match " (car elt) + " keywords. + +Generated by `font-latex-user-keyword-classes'")))) + (let ((keywords (nth 1 elt)) + single-char-macro-flag) + (setq keywords (if (listp (car keywords)) + (mapcar #'car keywords) + keywords)) + (catch 'single-char + (dolist (keyword keywords) + (unless (string-match "^[A-Za-z]" keyword) + (setq single-char-macro-flag t) + (throw 'single-char nil)))) + (set (intern (concat prefix (car elt))) + (when (> (safe-length keywords) 0) + (concat "\\\\" (let ((max-specpdl-size 1000)) + (regexp-opt keywords t)) + (unless single-char-macro-flag "\\>"))))))))) + +(defun font-latex-make-user-keywords () + "Build defuns and defvars for user keyword fontification." + (let ((keyword-specs font-latex-user-keyword-classes)) + (dolist (item keyword-specs) + (let ((prefix "font-latex-match-") + (name (nth 0 item)) + (keywords (nth 1 item)) + (face (nth 2 item)) + (type (nth 3 item))) + + ;; defvar font-latex-match-*-keywords + (eval `(defvar ,(intern (concat prefix name "-keywords")) ',keywords + ,(concat "Font-latex keywords for " name " face. + +Generated by `font-latex-make-user-keywords'."))) + + ;; defun font-latex-match-* + (eval (font-latex--make-match-defun prefix name face type) t) + + ;; Add the matcher to `font-latex-keywords-2'. + (add-to-list 'font-latex-keywords-2 + (font-latex-keyword-matcher prefix name face type) t)))) + + ;; Add the "fixed" matchers and highlighters. + (dolist (item + '(("\\(^\\|[^\\]\\)\\(&+\\)" 2 'font-latex-warning-face) + (font-latex-match-dollar-math 0 'font-latex-math-face keep) + (font-latex-match-quotation + (0 'font-latex-string-face append) + (1 'font-latex-warning-face)) + ;; Hack to remove the verbatim face from the \ in + ;; \end{verbatim} and similar. The same hack is used in + ;; tex-mode.el. + ("\\(\\\\\\)end" + (1 (get-text-property (match-end 1) 'face) t)))) + (add-to-list 'font-latex-keywords-1 item) + (add-to-list 'font-latex-keywords-2 item)) + (dolist (item + '((font-latex-match-math-env + (0 'font-latex-warning-face t t) + (1 'font-latex-math-face append t)) + (font-latex-match-math-envII + (1 'font-latex-math-face append t)) + (font-latex-match-simple-command + (0 'font-latex-sedate-face append)) + (font-latex-match-script + (1 (font-latex-script (match-beginning 0)) append)) + (font-latex-match-script-chars + (1 (font-latex-script-char (match-beginning 1)) prepend)))) + (add-to-list 'font-latex-keywords-2 item t))) +(font-latex-make-user-keywords) + +(defun font-latex-add-keywords (keywords class) + "Add KEYWORDS to CLASS. +KEYWORDS is a list of keywords or keywords with syntax specs. +CLASS corresponds to a keyword class and can be one of the +symbols `warning', `variable', `reference', `biblatexnoarg', +`biblatex', `function', `sectioning-0', `sectioning-1', +`sectioning-2', `sectioning-3', `sectioning-4', `sectioning-5', +`slide-title', `textual', `bold-command', `italic-command', +`math-command', `type-command', `bold-declaration', +`italic-declaration' or `type-declaration'. + +The keywords will be added to the buffer-local list of keywords +of the respective keyword class and necessary updates of the font +locking machinery will be triggered." + (let* ((class (symbol-name class)) + (list (intern (format "font-latex-match-%s-keywords-local" class)))) + (dolist (elt keywords) + (add-to-list list elt)) + (funcall (intern (format "font-latex-match-%s-make" class))) + ;; Trigger refontification. + (when (fboundp 'font-lock-flush) + (font-lock-flush)))) + +(defvar font-latex-keywords font-latex-keywords-1 + "Default expressions to highlight in TeX mode.") + + +;;; Subscript and superscript + +(defcustom font-latex-fontify-script t + "If non-nil, fontify subscript and superscript strings. + +By default, super/subscripts are raised/lowered if this variable +is non-nil. This fontification only affects one level of +scripts, for example in x^{y^z}, the y and the z have the same +size and are equally raised over x. + +If this variable is set to the symbol `multi-level', then y is +raised above x, and z is raised above y. With many script +levels, the text might become too small to be readable, thus +there is the option `font-latex-fontify-script-max-level'. (The +factors for text shrinking are defined in the faces +`font-latex-superscript-face' and `font-latex-subscript-face' and +the raise/lower factor in `font-latex-script-display'.) + +If this variable is set to the symbol `invisible', then the +effect is essentially like `multi-level' but additionally the +script operators ^ and _ are not displayed." + :type '(choice (boolean :tag "Enabled") + (const :tag "Multiple levels" multi-level) + (const :tag "Hide ^ and _" invisible)) + :group 'font-latex) +(put 'font-latex-fontify-script 'safe-local-variable + (lambda (val) + (or (booleanp val) + (memq val '(multi-level invisible))))) + +(defcustom font-latex-fontify-script-max-level 3 + "Maximum scriptification level for which script faces are applied. +The faces `font-latex-superscript-face' and +`font-latex-subscript-face' define custom :height values < 1.0. +Therefore, scripts are displayed with a slightly smaller font +than normal math text. If `font-latex-fontify-script' is +`multi-level' or `invisible', the font size becomes too small to +be readable after a few levels. This option allows to specify +the maximum level after which the size of the script text won't +be shrunken anymore. + +For example, see this expression: + + \\( x^{y^{z^a_b}} \\) + +x has scriptification level 0, y has level 1, z has level 2, and +both a and b have scriptification level 3. + +If `font-latex-fontify-script-max-level' was 2, then z, a, and b +would have the same font size. If it was 3 or more, then a and b +were smaller than z just in the same way as z is smaller than y +and y is smaller than x." + :group 'font-latex + :type 'integer) + +(defcustom font-latex-script-display '((raise -0.5) . (raise 0.5)) + "Display specification for subscript and superscript content. +The car is used for subscript, the cdr is used for superscripts." + :group 'font-latex + :type '(cons (choice (sexp :tag "Subscript form") + (const :tag "No lowering" nil)) + (choice (sexp :tag "Superscript form") + (const :tag "No raising" nil)))) + + +;;; Syntactic keywords + +(defvar font-latex-syntactic-keywords nil + "Syntactic keywords used by `font-latex'.") +(make-variable-buffer-local 'font-latex-syntactic-keywords) + +(defvar font-latex-syntactic-keywords-extra nil + "List of syntactic keywords to add to `font-latex-syntactic-keywords'. +The form should be the same as in `font-lock-syntactic-keywords'.") +(make-variable-buffer-local 'font-latex-syntactic-keywords-extra) + +;; Set and updated in `font-latex-set-syntactic-keywords'. +(defvar font-latex-doctex-syntactic-keywords nil) + +(defun font-latex-set-syntactic-keywords () + "Set the variable `font-latex-syntactic-keywords'. +This function can be used to refresh the variable in case other +variables influencing its value, like `LaTeX-verbatim-environments', +have changed." + ;; Checks for non-emptiness of lists added in order to cater for + ;; installations where `(regexp-opt-group nil)' would enter a loop. + (let ((verb-envs (and (fboundp 'LaTeX-verbatim-environments) + (LaTeX-verbatim-environments))) + (verb-macros-with-delims + (and (fboundp 'LaTeX-verbatim-macros-with-delims) + (LaTeX-verbatim-macros-with-delims))) + (verb-macros-with-braces + (and (fboundp 'LaTeX-verbatim-macros-with-braces) + (LaTeX-verbatim-macros-with-braces)))) + (setq verb-envs (and verb-envs (regexp-opt verb-envs)) + verb-macros-with-delims (and verb-macros-with-delims + (regexp-opt verb-macros-with-delims)) + verb-macros-with-braces (and verb-macros-with-braces + (regexp-opt verb-macros-with-braces)) + font-latex-syntactic-keywords nil) + (unless (= (length verb-envs) 0) + (add-to-list + 'font-latex-syntactic-keywords + `(,(concat + "^[ \t]*\\\\begin *{\\(?:" verb-envs "\\)}" + ;; Some environments accept an optional and/or mandatory + ;; argument that can span over more lines. Between + ;; "\begin{<envname>}" and the optional argument there can + ;; be whitespaces and the newline can be commented by a "%" + ;; character. + "[ \t]*\\(?:%.*\n[ \t]*\\)?" + ;; The following line of the regexp matches the optional + ;; argument and allows for up to one level of brackets + ;; inside the argument (e.g., the dialect of a language in + ;; the `lstlisting' environment by the `listings' package). + "\\(?:\\[[^][]*\\(?:\\[[^][]*\\][^][]*\\)*\\]\\)?" + ;; After the optional argument, there may also be another + ;; mandatory argument(s) (e.g. with VerbatimOut or the + ;; minted envs or defined with `lstnewenvironment'). Use + ;; the same trick as above in order to allow one level of + ;; braces in the argument. + "\\(?:{[^{}]*\\(?:{[^{}]*}[^{}]*\\)*}\\)*" + ;; Now match the final newline. The "." alternative + ;; catches the case where verbatim content is written + ;; immediately after the \begin{verbatim}. + "\\(\n\\|.\\)") + (1 "|" t))) + (add-to-list + 'font-latex-syntactic-keywords + ;; Using the newline character for the syntax property often + ;; resulted in fontification problems when text was inserted at + ;; the end of the verbatim environment. That's why we now use + ;; the starting backslash of \end. There is a hack in + ;; `font-latex-make-user-keywords' to remove the spurious + ;; fontification of the backslash. + `(,(concat "\\(\\\\\\)end *{\\(?:" verb-envs "\\)}") + (1 "|" t)))) + (unless (= (length verb-macros-with-delims) 0) + (add-to-list + 'font-latex-syntactic-keywords + `(,(concat "\\\\\\(?:" verb-macros-with-delims "\\)" + ;; Some macros take an optional argument. This is + ;; the same line as above for environments. + "\\(?:\\[[^][]*\\(?:\\[[^][]*\\][^][]*\\)*\\]\\)?" + ;; An opening curly brace as delimiter is valid, but + ;; allowing it might screw up fontification of stuff + ;; like "\url{...} foo \textbf{<--!...}". + "\\([^a-z@*\n\f{]\\).*?" + ;; Give an escape char at the end of the verbatim + ;; construct punctuation syntax. Prevents wrong + ;; fontification of stuff like "\verb|foo\|". + "\\(" (regexp-quote TeX-esc) "*\\)\\(\\1\\)") + (1 "\"") (2 ".") (3 "\"")))) + (unless (= (length verb-macros-with-braces) 0) + (add-to-list + 'font-latex-syntactic-keywords + `(,(concat "\\\\\\(?:" verb-macros-with-braces "\\)" + ;; Some macros take an optional argument. This is + ;; the same line as above for environments. + "\\(?:\\[[^][]*\\(?:\\[[^][]*\\][^][]*\\)*\\]\\)?" + "\\({\\).*?[^\\]\\(?:\\\\\\\\\\)*\\(}\\)") + (1 "|") (2 "|"))))) + (when font-latex-syntactic-keywords-extra + (nconc font-latex-syntactic-keywords font-latex-syntactic-keywords-extra)) + ;; ;; Cater for docTeX mode. + ;; (setq font-latex-doctex-syntactic-keywords + ;; (append font-latex-syntactic-keywords + ;; ;; For docTeX comment-in-doc. + ;; '(("\\(\\^\\)\\^A" (1 (font-latex-doctex-^^A)))))) + ;; Finally, compute our `syntax-propertize-function' anew. + (setq-local syntax-propertize-function + (font-latex--make-syntax-propertize-function))) + + +;;; Syntactic fontification + +(defun font-latex-syntactic-face-function (state) + (if (nth 3 state) + 'font-latex-verbatim-face + 'font-lock-comment-face)) + +;;; Faces + +(defface font-latex-bold-face + (let ((font '(:inherit bold))) + `((((class grayscale) (background light)) + (:foreground "DimGray" ,@font)) + (((class grayscale) (background dark)) + (:foreground "LightGray" ,@font)) + (((class color) (background light)) + (:foreground "DarkOliveGreen" ,@font)) + (((class color) (background dark)) + (:foreground "OliveDrab" ,@font)) + (t (,@font)))) + "Face used to highlight text to be typeset in bold." + :group 'font-latex-highlighting-faces) + +(defface font-latex-italic-face + (let ((font '(:inherit italic))) + `((((class grayscale) (background light)) + (:foreground "DimGray" ,@font)) + (((class grayscale) (background dark)) + (:foreground "LightGray" ,@font)) + (((class color) (background light)) + (:foreground "DarkOliveGreen" ,@font)) + (((class color) (background dark)) + (:foreground "OliveDrab" ,@font)) + (t (,@font)))) + "Face used to highlight text to be typeset in italic." + :group 'font-latex-highlighting-faces) + +(defface font-latex-math-face + (let ((font '(:inherit underline))) + `((((class grayscale) (background light)) + (:foreground "DimGray" ,@font)) + (((class grayscale) (background dark)) + (:foreground "LightGray" ,@font)) + (((class color) (background light)) + (:foreground "SaddleBrown")) + (((class color) (background dark)) + (:foreground "burlywood")) + (t (,@font)))) + "Face used to highlight math." + :group 'font-latex-highlighting-faces) + +(defface font-latex-sedate-face + '((((class grayscale) (background light)) (:foreground "DimGray")) + (((class grayscale) (background dark)) (:foreground "LightGray")) + (((class color) (background light)) (:foreground "DimGray")) + (((class color) (background dark)) (:foreground "LightGray")) + ;;;(t (:underline t)) + ) + "Face used to highlight sedate stuff." + :group 'font-latex-highlighting-faces) + +(defface font-latex-string-face + (let ((font '(:inherit italic))) + `((((type tty) (class color)) + (:foreground "green")) + (((class grayscale) (background light)) + (:foreground "DimGray" ,@font)) + (((class grayscale) (background dark)) + (:foreground "LightGray" ,@font)) + (((class color) (background light)) + (:foreground "RosyBrown")) + (((class color) (background dark)) + (:foreground "LightSalmon")) + (t (,@font)))) + "Face used to highlight strings." + :group 'font-latex-highlighting-faces) + +(defface font-latex-warning-face + (let ((font '(:inherit bold))) + `((((class grayscale)(background light)) + (:foreground "DimGray" ,@font)) + (((class grayscale)(background dark)) + (:foreground "LightGray" ,@font)) + (((class color)(background light)) + (:foreground "red" ,@font)) + (((class color)(background dark)) + (:foreground "red" ,@font)) + (t (,@font)))) + "Face for important keywords." + :group 'font-latex-highlighting-faces) + +(defface font-latex-verbatim-face + (let ((font '(:inherit fixed-pitch))) + `((((class grayscale) (background light)) + (:foreground "DimGray" ,@font)) + (((class grayscale) (background dark)) + (:foreground "LightGray" ,@font)) + (((class color) (background light)) + (:foreground "SaddleBrown" ,@font)) + (((class color) (background dark)) + (:foreground "burlywood" ,@font)) + (t (,@font)))) + "Face used to highlight TeX verbatim environments." + :group 'font-latex-highlighting-faces) + +(defface font-latex-superscript-face + '((t (:height 0.85))) + "Face used for superscripts." + :group 'font-latex-highlighting-faces) + +(defface font-latex-subscript-face + '((t (:height 0.85))) + "Face used for subscripts." + :group 'font-latex-highlighting-faces) + +(defface font-latex-script-char-face + (let ((font '(:inherit underline))) + `((((class grayscale) (background light)) + (:foreground "DarkGray" ,@font)) + (((class grayscale) (background dark)) + (:foreground "gray" ,@font)) + (((class color) (background light)) + (:foreground "salmon")) + (((class color) (background dark)) + (:foreground "DarkRed")) + (t (,@font)))) + "Face used for the script chars ^ and _." + :group 'font-latex-highlighting-faces) + +(defface font-latex-slide-title-face + '((t (:inherit (variable-pitch font-lock-type-face) + :weight bold :height 1.2))) + "Face for slide titles." + :group 'font-latex-highlighting-faces) + +;;; Setup + +(defvar font-latex-syntax-alist + ;; Use word syntax for @ because we use \> for matching macros and + ;; we don't want \foo@bar to be found if we search for \foo. + '((?\( . ".") (?\) . ".") (?@ . "w")) + "List of specifiers for the syntax alist of `font-lock-defaults'.") + +(defun font-latex-add-to-syntax-alist (list) + "Activate syntactic font locking for the entries in LIST. +The entries are added to `font-latex-syntax-alist' and eventually +end up in `font-lock-defaults'. Each entry in LIST should be a +cons pair as expected by `font-lock-defaults'. The function also +triggers Font Lock to recognize the change." + (set (make-local-variable 'font-latex-syntax-alist) + (append font-latex-syntax-alist list)) + ;; We modify the `font-lock-syntax-table' directly but also call + ;; `font-latex-setup' in order to have `font-lock-defaults' be in sync. + (font-latex-setup) + (dolist (elt list) + (modify-syntax-entry (car elt) (cdr elt) font-lock-syntax-table)) + ;; Trigger refontification. + (when (fboundp 'font-lock-flush) + (font-lock-flush))) + +(defun font-latex--make-syntax-propertize-function () + "Return a `syntax-propertize-function' for (La|Doc)TeX documents." + (let ((kws ;; (if (derived-mode-p 'doctex-mode) + ;; font-latex-doctex-syntactic-keywords + font-latex-syntactic-keywords)) ;; ) + (syntax-propertize-via-font-lock kws))) + +;;;###autoload +(defun font-latex-setup () + "Setup this buffer for LaTeX font-lock. Usually called from a hook." + (font-latex-set-syntactic-keywords) + + ;; Activate multi-line fontification facilities. + (set (make-local-variable 'font-lock-multiline) t) + + ;; The test for `major-mode' currently only works with docTeX mode + ;; because `TeX-install-font-lock' is called explicitly in + ;; `doctex-mode'. In case other modes have to be distinguished as + ;; well, remove the call to `TeX-install-font-lock' from + ;; `VirTeX-common-initialization' and place it in the different + ;; `xxx-mode' calls instead, but _after_ `major-mode' is set. + (let ((defaults + `((font-latex-keywords font-latex-keywords-1 font-latex-keywords-2) + nil nil ,font-latex-syntax-alist nil)) + (variables + '((font-lock-mark-block-function . mark-paragraph) + (font-lock-fontify-region-function + . font-latex-fontify-region) + (font-lock-unfontify-region-function + . font-latex-unfontify-region) + (font-lock-extend-region-functions + font-lock-extend-region-wholelines + font-lock-extend-region-multiline + font-latex-extend-region-backwards-command-with-args + font-latex-extend-region-backwards-command-in-braces + font-latex-extend-region-backwards-quotation + font-latex-extend-region-backwards-math) + (syntax-propertize-extend-region-functions + syntax-propertize-wholelines + font-latex-sp-extend-region-backwards-verb-env)))) + ;; Add the mode-dependent stuff to the basic variables defined above. + (if (eq major-mode 'doctex-mode) + (progn + (setcar defaults (append (car defaults) + '(font-latex-doctex-keywords))) + (setq variables + (append variables + '((font-lock-syntactic-face-function + . font-latex-doctex-syntactic-face-function))))) + (setq variables + (append variables + '((font-lock-syntactic-face-function + . font-latex-syntactic-face-function))))) + ;; Set the defaults. + (setq font-lock-defaults (append defaults variables))) + + ;; Make sure fontification will be refreshed if a user sets variables + ;; influencing fontification in her file-local variables section. + (add-hook 'hack-local-variables-hook #'font-latex-after-hacking-local-variables t t)) + +(defun font-latex-update-font-lock (&optional _syntactic-kws) + "Tell font-lock about updates of fontification rules. +If SYNTACTIC-KWS is non-nil, also update +`font-latex-syntactic-keywords'." + (display-warning + 'auctex + (concat "`font-latex-update-font-lock' should not be called. +It is obsolete and going to be removed. +If you have called `font-latex-add-keywords' and want to refresh fontification, +call `font-lock-flush' instead. +If you changed syntactic fontification, for example, one of the variables +- `LaTeX-verbatim-macros-with-delims' +- `LaTeX-verbatim-macros-with-delims-local' +- `LaTeX-verbatim-macros-with-braces' +- `LaTeX-verbatim-macros-with-braces-local' +- `LaTeX-verbatim-environments' +- `LaTeX-verbatim-environments-local' +- `font-latex-syntactic-keywords-extra' +then call `font-latex-set-syntactic-keywords'."))) + +(make-obsolete 'font-latex-update-font-lock nil "12.2.4") + +(defvar font-latex--updated-region-end nil +;; During font lock operation, matched range sometimes exceeds the +;; given end limit. So record the actual end in this variable to +;; notify the font lock machinery. +;; Match functions should do the following two if the end of the +;; actual match goes beyond the limit: +;; 1. If the value of this variable is smaller than limit, set this +;; variable to that limit. +;; 2. When the end of the actual match exceeds this variable, +;; - apply `font-lock-unfontify-region' between the value of this +;; variable and the end of the actual match +;; - update this variable to the end of the actual match +;; See implementation of `font-latex-match-math-env' for actual usage. + "Record the end of fontification.") +(defun font-latex-fontify-region (beg end &optional verbose) + "Fontify region from BEG to END. +Take care when the actually fonfified region was extended beyond END." + (setq font-latex--updated-region-end end) + (let ((res (font-lock-default-fontify-region beg end verbose))) + ;; COMPATIBILITY for older emacsen. Return value for jit-lock + ;; is meaningful for only newer emacsen. + (if (eq (car-safe res) 'jit-lock-bounds) + `(jit-lock-bounds ,(cadr res) . + ,(max (cddr res) font-latex--updated-region-end))))) + +;; Copy and adaption of `tex-font-lock-unfontify-region' from +;; tex-mode.el in GNU Emacs on 2004-08-04. +;; (XEmacs passes a third argument to the function.) +(defun font-latex-unfontify-region (beg end &rest _ignored) + "Unfontify region from BEG to END." + (font-lock-default-unfontify-region beg end) + (remove-list-of-text-properties beg end '(script-level invisible)) + (while (< beg end) + (let ((next (next-single-property-change beg 'display nil end)) + (prop (get-text-property beg 'display))) + (if (and (eq (car-safe prop) 'raise) + (null (cddr prop))) + (put-text-property beg next 'display nil)) + (setq beg next)))) + +(defun font-latex-after-hacking-local-variables () + "Refresh fontification if required by updates of file-local variables. +This function is added to `hack-local-variables-hook' and +recomputes fontification if variables affecting fontification are +modified. Such variables include +`LaTeX-verbatim-environments-local', +`LaTeX-verbatim-macros-with-braces-local', +`LaTeX-verbatim-macros-with-delims-local'." + (when + ;; In Emacs we know if the value came from file or directory + ;; locals. Note to self: directory-local variables are also added + ;; to file-local-variables-alist. + (let ((hacked-local-vars (mapcar #'car file-local-variables-alist))) + (or (memq 'LaTeX-verbatim-environments-local hacked-local-vars) + (memq 'LaTeX-verbatim-macros-with-braces-local hacked-local-vars) + (memq 'LaTeX-verbatim-macros-with-delims-local hacked-local-vars))) + ;; Ok, we need to refresh syntactic fontification. + (font-latex-set-syntactic-keywords))) + +;;; Utility functions + +(defun font-latex-find-matching-close (openchar closechar) + "Skip over matching pairs of OPENCHAR and CLOSECHAR. +OPENCHAR is the opening character and CLOSECHAR is the closing +character. Character pairs are usually { } or [ ]. Comments are +ignored during the search." + (let ((parse-sexp-ignore-comments + (not (eq major-mode 'doctex-mode))) ; scan-sexps ignores comments + (init-point (point)) + (mycount 1) + (esc-char (or (and (boundp 'TeX-esc) TeX-esc) "\\")) + ;; XXX: Do not look up syntax-table properties since they may + ;; be misleading, e.g. in the case of "{foo}^^A" where the + ;; closing brace gets a comment end syntax. + (parse-sexp-lookup-properties nil)) + (or + (condition-case nil + (progn + (goto-char (with-syntax-table + (TeX-search-syntax-table openchar closechar) + (scan-sexps (point) 1))) + ;; No error code. See if closechar is unquoted + (save-excursion + (backward-char 1) + (zerop (mod (skip-chars-backward (regexp-quote esc-char)) 2)))) + (error nil)) + (save-match-data + (goto-char (1+ init-point)) + (while (and (> mycount 0) + (re-search-forward + (string ?\[ + ;; closechar might be ] + ;; and therefor must be first in regexp + closechar openchar + ?\]) + nil t)) + (cond + ((font-latex-commented-outp) + (forward-line 1)) + ((save-excursion + (backward-char 1) + (zerop (mod (skip-chars-backward (regexp-quote esc-char)) + 2))) + (setq mycount (+ mycount + (if (= (preceding-char) openchar) 1 -1))))))) + (if (= mycount 0) + t + (goto-char init-point) + nil)))) + +(defun font-latex-commented-outp () + "Return t if comment character is found between bol and point." + (save-excursion + (let ((limit (point)) + (esc-char (if (and (boundp 'TeX-esc) TeX-esc) TeX-esc "\\"))) + (forward-line 0) + (if (and (eq (char-after) ?\%) + (not (font-latex-faces-present-p 'font-latex-verbatim-face))) + (not (eq major-mode 'doctex-mode)) + (catch 'found + (while (progn (skip-chars-forward "^%" limit) + (< (point) limit)) + (when (and (save-excursion + (zerop (mod (skip-chars-backward + (regexp-quote esc-char)) 2))) + (not (font-latex-faces-present-p + 'font-latex-verbatim-face))) + (throw 'found t)) + (forward-char))))))) + +(defun font-latex-faces-present-p (faces &optional pos) + "Return t if FACES are present at position POS. +FACES may be a single face or a list of faces. +If POS is omitted, the current position of point is used." + (let* ((faces (if (listp faces) faces (list faces))) + (pos (or pos (point))) + (prop (get-text-property pos 'face)) + (prop-list (if (listp prop) prop (list prop)))) + (catch 'member + (dolist (item prop-list) + (when (memq item faces) + (throw 'member t)))))) + +(defun font-latex-forward-comment () + "Like `forward-comment' but with special provisions for docTeX mode. +In docTeX mode \"%\" at the start of a line will be treated as whitespace." + (if (eq major-mode 'doctex-mode) + ;; XXX: We should probably cater for ^^A as well. + (progn + (while (progn (if (bolp) (skip-chars-forward "%")) + (> (skip-chars-forward " \t\n") 0))) + (when (eq (char-after) ?%) + (beginning-of-line 2) + t)) + (forward-comment 1))) + +;;; Match functions + +(defvar font-latex-matched-faces nil + "List of faces corresponding to matches in match data.") + +(defun font-latex-matched-face (pos) + "Return face at position POS in `font-latex-matched-faces'." + (nth pos font-latex-matched-faces)) + +(defvar font-latex-command-with-args-default-spec nil ; "*[{" + "Default specifier for keywords without syntax description. +Set this to nil if verification of command syntax is unwanted.") + +(defvar font-latex-command-with-args-opt-arg-delims + '((?\[ . ?\]) (?< . ?>) (?\( . ?\))) + "List character pairs used as delimiters for optional arguments.") + +(defvar font-latex-syntax-error-modes '(latex-mode) + "List of modes where syntax errors in macros should be indicated.") + +(defun font-latex-match-command-with-arguments (regexp keywords face limit) + "Search for regexp command KEYWORDS[opt]{arg} before LIMIT. +Returns nil if none of KEYWORDS is found." + (setq font-latex-matched-faces nil) + (catch 'match + (while (re-search-forward regexp limit t) + (unless (font-latex-faces-present-p '(font-lock-comment-face + font-latex-verbatim-face) + (match-beginning 0)) + (let* ((beg (match-beginning 0)) + end ; Used for multiline text property. + (match-data (list beg)) + match-beg syntax-error alternative spec + error-indicator-pos + (spec-list (string-to-list + (or (cadr (assoc (match-string 1) keywords)) + font-latex-command-with-args-default-spec))) + (parse-sexp-ignore-comments t)) ; scan-sexps ignores comments + (goto-char (match-end 0)) + ;; Check for starred macro if first spec is an asterisk or a + ;; plus sign in case of \defaultfontfeatures+ provided by + ;; fontspec.sty + (when (or (eq (car spec-list) ?*) + (eq (car spec-list) ?+)) + (setq spec-list (cdr spec-list)) + (skip-chars-forward "*+" (1+ (point)))) + ;; Add current point to match data and use keyword face for + ;; region from start to point. + (nconc match-data (list (point))) + (add-to-list 'font-latex-matched-faces 'font-lock-keyword-face) + (setq end (point)) + (catch 'break + ;; Walk the list of specs. + (while spec-list + (setq spec (pop spec-list) + error-indicator-pos beg) + (while (and (not (eobp)) (font-latex-forward-comment))) + ;; Alternative + (when (eq spec ?|) + (setq alternative t) + (setq spec (pop spec-list))) + (cond + ;; Macros: \foo + ((eq spec ?\\) + (if (eq (char-after) spec) + (progn + (nconc match-data + (list (point) + (progn + (forward-char) + (if (zerop (skip-syntax-forward "_w")) + (forward-char) ; Single-char macro. + (skip-chars-forward "*+")) + (point)))) + (nconc font-latex-matched-faces (list face)) + (setq end (max end (point))) + (when alternative (pop spec-list))) + (setq syntax-error t) + (throw 'break nil))) + ;; Mandatory arguments: {...} + ((eq spec ?{) + (if (and (eq (char-after) spec) + (setq match-beg (point)) + (font-latex-find-matching-close ?{ ?})) + (progn + (nconc match-data (list (1+ match-beg) (1- (point)))) + (nconc font-latex-matched-faces (list face)) + (setq end (max end (1- (point)))) + (when alternative (pop spec-list))) + (unless alternative + (setq syntax-error t) + (when (and match-beg (= match-beg (point))) + (setq error-indicator-pos match-beg)) + (throw 'break nil)))) + ;; Optional arguments: [...] and others + ((eq (char-after) spec) + (setq match-beg (point)) + (if (font-latex-find-matching-close + spec (cdr (assq + spec + font-latex-command-with-args-opt-arg-delims))) + (progn + (nconc match-data (list (1+ match-beg) (1- (point)))) + (nconc font-latex-matched-faces + (list 'font-lock-variable-name-face)) + (setq end (max end (1- (point))))) + (setq syntax-error t + error-indicator-pos match-beg) + (throw 'break nil)))) + (setq alternative nil))) + (when (and syntax-error (memq major-mode + font-latex-syntax-error-modes)) + ;; Add the warning face at the front of the list because + ;; the matcher uses 'append and the face would otherwise + ;; be overridden by the keyword face. + (setq match-data (append (list error-indicator-pos + (1+ error-indicator-pos)) + match-data)) + (push 'font-latex-warning-face font-latex-matched-faces)) + (store-match-data match-data) + (throw 'match t)))))) + +;; Those are dynamically bound by font-lock. +(defvar font-lock-beg) +(defvar font-lock-end) + +(defun font-latex-extend-region-backwards-command-with-args () + "Extend region backwards for commands with args." + (save-excursion + (goto-char font-lock-end) + (catch 'extend + (while (TeX-search-backward-unescaped "}" font-lock-beg t) + (let ((macro-start + (TeX-find-macro-start + (max (point-min) + (- font-lock-beg font-latex-multiline-boundary))))) + (when (and macro-start + (< macro-start font-lock-beg)) + (setq font-lock-beg macro-start) + (throw 'extend t))))))) + +(defun font-latex-match-command-in-braces (keywords limit) + "Search for command like {\\bfseries fubar} before LIMIT. +Sets `match-data' so that: + subexpression 0 is a warning indicator, + subexpression 1 is the keyword, and + subexpression 2 is the rest in the TeX group. +Return nil if no command is found." + (catch 'match + (while (re-search-forward keywords limit t) + (unless (font-latex-faces-present-p '(font-lock-comment-face + font-latex-verbatim-face) + (match-beginning 0)) + (let ((kbeg (match-beginning 0)) (kend (match-end 1)) + (beg (match-end 0)) + cbeg cend + (parse-sexp-ignore-comments t)) ; scan-sexps ignores comments + (goto-char kbeg) + (if (not (eq (preceding-char) ?\{)) + ;; Fontify only the keyword (no argument found). + (progn + (setq cbeg kbeg cend kend) + (goto-char (match-end 0)) + (store-match-data (list (point) (point) + (point) (point) + cbeg cend)) + (throw 'match t)) + ;; There's an opening bracket + (save-restriction + ;; Restrict to LIMIT. + (narrow-to-region (point-min) limit) + (forward-char -1) ; Move on the opening bracket + (if (font-latex-find-matching-close ?\{ ?\}) + (store-match-data (list kbeg kbeg + kbeg kend + beg (1- (point)))) + (goto-char kend) + (store-match-data (list (1- kbeg) kbeg + kbeg kend + kend kend))) + (throw 'match t)))))))) + +(defun font-latex-extend-region-backwards-command-in-braces () + "Extend region backwards for commands in braces." + (save-excursion + (goto-char font-lock-end) + (catch 'extend + (while (TeX-search-backward-unescaped "}" font-lock-beg t) + (let ((group-start + (TeX-find-opening-brace + nil (max (point-min) + (- font-lock-beg font-latex-multiline-boundary))))) + (when group-start + ;; XXX: Actually we'd have to check if any of the + ;; declaration-type macros can be found right after the + ;; brace. If we don't do this (like now) large regions + ;; may be refontified for no good reason. For checking + ;; the built-in `font-latex-match-*' variables for + ;; declaration-type macros as well as the respective + ;; user-defined variables could be concatenated. + (goto-char group-start) + (when (< group-start font-lock-beg) + (setq font-lock-beg group-start) + (throw 'extend t)))))))) + +(defvar font-latex-match-simple-exclude-list + '("-" "," "/" "&" "#" "_" "`" "'" "^" "~" "=" "." "\"") + "List of characters directly after \"\\\" excluded from fontification. +Each character is a string.") + +(defvar font-latex-match-simple-include-list '("@") + "List of characters allowed in a macro for fontification. +Each character is a string. This variable is initialized to +\"@\" since internal LaTeX commands are very often redefined in a +.tex file and the fontification should work correctly in those +cases.") +(make-variable-buffer-local 'font-latex-match-simple-include-list) + +(defun font-latex-match-simple-command (limit) + "Search for command like \\foo before LIMIT." + ;; \s_ matches chars with symbol syntax, \sw chars with word syntax, + ;; \s. chars with punctuation syntax. We must exclude matches where + ;; the first character after the \ is a reserved character and + ;; should not be fontified (e.g. \, in foo\,bar or \- in foo\-bar). + ;; These characters are stored in + ;; `font-latex-match-simple-exclude-list'. In docTeX mode, we + ;; remove "_" from this list to get correct fontification for macros + ;; like `\__module_foo:nnn' + (let* ((search (lambda () + (TeX-re-search-forward-unescaped + (concat + ;; Chars directly after backslash + "\\\\\\(\\s_\\|\\sw\\|\\s.\\)" + ;; Start group of the following chars + "\\(?:[" + ;; a-zA-Z are always allowed: + "a-zA-Z" + ;; Additional characters added by AUCTeX styles + (mapconcat #'identity + font-latex-match-simple-include-list + "") + ;; End group + "]\\)*") + limit t))) + (pos (funcall search))) + (while (and pos + (member (match-string 1) + (if (eq major-mode 'doctex-mode) + (remove "_" font-latex-match-simple-exclude-list) + font-latex-match-simple-exclude-list))) + (setq pos (funcall search))) + pos)) + +(defun font-latex-match-math-env (limit) + "Match math pattern up to LIMIT. +Used for patterns like: +\\( F = ma \\) +\\=\\[ F = ma \\] but not \\\\=\\[len]" + (catch 'match + (while (re-search-forward "\\(\\\\(\\)\\|\\(\\\\\\[\\)" limit t) + (unless (save-excursion + (goto-char (match-beginning 0)) + ;; \\[ does not start a math environment + (/= (mod (skip-chars-backward "\\\\") 2) 0)) + (let ((beg (match-beginning 0)) + (open-tag (if (match-beginning 1) "\\(" "\\[")) + (close-tag (if (match-beginning 1) "\\)" "\\]"))) + ;; Search for both opening and closing tags in order to be + ;; able to avoid erroneously matching stuff like "\(foo \(bar\)". + (if (and (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*\\(" + (regexp-quote open-tag) "\\|" + (regexp-quote close-tag) "\\)") + (+ limit font-latex-multiline-boundary) + 'move) + (string= (match-string 1) close-tag)) + ;; Found closing tag. + (let ((p (point))) + (if (< font-latex--updated-region-end limit) + ;; *-extend-region-functions have extended the + ;; limit already. + (setq font-latex--updated-region-end limit)) + ;; If the closing tag is beyond the current end of + ;; region, take care of it. + (when (< font-latex--updated-region-end p) + (font-lock-unfontify-region font-latex--updated-region-end p) + (setq font-latex--updated-region-end p)) + (store-match-data (list beg beg beg p))) + ;; Did not find closing tag. + (goto-char (+ beg 2)) + (store-match-data (list beg (point) (point) (point)))) + (throw 'match t)))))) + +(require 'texmathp) +(defcustom font-latex-math-environments nil + "List of math environment names for font locking. +It is no longer recommended to customize this option. You should +customize `texmathp-tex-commands' instead because it is important +for stable operation of font lock that this option is coherent +with that option in addition to `texmathp-tex-commands-default'. +See info node `(auctex)Fontification of math' to convert your +customization into `texmathp-tex-commands'." + ;; This option is now used only through + ;; `font-latex--match-math-envII-regexp'. + :type '(repeat string) + :group 'font-latex) + +(defvar font-latex--match-math-envII-regexp nil + "Regular expression to match math environments. +Set by `font-latex--update-math-env' and used in +`font-latex-match-math-envII'.") + +(defun font-latex-update-math-env () + "Update regexp to search for math environments. +Extract environments marked as `env-on' in +`texmathp-tex-commands1' except starred variants. Then build +`font-latex--match-math-envII-regexp' from them, appending the +environments in `font-latex-math-environments'." + ;; Make sure `texmathp-tex-commands1' is up to date. + (texmathp-compile) + (let (envs) + (dolist (entry texmathp-tex-commands1) + (if (and (eq 'env-on (cadr entry)) + (not (string= "*" (substring (car entry) -1)))) + (cl-pushnew (car entry) envs :test #'equal))) + (setq font-latex--match-math-envII-regexp + (concat "\\\\begin[ \t]*{" + ;; Take user additions also into account. + (regexp-opt (append font-latex-math-environments envs) t) + ;; Subexpression 2 is used to build the \end{<env>} + ;; construct later. + "\\(\\*?}\\)" + ;; Match an optional and possible mandatory + ;; argument(s) as long as they are on the same line + ;; with no spaces in-between. The content of optional + ;; argument can span multiple lines. + "\\(?:\\[[^][]*\\(?:\\[[^][]*\\][^][]*\\)*\\]\\)?" + "\\(?:{[^}]*}\\)*")))) + +;; Initialize. +(font-latex-update-math-env) + +(defun font-latex-match-math-envII (limit) + "Match math patterns up to LIMIT. +Used for patterns like: +\\begin{equation} + fontified stuff +\\end{equation} or +\\begin{empheq}[X=Y\\Rightarrow]{alignat=3} + fontified stuff +\\end{empheq} +The \\begin{equation} incl. arguments in the same line and +\\end{equation} are not fontified here." + (when (re-search-forward font-latex--match-math-envII-regexp limit t) + (let ((beg (match-end 0)) end + (beg-of-begin (match-beginning 0))) + (if (re-search-forward (concat "\\\\end[ \t]*{" + (regexp-quote + (buffer-substring-no-properties + (match-beginning 1) + (match-end 2)))) + (+ limit font-latex-multiline-boundary) 'move) + (progn + (setq end (match-beginning 0)) + (if (< font-latex--updated-region-end limit) + (setq font-latex--updated-region-end limit)) + (when (< font-latex--updated-region-end end) + (font-lock-unfontify-region font-latex--updated-region-end end) + (setq font-latex--updated-region-end end))) + (goto-char beg) + (setq end beg + beg-of-begin beg)) + ;; Store the position of "\begin{foo}" as (match-beginnig 0) so + ;; that `font-lock-multiline' text property covers it. This keeps + ;; editing inside multi-line optional argument sane. + (store-match-data (list beg-of-begin end beg end)) + t))) + +(defun font-latex-match-dollar-math (limit) + "Match inline math $...$ or display math $$...$$ before LIMIT." + (catch 'match + (let (beg num) + (while (font-latex-find-dollar-math limit) + ;; Found "$" which starts $...$ or $$...$$. + (setq beg (point) + ;; Go inside the math expression. + num (skip-chars-forward "$" limit)) + ;; If those are three or more consecutive $, ignore them and + ;; search again. + (if (< num 3) + (if ;; Let's find the same number of live dollar signs. + (font-latex-find-dollar-math + ;; Hope that limit+font-latex-multiline-boundary + ;; doesn't fall just inside single "$$". + (min (point-max) (+ limit font-latex-multiline-boundary)) + num) + ;; Found. + (progn + (forward-char num) + (let ((p (point))) + (if (< font-latex--updated-region-end limit) + (setq font-latex--updated-region-end limit)) + (when (< font-latex--updated-region-end p) + (font-lock-unfontify-region + font-latex--updated-region-end p) + (setq font-latex--updated-region-end p)) + (set-match-data (list beg p))) + (throw 'match t)) + ;; Not found. + ;; That $ or $$ is probably unclosed in the buffer. + (throw 'match nil))))))) + +(defun font-latex-find-dollar-math (limit &optional num) + "Find dollar sign(s) before LIMIT. +Set point just before the found $. Ignore escaped $ (\"\\$\"). +Optional argument NUM, if non-nil, specifies the number of dollar +signs to follow the point and must be 1 or 2. +LIMIT must not exceed the end of buffer." + (catch 'found + (while (progn + (skip-chars-forward "^$" limit) + (< (point) limit)) + ;; Found "$". + ;; If that "$" is not our target, skip over it and search + ;; again. + (cond + ;; check 1: Are we in a verbatim construct or comment? + ((let ((ppss (syntax-ppss))) + (or (nth 3 ppss) + ;; Ignore $ in comments... + (and (nth 4 ppss) + ;; ... except if we're looking for the end of the + ;; inline math. We need to consider this %$ + ;; comments because they are the workaround for + ;; falsely triggered math mode due to valid, + ;; non-math occurrences of $. (bug#48365) + (not num)))) + (skip-chars-forward "$" limit)) + ;; check 2: Else, is "$" escaped? + ((TeX-escaped-p) + (forward-char 1)) + ;; check 3: Else, is the number of the following "$" wrong? + ;; This check cannot precede check 2 because "$1+2\$$" is + ;; legal. + ((and (eq num 2) (not (eq (char-after (1+ (point))) ?$))) + ;; If double dollars ($$) are followed by $, skip over that $. + ;; We need not care the case that single dollar ($) is + ;; followed by $$ because expressions like "$1+1$$2+2$" and + ;; "$1+2$$$3+3$$" are legal. + (forward-char 1)) + (t + ;; That "$" is live one. + (throw 'found t)))))) + +(defun font-latex-extend-region-backwards-math () + "Extend region backwards for math environmets. +Take into account $...$, $$...$$, \\(...\\) and \\=\\[...\\], too." + ;; Use `texmathp' to identify whether the point is inside math mode. + ;; Only heuristic, but it's very difficult to identify rigorously + ;; without syntactic support. + + ;; Check if `font-lock-beg' is inside math mode. + (goto-char font-lock-beg) + + ;; Workaround bug#41522. Ensure `syntax-table' property is given to + ;; all verbatim-like constructs up to the position before running + ;; `texmathp' in order to prevent wrong fontification of verbatim + ;; face. This is necessary because `texmathp' calls `up-list' inside + ;; narrowing. + (syntax-propertize (point)) + + ;; XXX: Should we make the `texmathp' search honor + ;; `font-latex-multiline-boundary'? + (when (and (texmathp) (< (cdr texmathp-why) font-lock-beg)) + ;; Make its beginning a new start of font lock region. + (setq font-lock-beg (cdr texmathp-why)) + t)) + +(defun font-latex-sp-extend-region-backwards-verb-env (beg end) + "Extend region backwards for verbatim environments." + (let ((envs (and (fboundp 'LaTeX-verbatim-environments) + (LaTeX-verbatim-environments)))) + (when envs + (save-excursion + (goto-char end) + (catch 'extend + (while (re-search-backward + (concat "\\\\end[ \t]*{" (regexp-opt envs t) "\\*?}") beg t) + (when (and (re-search-backward + (concat "\\\\begin[ \t]*{" + (buffer-substring-no-properties + (match-beginning 1) + (match-end 0)) + ;; Match an optional and possible + ;; mandatory argument(s) + "\\(?:\\[[^][]*\\(?:\\[[^][]*\\][^][]*\\)*\\]\\)?" + "\\(?:{[^}]*}\\)*") + (- beg font-latex-multiline-boundary) t) + (< (point) beg)) + (throw 'extend (cons (point) end))))))))) + +(defun font-latex-update-quote-list () + "Update quote list and regexp if value of `font-latex-quotes' changed." + (unless (eq font-latex-quotes-control font-latex-quotes) + (setq font-latex-quotes-control font-latex-quotes) + (font-latex-quotes-set-internal) + ;; Set order of each entry in `font-latex-quote-list' according to + ;; setting of `font-latex-quotes-internal'. + (let ((tail font-latex-quote-list) + elt) + (while tail + (setq elt (car tail)) + (when (and (> (safe-length elt) 2) + (not (eq (nth 2 elt) font-latex-quotes-internal))) + (setcar tail (list (nth 1 elt) (nth 0 elt) + font-latex-quotes-internal))) + (setq tail (cdr tail)))) + (setq font-latex-quote-regexp-beg + (regexp-opt (mapcar #'car font-latex-quote-list) t)))) + +(defun font-latex-match-quotation (limit) + "Match quote patterns up to LIMIT. +Used for patterns like: +``this is a normal quote'' and these are multilingual quoted strings: +\"< french \"> and \"`german\"' quotes. +The quotes << french >> and 8-bit french are used if `font-latex-quotes' is +set to `french', and >>german<< (and 8-bit) are used if set to `german'." + (when font-latex-quotes + (font-latex-update-quote-list) + ;; Search for matches. + (catch 'match + (while (TeX-re-search-forward-unescaped + font-latex-quote-regexp-beg limit t) + (unless (font-latex-faces-present-p '(font-lock-comment-face + font-latex-verbatim-face + font-latex-math-face) + (match-beginning 0)) + (let* ((beg (match-beginning 0)) + (after-beg (match-end 0)) + (opening-quote (match-string-no-properties 0)) + (closing-quote + (nth 1 (assoc opening-quote font-latex-quote-list))) + (nest-count 0) + (point-of-surrender (+ beg font-latex-multiline-boundary))) + ;; Find closing quote taking nested quotes into account. + (while (progn + (re-search-forward + (concat opening-quote "\\|" closing-quote) + point-of-surrender 'move) + (when (and (< (point) point-of-surrender) (not (eobp))) + (if (string= (match-string-no-properties 0) + opening-quote) + (setq nest-count (1+ nest-count)) + (when (/= nest-count 0) + (setq nest-count (1- nest-count))))))) + ;; If no closing quote was found, set the second match which + ;; will be marked with warning color, if one was found, set + ;; the first match which will be marked with string color. + (if (or (= (point) point-of-surrender) (eobp)) + (progn + (goto-char after-beg) + (store-match-data (list after-beg after-beg beg after-beg))) + (let ((p (point))) + (if (< font-latex--updated-region-end limit) + (setq font-latex--updated-region-end limit)) + (when (< font-latex--updated-region-end p) + (font-lock-unfontify-region + font-latex--updated-region-end p) + (setq font-latex--updated-region-end p)) + (store-match-data (list beg p p p)))) + (throw 'match t))))))) + +(defun font-latex-extend-region-backwards-quotation () + "Extend region backwards for quotations." + (when font-latex-quotes + (font-latex-update-quote-list) + (let ((regexp-end (regexp-opt (mapcar #'cadr font-latex-quote-list) t))) + (save-excursion + (goto-char font-lock-end) + (catch 'extend + (while (re-search-backward regexp-end font-lock-beg t) + (let ((found-end (match-beginning 0)) + (closing-quote (match-string-no-properties 0)) + (nest-count 0) + (point-of-surrender (- font-lock-beg + font-latex-multiline-boundary)) + opening-quote) + (catch 'found + (dolist (elt font-latex-quote-list) + (when (string= (cadr elt) closing-quote) + (setq opening-quote (car elt)) + (throw 'found nil)))) + ;; Find opening quote taking nested quotes into account. + (while (if (re-search-backward (concat opening-quote "\\|" + closing-quote) + point-of-surrender 'move) + ;; Found quotes before point-of-surrender. + (cond ((string= (match-string-no-properties 0) + closing-quote) + ;; Encountered another closing quote. + ;; Increase nest-count and continue + ;; the inner loop. + (setq nest-count (1+ nest-count))) + ;; Found an opening quote. + ((/= nest-count 0) + ;; If in nest, decrease nest-count + ;; and continue the inner loop. + (setq nest-count (1- nest-count))) + ;; Else we arrived at the opening quote + ;; matching with the closing quote found + ;; in the outer loop. + ((< (point) font-lock-beg) + ;; If that opening quote locates + ;; before `font-lock-beg', break the + ;; outer loop and extend the region. + (setq font-lock-beg (point)) + (throw 'extend t)) + (t + ;; Else terminate the inner loop and + ;; continue the outer loop. + nil)) + ;; Didn't find quotes before + ;; point-of-surrender. + ;; Go back just before the closing quote, + ;; terminate the inner loop and + ;; continue the outer loop. + (goto-char found-end) + nil))))))))) + +(defun font-latex-match-script (limit) + "Match subscript and superscript patterns up to LIMIT." + (when (and font-latex-fontify-script + (re-search-forward "[_^] *\\([^\n\\{}]\\|\ +\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|\\({\\)\\)" limit t)) + (if (and (not (memq font-latex-fontify-script '(multi-level invisible))) + (font-latex-faces-present-p '(font-latex-subscript-face + font-latex-superscript-face))) + ;; Apply subscript and superscript highlighting only once (in case + ;; font-latex-fontify-script is not 'multi-level) in order to prevent + ;; the font size becoming too small. We set an empty match to do that. + (let ((point (point))) + (store-match-data (list point point point point))) + (when (match-end 3) + (let ((beg (match-beginning 3)) + (end (TeX-find-closing-brace + ;; Don't match groups spanning more than one line + ;; in order to avoid visually wrong indentation in + ;; subsequent lines. + nil (line-end-position)))) + (store-match-data (if end + (list (match-beginning 0) end beg end) + (list beg beg beg beg)))))) + t)) + +(defun font-latex-match-script-chars (limit) + "Match subscript and superscript chars up to LIMIT." + (catch 'found + (while (re-search-forward "[^_^]\\([_^]\\)" limit t) + (let ((pos (match-beginning 1))) + (when (and (font-latex-faces-present-p 'font-latex-math-face pos) + (not (font-latex-faces-present-p '(font-lock-constant-face + font-lock-builtin-face + font-lock-comment-face + font-latex-verbatim-face) pos)) + ;; Check for backslash quoting + (not (let ((odd nil) + (pos pos)) + (while (eq (char-before pos) ?\\) + (setq pos (1- pos) odd (not odd))) + odd))) + (throw 'found t)))))) + +(defun font-latex--get-script-props (pos script-type) + (let* ((old-raise (or (plist-get (get-text-property pos 'display) 'raise) 0.0)) + (new-level (1+ (or (get-text-property pos 'script-level) 0))) + (disp-props (copy-sequence (cl-case script-type + (:super (cdr font-latex-script-display)) + (:sub (car font-latex-script-display))))) + (new-disp-props (let ((raise (plist-get disp-props 'raise)) + (nl new-level)) + (if raise + ;; This polynom approximates that the factor + ;; which is multiplied with raise is 1 for nl=1, + ;; 0.8 for nl=2, 0.64 for nl=3, etc. (so always + ;; about 80% of the previous value). + (plist-put disp-props 'raise + (+ old-raise + (* raise + (+ 1.1965254857142873 + (* nl -0.21841226666666758) + (* nl nl 0.012018514285714385))))) + disp-props)))) + `(face ,(if (<= new-level font-latex-fontify-script-max-level) + (cl-case script-type + (:super 'font-latex-superscript-face) + (:sub 'font-latex-subscript-face)) + nil) + script-level ,new-level + display ,new-disp-props))) + +;; Copy and adaption of `tex-font-lock-suscript' from tex-mode.el in +;; GNU Emacs on 2004-07-07. +(defun font-latex-script (pos) + "Return face and display spec for subscript and superscript content." + (when (and (font-latex-faces-present-p 'font-latex-math-face pos) + (not (font-latex-faces-present-p '(font-lock-constant-face + font-lock-builtin-face + font-lock-comment-face + font-latex-verbatim-face) pos)) + ;; Check for backslash quoting + (not (let ((odd nil) + (pos pos)) + (while (eq (char-before pos) ?\\) + (setq pos (1- pos) odd (not odd))) + odd))) + (if (eq (char-after pos) ?_) + (font-latex--get-script-props pos :sub) + (font-latex--get-script-props pos :super)))) + +(defun font-latex-script-char (_pos) + "Return face and display spec for subscript and superscript character at POS." + `(face font-latex-script-char-face + ,@(when (eq font-latex-fontify-script 'invisible) + '(invisible t)))) + +;;; docTeX + +(defvar font-latex-doctex-preprocessor-face + 'font-latex-doctex-preprocessor-face + "Face used to highlight preprocessor directives in docTeX mode.") + +(defface font-latex-doctex-preprocessor-face + '((t (:inherit (font-latex-doctex-documentation-face + font-lock-builtin-face ; Emacs 21 does not provide + ; the preprocessor face. + font-lock-preprocessor-face)))) + "Face used to highlight preprocessor directives in docTeX mode." + :group 'font-latex-highlighting-faces) + +(defvar font-latex-doctex-documentation-face + 'font-latex-doctex-documentation-face + "Face used to highlight the documentation in docTeX mode.") + +(defface font-latex-doctex-documentation-face + '((((class mono)) (:inverse-video t)) + (((class grayscale) (background dark)) (:background "#333")) + (((class color) (background dark)) (:background "#333")) + (t (:background "#eeeeee"))) + "Face used to highlight the documentation parts in docTeX mode." + :group 'font-latex-highlighting-faces) + +(defvar font-latex-doctex-keywords + (append '((font-latex-doctex-match-^^A 0 font-lock-comment-face t)) + font-latex-keywords-2 + '(("^%<[^>]*>" (0 font-latex-doctex-preprocessor-face t))))) + +(defun font-latex-doctex-match-^^A (limit) + "In docTeX mode, match comment started by ^^A and ^^X before LIMIT." + (catch 'found + (while (TeX-re-search-forward-unescaped "\\^\\^[AX]" limit t) + (when (eq (char-after (line-beginning-position)) ?\%) + (forward-line 1) + ;; Adjust `font-latex--updated-region-end' if necessary. + (let ((p (point))) + (if (< font-latex--updated-region-end limit) + (setq font-latex--updated-region-end limit)) + (when (< font-latex--updated-region-end p) + (font-lock-unfontify-region + font-latex--updated-region-end p) + (setq font-latex--updated-region-end p)) + ;; We assume that the above adjustment preserves match data. + (set-match-data (list (match-beginning 0) p))) + (throw 'found t))))) + +;; Copy and adaptation of `doctex-font-lock-syntactic-face-function' +;; in `tex-mode.el' of CVS Emacs (March 2004) +(defun font-latex-doctex-syntactic-face-function (state) + ;; Mark docTeX documentation, which is parsed as a style A comment + ;; starting in column 0. + (if (or (nth 3 state) (nth 7 state) + (not (memq (char-before (nth 8 state)) + '(?\n nil)))) + ;; Anything else is just as for LaTeX. + (font-latex-syntactic-face-function state) + font-latex-doctex-documentation-face)) + + +;;; Installation in non-AUCTeX LaTeX mode + +;; Here used to be some code which tried to magically make things work and +;; thereby broke other stuff. If you want to use font-latex with stock +;; latex-mode, then please just add `font-latex-setup' to `latex-mode-hook' +;; yourself. + +;;; Byte-compilation of generated functions +;; Not needed now that we generate the code via a macro. +;; (when (byte-code-function-p +;; (symbol-function 'font-latex-make-built-in-keywords)) +;; (dolist (elt font-latex-built-in-keyword-classes) +;; (let ((name (nth 0 elt))) +;; (byte-compile (intern (concat "font-latex-match-" name))) +;; (byte-compile (intern (concat "font-latex-match-" name "-make")))))) + + +;; Provide ourselves: +(provide 'font-latex) + +;; Local Variables: +;; coding: utf-8 +;; End: + +;;; font-latex.el ends here |