Function: tuareg--install-font-lock
tuareg--install-font-lock is a natively compiled function defined in
tuareg.el.
Signature
(tuareg--install-font-lock &optional INTERACTIVE-P)
Documentation
Setup font-lock-defaults. INTERACTIVE-P says whether it is
for the interactive mode.
Source Code
;; Defined in /nix/store/6mbh851dhnag8f92qfrlh9ckldzwf6c6-emacs-packages-deps/share/emacs/site-lisp/elpa/tuareg-20260626.936/tuareg.el
(defun tuareg--install-font-lock (&optional interactive-p)
"Setup `font-lock-defaults'. INTERACTIVE-P says whether it is
for the interactive mode."
(let* ((id tuareg--id-re)
(lid tuareg--lid-re)
(uid tuareg--uid-re)
(attr-id1 "\\<[[:alpha:]_][[:alpha:]0-9_']*\\>")
(attr-id (concat attr-id1 "\\(?:\\." attr-id1 "\\)*"))
(maybe-infix-extension (concat "\\(?:%" attr-id "\\)?")); at most 1
;; Matches braces balanced on max 3 levels.
(balanced-braces
(let ((b "\\(?:[^()]\\|(")
(e ")\\)*"))
(concat b b b "[^()]*" e e e)))
(balanced-braces-no-string
(let ((b "\\(?:[^()\"]\\|(")
(e ")\\)*"))
(concat b b b "[^()\"]*" e e e)))
(balanced-braces-no-end-operator ; non-empty
(let* ((b "\\(?:[^()]\\|(")
(e ")\\)*")
(braces (concat b b "[^()]*" e e))
(end-op (concat "\\(?:[^()!$%&*+-./:<=>?@^|~]\\|("
braces ")\\)")))
(concat "\\(?:[^()!$%&*+-./:<=>?@^|~]"
;; Operator not starting with ~
"\\|[!$%&*+-./:<=>?@^|][!$%&*+-./:<=>?@^|~]*" end-op
;; Operator or label starting with ~
"\\|~\\(?:[!$%&*+-./:<=>?@^|~]+" end-op
"\\|[[:lower:]][[:alpha:]0-9]*[: ]\\)"
"\\|(" braces e)))
(balanced-brackets
(let ((b "\\(?:[^][]\\|\\[")
(e "\\]\\)*"))
(concat b b b "[^][]*" e e e)))
(maybe-infix-attribute
(concat "\\(?:\\[@" attr-id balanced-brackets "\\]\\)*"))
(maybe-infix-ext+attr
(concat maybe-infix-extension maybe-infix-attribute))
;; FIXME: module paths with functor applications
(module-path (concat uid "\\(?:\\." uid "\\)*"))
(typeconstr (concat "\\(?:" module-path "\\.\\)?" lid))
(extended-module-name
(concat uid "\\(?: *([ [:upper:]]" balanced-braces ")\\)*"))
(extended-module-path
(concat extended-module-name
"\\(?: *\\. *" extended-module-name "\\)*"))
(modtype-path (concat "\\(?:" extended-module-path "\\.\\)*" id))
(typevar "'[[:alpha:]_][[:alpha:]0-9_']*\\>")
(typeparam (concat "\\(?:[+-]?" typevar "\\|_\\)"))
(typeparams (concat "\\(?:" typeparam "\\|( *"
typeparam " *\\(?:, *" typeparam " *\\)*)\\)"))
(typedef (concat "\\(?:" typeparams " *\\)?" lid))
;; Define 2 groups: possible path, variables
(let-ls3 (regexp-opt '("clock" "node" "static"
"present" "automaton" "where" "match"
"with" "do" "done" "unless" "until"
"reset" "every")))
(before-operator-char "[^-!$%&*+./:<=>?@^|~#?]")
(operator-char "[-!$%&*+./:<=>?@^|~]")
(operator-char-no> "[-!$%&*+./:<=?@^|~]"); for "->"
(binding-operator-char
(concat "\\(?:[-$&*+/<=>@^|]" operator-char "*\\)"))
(let-binding-g4 ; 4 groups
(concat "\\_<\\(?:\\(let\\_>" binding-operator-char "?\\)"
"\\(" maybe-infix-ext+attr
"\\)\\(?: +\\(" (if (tuareg-editing-ls3) let-ls3 "rec\\_>")
"\\)\\)?\\|\\(and\\_>" binding-operator-char "?\\)\\)"))
;; group for possible class param
(gclass-gparams
(concat "\\(\\_<class\\(?: +type\\)?\\(?: +virtual\\)?\\_>\\)"
" *\\(\\[ *" typevar " *\\(?:, *" typevar " *\\)*\\] *\\)?"))
;; font-lock rules common to all levels
(common-keywords
`(("^#[0-9]+ *\\(?:\"[^\"]+\"\\)?"
0 'tuareg-font-lock-line-number-face t)
;; cppo
(,(concat "^ *#"
(regexp-opt '("define" "undef" "if" "ifdef" "ifndef"
"else" "elif" "endif" "include"
"warning" "error" "ext" "endext")
'symbols))
(0 'font-lock-preprocessor-face))
;; Directives
,@(if interactive-p
`((,(concat "^# +\\(#" lid "\\)")
1 'tuareg-font-lock-interactive-directive-face)
(,(concat "^ *\\(#" lid "\\)")
1 'tuareg-font-lock-interactive-directive-face))
`((,(concat "^\\(#" lid "\\)")
(0 'tuareg-font-lock-interactive-directive-face))))
(,(concat (if interactive-p "^ *#\\(?: +#\\)?" "^#")
"show\\(?:_module\\)? +\\(" uid "\\)")
1 'tuareg-font-lock-module-face)
(";;+" 0 'tuareg-font-double-semicolon-face)
;; Attributes (`keep' to highlight except strings & chars)
(,(concat "\\[@\\(?:@@?\\)?" attr-id balanced-brackets "\\]")
0 'tuareg-font-lock-attribute-face keep)
;; Extension nodes.
(,(concat "\\(\\[%%?" attr-id "\\)" balanced-brackets "\\(\\]\\)")
(1 'tuareg-font-lock-extension-node-face)
(2 'tuareg-font-lock-extension-node-face))
(,(concat "[^;];\\(" maybe-infix-extension "\\)")
1 'tuareg-font-lock-infix-extension-node-face)
(,(concat "\\_<\\(function\\)\\_>\\(" maybe-infix-ext+attr "\\)"
tuareg--whitespace-re "\\(" lid "\\)?")
(1 'font-lock-keyword-face)
(2 'tuareg-font-lock-infix-extension-node-face keep)
(3 'font-lock-variable-name-face nil t))
(,(concat "\\_<\\(fun\\|match\\|if\\)\\_>\\(" maybe-infix-ext+attr "\\)")
(1 'font-lock-keyword-face)
(2 'tuareg-font-lock-infix-extension-node-face keep))
;; "type" to introduce a local abstract type considered a keyword
(,(concat "( *\\(type\\) +\\(" lid " *\\)+)")
(1 'font-lock-keyword-face)
(2 'font-lock-type-face))
(":[\n]? *\\(\\<type\\>\\)"
(1 'font-lock-keyword-face))
;; (lid: t), before function definitions
(,(concat "(" lid " *:\\(['_[:alpha:]]"
balanced-braces-no-string "\\))")
1 'font-lock-type-face keep)
;; "module type of" module-expr (here "of" is a governing
;; keyword). Must be before the modules highlighting.
(,(concat "\\<\\(module +type +of\\)\\>\\(?: +\\("
module-path "\\)\\)?")
(1 'tuareg-font-lock-governing-face keep)
(2 'tuareg-font-lock-module-face keep t))
;; First class modules. In these contexts, "val" and "module"
;; are not considered as "governing" (main structure of the code).
(,(concat "( *\\(module\\) +\\(" module-path "\\) *\\(?:: *\\("
balanced-braces-no-string "\\)\\)?)")
(1 'font-lock-keyword-face)
(2 'tuareg-font-lock-module-face)
(3 'tuareg-font-lock-module-face keep t))
(,(concat "( *\\(val\\) +\\("
balanced-braces-no-end-operator "\\): +\\("
balanced-braces-no-string "\\))")
(1 'font-lock-keyword-face)
(2 'tuareg-font-lock-module-face)
(3 'tuareg-font-lock-module-face))
(,(concat "\\_<\\(module\\)\\(" maybe-infix-ext+attr "\\)"
"\\(\\(?: +type\\)?\\(?: +rec\\)?\\)\\>\\(?: *\\("
uid "\\)\\)?")
(1 'tuareg-font-lock-governing-face)
(2 'tuareg-font-lock-infix-extension-node-face)
(3 'tuareg-font-lock-governing-face)
(4 'tuareg-font-lock-module-face keep t))
("\\_<let +exception\\_>" . tuareg-font-lock-governing-face)
(,(concat (regexp-opt '("sig" "struct" "functor" "inherit"
"initializer" "object" "begin")
'symbols)
"\\(" maybe-infix-ext+attr "\\)")
(1 'tuareg-font-lock-governing-face)
(2 'tuareg-font-lock-infix-extension-node-face keep))
(,(regexp-opt '("constraint" "in" "end") 'symbols)
(0 'tuareg-font-lock-governing-face))
,@(if (tuareg-editing-ls3)
`((,(concat "\\<\\(let[ \t]+" let-ls3 "\\)\\>")
(0 'tuareg-font-lock-governing-face))))
;; "with type": "with" treated as a governing keyword
(,(concat "\\<\\(\\(?:with\\|and\\) +type\\(?: +nonrec\\)?\\_>\\) *"
"\\(" typeconstr "\\)?")
(1 'tuareg-font-lock-governing-face keep)
(2 'font-lock-type-face keep t))
(,(concat "\\<\\(\\(?:with\\|and\\) +module\\>\\) *\\(?:\\("
module-path "\\) *\\)?\\(?:= *\\("
extended-module-path "\\)\\)?")
(1 'tuareg-font-lock-governing-face keep)
(2 'tuareg-font-lock-module-face keep t)
(3 'tuareg-font-lock-module-face keep t))
;; "!", "mutable", "virtual" treated as governing keywords
(,(concat "\\<\\(\\(?:val\\(" maybe-infix-ext+attr "\\)"
(if (tuareg-editing-ls3) "\\|reset\\|do")
"\\)!? +\\(?:mutable\\(?: +virtual\\)?\\_>"
"\\|virtual\\(?: +mutable\\)?\\_>\\)"
"\\|val!\\(" maybe-infix-ext+attr "\\)\\)"
"\\(?: *\\(" lid "\\)\\)?")
(2 'tuareg-font-lock-infix-extension-node-face keep t)
(3 'tuareg-font-lock-infix-extension-node-face keep t)
(1 'tuareg-font-lock-governing-face keep t)
(4 'font-lock-variable-name-face nil t))
;; "val" without "!", "mutable" or "virtual"
(,(concat "\\_<\\(val\\)\\_>\\(" maybe-infix-ext+attr "\\)"
"\\(?: +\\(" lid "\\)\\)?")
(1 'tuareg-font-lock-governing-face keep)
(2 'tuareg-font-lock-infix-extension-node-face keep)
(3 'font-lock-function-name-face keep t))
;; "private" treated as governing keyword
(,(concat "\\(\\<method!?\\(?: +\\(?:private\\(?: +virtual\\)?"
"\\|virtual\\(?: +private\\)?\\)\\)?\\>\\)"
" *\\(" lid "\\)?")
(1 'tuareg-font-lock-governing-face keep t)
(2 'font-lock-function-name-face keep t)); method name
(,(concat "\\<\\(open\\(?:! +\\|\\> *\\)\\)\\(" module-path "\\)?")
(1 'tuareg-font-lock-governing-face)
(2 'tuareg-font-lock-module-face keep t))
;; (expr: t) and (expr :> t) If `t' is longer then one
;; word, require a space before. Not only this is more
;; readable but it also avoids that `~label:expr var` is
;; taken as a type annotation when surrounded by
;; parentheses. Done last so that it does not apply if
;; already highlighted (let x : t = u in ...) but before
;; module paths (expr : X.t).
(,(concat "(" balanced-braces-no-end-operator ":>? *\\(?:\n *\\)?"
"\\(['_[:alpha:]]" balanced-braces-no-string
"\\|(" balanced-braces-no-string ")"
balanced-braces-no-string"\\))")
1 'font-lock-type-face)
;; module paths A.B.
(,(concat module-path "\\.") . tuareg-font-lock-module-face)
,@(and tuareg-support-metaocaml
'(("[^-@^!*=<>&/%+~?#]\\(\\(?:\\.<\\|\\.~\\|!\\.\\|>\\.\\)+\\)"
1 'tuareg-font-lock-multistage-face)))
;; External function declaration
(,(concat "\\_<\\(external\\)\\_>\\(?: +\\(" lid "\\)\\)?")
(1 'tuareg-font-lock-governing-face)
(2 'font-lock-function-name-face keep t))
;; Binding operators
(,(concat "( *\\(\\(?:let\\|and\\)\\_>"
binding-operator-char "\\) *)")
1 'font-lock-function-name-face)
;; Highlight "let" and function names (their argument
;; patterns can then be treated uniformly with variable bindings)
(,(concat let-binding-g4
"\\(?: *" (regexp-opt '("local_" "mutable") 'symbols) "\\)?"
" *\\(?:\\(" lid "\\) *"
"\\(?:[^ =,:a]\\|a\\(?:[^s]\\|s[^[:space:]]\\)\\)\\)?")
(1 'tuareg-font-lock-governing-face keep t)
(2 'tuareg-font-lock-infix-extension-node-face keep t)
(3 'tuareg-font-lock-governing-face keep t)
(4 'tuareg-font-lock-governing-face keep t)
;; Group 5 (local_, mutable) is covered by the keywords rule
;; below.
(6 'font-lock-function-name-face keep t))
(,(concat "\\_<\\(include\\)\\_>\\(?: +\\("
extended-module-path "\\|( *"
extended-module-path " *: *" balanced-braces " *)\\)\\)?")
(1 'tuareg-font-lock-governing-face)
(2 'tuareg-font-lock-module-face keep t))
;; module type A = B
(,(concat "\\_<\\(module +type\\)\\_>\\(?: +" id
" *= *\\(" modtype-path "\\)\\)?")
(1 'tuareg-font-lock-governing-face)
(2 'tuareg-font-lock-module-face keep t))
;; "class [params] name"
(,(concat gclass-gparams "\\(" lid "\\)?")
(1 'tuareg-font-lock-governing-face keep)
(2 'font-lock-type-face keep t)
(3 'font-lock-function-name-face keep t))
;; "type lid" anywhere (e.g. "let f (type t) x =")
;; introduces a new type
(,(concat "\\_<\\(type\\_>\\)\\(" maybe-infix-ext+attr
"\\)\\(?: +\\(nonrec\\_>\\)\\)?\\(?:"
tuareg--whitespace-re
"\\(" typedef "\\)\\)?")
(1 'tuareg-font-lock-governing-face)
(2 'tuareg-font-lock-infix-extension-node-face keep)
(3 'tuareg-font-lock-governing-face keep t)
(4 'font-lock-type-face keep t))))
tuareg-font-lock-keywords-1-extra)
(setq
tuareg-font-lock-keywords
(append
common-keywords
`(;; Basic way of matching functions
(,(concat let-binding-g4 " *\\("
lid "\\) *= *\\(fun\\(?:ction\\)?\\)\\>")
(5 'font-lock-function-name-face)
(6 'font-lock-keyword-face))
)))
(setq
tuareg-font-lock-keywords-1-extra
`((,(regexp-opt '("true" "false" "__LOC__" "__FILE__" "__LINE__"
"__MODULE__" "__POS__" "__LOC_OF__" "__LINE_OF__"
"__POS_OF__")
'symbols)
(0 'font-lock-constant-face))
(,(let ((kwd '("as" "do" "done" "downto" "else" "for" "if"
"then" "to" "try" "when" "while" "new"
"lazy" "assert" "exception")))
(if (tuareg-editing-ls3)
(progn (push "reset" kwd) (push "merge" kwd)
(push "emit" kwd) (push "period" kwd)))
(regexp-opt kwd 'symbols))
(0 'font-lock-keyword-face))
(,(concat "\\_<exception +\\(" uid "\\)")
1 'tuareg-font-lock-constructor-face)
;; (M: S) -- only color S here (may be "A.T with type t = s")
(,(concat "( *" uid " *: *\\("
modtype-path "\\(?: *\\_<with\\_>"
balanced-braces "\\)?\\) *)")
1 'tuareg-font-lock-module-face keep)
;; module A(B: _)(C: _) : D = E, including "module A : E"
(,(concat "\\_<module +" uid tuareg--whitespace-re
"\\(\\(?:( *" uid " *: *"
modtype-path "\\(?: *\\_<with\\_>" balanced-braces "\\)?"
" *)" tuareg--whitespace-re "\\)*\\)\\(?::"
tuareg--whitespace-re "\\(" modtype-path
"\\) *\\)?\\(?:=" tuareg--whitespace-re
"\\(" extended-module-path "\\)\\)?")
(1 'font-lock-variable-name-face keep); functor (module) variable
(2 'tuareg-font-lock-module-face keep t)
(3 'tuareg-font-lock-module-face keep t))
(,(concat "\\_<functor\\> *( *\\(" uid "\\) *: *\\("
modtype-path "\\) *)")
(1 'font-lock-variable-name-face keep); functor (module) variable
(2 'tuareg-font-lock-module-face keep))
;; Other uses of "with", "mutable", "private", "virtual"
(,(regexp-opt '("of" "with" "mutable" "private" "virtual"
"global_" "local_" "exclave_")
'symbols)
(0 'font-lock-keyword-face))
;; labels
(,(concat "\\([?~]" lid "\\)" tuareg--whitespace-re ":[^:>=]")
1 'tuareg-font-lock-label-face keep)
;; label in a type signature
(,(concat "\\(?:->\\|:[^:>=]\\)" tuareg--whitespace-re
"\\(" lid "\\)[ \t]*:[^:>=]")
1 'tuareg-font-lock-label-face keep)
;; Polymorphic variants (take precedence on builtin names)
(,(concat "`" id) . tuareg-font-lock-constructor-face)
(,(regexp-opt tuareg-keywords 'symbols)
(0 'font-lock-builtin-face))
("\\[[ \t]*\\]" . tuareg-font-lock-constructor-face) ; []
("[])[:alpha:]0-9 \t]\\(::\\)[[([:alpha:]0-9 \t]" ; :: (not not ::…)
1 'tuareg-font-lock-constructor-face)
;; Constructors
(,(concat "\\(" uid "\\)[^.]") 1 'tuareg-font-lock-constructor-face)
(,(concat "\\_<let +exception +\\(" uid "\\)")
1 'tuareg-font-lock-constructor-face)
;; let-bindings (let f : type = fun)
(,(concat let-binding-g4 " *\\(" lid "\\) *\\(?:: *\\([^=]+\\)\\)?= *"
"fun\\(?:ction\\)?\\>")
(5 'font-lock-function-name-face nil t)
(6 'font-lock-type-face keep t))
;; let binding variables
(,(concat "\\(?:" let-binding-g4 "\\|" gclass-gparams "\\)")
(tuareg--pattern-vars-matcher (tuareg--pattern-pre-form-let) nil
(0 'font-lock-variable-name-face keep))
(tuareg--pattern-maybe-type-matcher nil nil ; def followed by type
(1 'font-lock-type-face keep)))
(,(concat "\\_<fun\\_>" maybe-infix-ext+attr)
(tuareg--pattern-vars-matcher (tuareg--pattern-pre-form-fun) nil
(0 'font-lock-variable-name-face keep)))
(,(concat "\\_<method!? +\\(" lid "\\)")
(1 'font-lock-function-name-face keep t); method name
(tuareg--pattern-vars-matcher (tuareg--pattern-pre-form-let) nil
(0 'font-lock-variable-name-face keep))
(tuareg--pattern-maybe-type-matcher nil nil ; method followed by type
(1 'font-lock-type-face keep)))
(,(concat "\\_<object *(\\(" lid "\\) *\\(?:: *\\("
balanced-braces "\\)\\)?)")
(1 'font-lock-variable-name-face)
(2 'font-lock-type-face keep t))
(,(concat "\\_<object *( *\\(" typevar "\\|_\\) *)")
1 'font-lock-type-face)
,@(and tuareg-font-lock-symbols
(tuareg-font-lock-symbols-keywords))))
(setq
tuareg-font-lock-keywords-1
(append common-keywords
tuareg-font-lock-keywords-1-extra))
(setq
tuareg-font-lock-keywords-2
`(,@common-keywords
;; https://caml.inria.fr/pub/docs/manual-ocaml/lex.html#infix-symbol
(,(concat "( *\\([-=<>@^|&+*/$%!]" operator-char
"*\\|[#?~]" operator-char "+\\) *)")
1 'font-lock-function-name-face)
;; By default do no highlight relation operators (=, <, >) nor
;; arithmetic operators because it is slow. However,
;; optionally allow it by popular demand.
,@(if tuareg-highlight-all-operators
;; Highlight "@", "+",... after "let…[@…]" but before
;; "let" rules remove the highlighting of "=".
`((,(concat before-operator-char
"\\([=<>@^&+*/$%!]" operator-char "*\\|:=\\|"
"[|#?~]" operator-char "+\\)")
1 'tuareg-font-lock-operator-face)
;; "-" is special: avoid "->" and "-13"
(,(concat "\\(-\\)\\(?:[^0-9>]\\|\\("
operator-char-no> operator-char "*\\)\\)")
(1 'tuareg-font-lock-operator-face)
(2 'tuareg-font-lock-operator-face keep t))
(,(regexp-opt '("type" "module" "module type"
"val" "val mutable")
'symbols)
(tuareg--pattern-equal-matcher nil nil nil)))
`((,(concat "[@^&$%!]" operator-char "*\\|"
"[|#?~]" operator-char "+")
(0 'tuareg-font-lock-operator-face))))
(,(regexp-opt
(if (tuareg-editing-ls3)
'("asr" "asl" "lsr" "lsl" "or" "lor" "and" "land" "lxor"
"not" "lnot" "mod" "fby" "pre" "last" "at")
'("asr" "asl" "lsr" "lsl" "or" "lor" "land"
"lxor" "not" "lnot" "mod"))
'symbols)
1 'tuareg-font-lock-operator-face)
,@tuareg-font-lock-keywords-1-extra)))
(setq font-lock-defaults
`((tuareg-font-lock-keywords
tuareg-font-lock-keywords-1
tuareg-font-lock-keywords-2)
nil nil
,tuareg-font-lock-syntax nil
(font-lock-syntactic-face-function
. tuareg-font-lock-syntactic-face-function)))
;; (push 'smie-backward-sexp-command font-lock-extend-region-functions)
)