;;; jmt-mode.el --- JMT Mode -*- lexical-binding: t; -*-
;; Copyright © 2019-2024 Michael Allan.
;;
;; Author: Michael Allan <mike@reluk.ca>
;; Version: 0-snapshot
;; SPDX-License-Identifier: MIT
;; Package-Requires: ((emacs "27.1"))
;; Keywords: languages, c
;; URL: http://reluk.ca/project/Java/Emacs/
;;
;; This file is not part of GNU Emacs.
;;
;; This file is released under an MIT licence. A copy of the licence normally accompanies it.
;; If not, then see `http://reluk.ca/project/Java/Emacs/LICENCE.txt`.
;;; Commentary:
;; This package implements JMT Mode, a major mode that affords better control
;; of Emacs’s Java mode, particularly in regard to syntax highlighting.
;; For more information, see `http://reluk.ca/project/Java/Emacs/`.
;;
;; Installation
;;
;; If you installed this package from MELPA using a package manager, then already JMT Mode
;; should activate for any loaded file that has either a `.java` extension or `java` shebang.
;; Alternatively, you may want to install it manually:
;;
;; 1. Put a copy of the file `jmt-mode.el` on your load path.
;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Library-Search.html
;;
;; 2. Optionally compile that copy. Load it into an Emacs buffer, for example,
;; and type `M-x emacs-lisp-byte-compile`.
;;
;; 3. Add the following code to your Emacs initialization file.
;;
;; (autoload 'jmt-mode "jmt-mode" nil t)
;; (set 'auto-mode-alist (cons (cons "\\.java\\'" 'jmt-mode) auto-mode-alist))
;; (set 'interpreter-mode-alist; For Java source-launch files encoded with a shebang. [SLS]
;; (cons (cons "\\(?:--split-string=\\|-S\\)?java" 'jmt-mode)
;; interpreter-mode-alist))
;; (register-definition-prefixes "jmt-mode" '("jmt-"))
;;
;; For a working example, see the relevant lines of `http://reluk.ca/.config/emacs/initialization.el`.
;;
;; Customization
;;
;; To see a list of customizeable faces, enter a JMT Mode buffer, or otherwise load JMT Mode,
;; and type `M-x customize-group <RET> jmt <RET>`. Alternatively, look through the `defface`
;; definitions of file `jmt-mode.el`.
;;
;; For a working example, see:
;;
;; • The author’s initialization file — http://reluk.ca/.config/emacs/initialization.el
;; • The author’s `~/.Xresources` — http://reluk.ca/.Xresources
;;
;; Changes made to Emacs
;;
;; This package applies monkey patches to the runtime session that redefine parts of built-in packages
;; CC Mode and Font Lock. The patches are applied on first entrance to JMT Mode. Most of them apply
;; to function definitions, in which case they are designed to leave the behaviour of Emacs unchanged
;; in all buffers except those running JMT Mode. The patched functions are:
;;
;; c-before-change
;; c-fontify-recorded-types-and-refs
;; c-font-lock-<>-arglists
;; c-font-lock-declarations
;; c-font-lock-doc-comments
;; font-lock-fontify-region-function
;;
;; Moreover, one variable is patched:
;;
;; javadoc-font-lock-doc-comments - To allow for upper case letters in Javadoc block tags.
;;; Code:
;; The `Package-Requires` version of Emacs (above) was obtained from `package-lint-current-buffer`.
(eval-when-compile (require 'cl-lib)); Built into Emacs since version 24.3.
(require 'cc-mode); Among other programming modes, it defines Java Mode.
;;; https://www.gnu.org/software/emacs/manual/html_node/ccmode/index.html
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; P r e l i m i n a r y d e c l a r a t i o n s
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
(defun jmt-make-Javadoc-tag-facing (f)
"Make a face property for a Javadoc tag using face F (symbol) as a base."
(list f 'font-lock-doc-face)); [PJF]
(defconst jmt-name-character-set "[:alnum:]_$"
"The set of characters from which a Java identifier may be formed.")
;;; https://docs.oracle.com/javase/specs/jls/se15/html/jls-3.html#jls-3.8
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; D e c l a r a t i o n s i n l e x i c o g r a p h i c o r d e r
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
(defgroup delimiter-faces nil
"Faces for Java separators and other delimiters."
:group 'jmt
:prefix "jmt-")
(defgroup javadoc-faces nil
"Faces for Java API descriptions."
:group 'jmt
:prefix "jmt-")
(defgroup jmt nil
"A major mode affording better control of Emacs's Java mode."
:group 'languages :group 'faces
:prefix "jmt-"
:tag "JMT"
:link '(url-link "http://reluk.ca/project/Java/Emacs/"))
(defface jmt-angle-bracket `((t . (:inherit jmt-bracket)))
"The face for an angle bracket, \\=`<\\=` or \\=`>\\=`."
:group 'delimiter-faces)
(defface jmt-annotation-delimiter; This non-replacement face inherits from `c-annotation-face` only
;;; for sake of `jmt-is-annotation-terminal-face` and replacement subface `jmt-annotation-mark`.
`((t . (:inherit c-annotation-face)))
"The face for the \\=`@\\=`, \\=`(\\=` and \\=`)\\=` delimiters of annotation.
Customize it to better distinguish the delimiters from the content
they delimit; making them more prominent or less prominent, for example.
See also `jmt-delimiter' and the faces that inherit from it."
:group 'delimiter-faces)
(defface jmt-annotation-mark; [RF]
`((t . (:inherit jmt-annotation-delimiter)))
"The face for the \\=`@\\=` symbol denoting annotation."
:group 'delimiter-faces)
(defface jmt-annotation-package-name; [MDF, RF]
`((t . (:inherit jmt-package-name)))
"The face for each segment of a package name in an annotation type reference.
It defaults to `jmt-package-name'; customize it if the default fits poorly
with your other annotation faces."
:group 'jmt)
(defface jmt-annotation-string; [BC, LF, RF]
`((t . (:inherit font-lock-string-face)))
"The face for a string in an annotation qualifier.
It defaults to `font-lock-string-face'; customize it if the default fits poorly
with your other annotation faces."
:group 'jmt)
(defface jmt-annotation-string-delimiter; [BC, LF, RF]
`((t . (:inherit jmt-string-delimiter)))
"The face for a string delimiter in an annotation qualifier.
It defaults to `jmt-string-delimiter'; customize it if the default fits poorly
with your other annotation faces."
:group 'delimiter-faces)
(defface jmt-annotation-qualifier `((t . (:inherit c-annotation-face)))
"The face for the element assignments of annotation.
Customize it e.g. to give the assignments less prominence
than the `c-annotation-face' of the preceding type name."
:group 'jmt)
(defface jmt-block-tag-name; [NDF, RF]
`((t . (:inherit jmt-Javadoc-tag-name)))
"The face for the proper identifier of a Javadoc block tag."
:group 'javadoc-faces)
(defconst jmt-block-tag-name-f (jmt-make-Javadoc-tag-facing 'jmt-block-tag-name))
(defface jmt-block-tag-parameter; [CI]
`((t . (:inherit font-lock-doc-face)))
"The face for a non-descriptive parameter of a Javadoc block tag.
See also subfaces `jmt-param-tag-parameter' and `jmt-throws-tag-parameter'."
:group 'javadoc-faces)
(defface jmt-boilerplate-keyword; [MDF, RF]
`((t . (:inherit jmt-principal-keyword)))
"The face for the keyword of a formal Java declaration in the preamble of a compilation unit."
:group 'keyword-faces)
(defface jmt-bracket `((t . (:inherit jmt-delimiter)))
"The face for a bracket.
See also `jmt-angle-bracket', `jmt-curly-bracket', `jmt-round-bracket' and `jmt-square-bracket'."
:group 'delimiter-faces)
(defun jmt--c-put-face-tamed (beg end face)
"Call `c-put-font-lock-face' with BEG END constrained to a valid region.
The given region is never constrained when `jmt-mode' is inactive, in which
case the call is simply passed through as \\=`c-put-font-lock-face BEG END FACE\\=`.
Otherwise, before calling \\=`c-put-font-lock-face\\=`, BEG and END are clipped
to the region presently under fontification by Font Lock."
(defvar jmt--is-level-3); [FV]
(defvar jmt--present-fontification-beg)
(defvar jmt--present-fontification-end)
(if (and jmt--is-level-3
(eq major-mode 'jmt-mode))
(progn
(setq beg (max beg jmt--present-fontification-beg)
end (min end jmt--present-fontification-end))
(when (< beg end) (c-put-font-lock-face beg end face)))
(c-put-font-lock-face beg end face)))
(defun jmt--c-put-face-unless-wild (beg end face)
"Call `c-put-font-lock-face' on condition BEG END delimits a valid region.
The given region is always judged valid when `jmt-mode' is inactive, in which
case the call is simply passed through as \\=`c-put-font-lock-face BEG END FACE\\=`.
Otherwise the call is passed through only if BEG and END lie within the region
presently under fontification by Font Lock."
(defvar jmt--is-level-3); [FV]
(defvar jmt--present-fontification-beg)
(defvar jmt--present-fontification-end)
(if (and jmt--is-level-3
(eq major-mode 'jmt-mode))
(unless (or
(> end jmt--present-fontification-end)
(< beg jmt--present-fontification-beg))
(c-put-font-lock-face beg end face))
(c-put-font-lock-face beg end face)))
(defface jmt-curly-bracket `((t . (:inherit jmt-bracket)))
"The face for a curly bracket, \\=`{\\=` or \\=`}\\=`."
:group 'delimiter-faces)
(defface jmt-delimiter nil
"The face for a delimiter not already faced by Java Mode.
Customize it to better distinguish the delimiters from the content they delimit;
making them more prominent or less prominent, for example. See also subfaces
`jmt-bracket', `jmt-separator'. And for delimiters that *are* already faced
by Java Mode, see `jmt-annotation-delimiter', `jmt-annotation-mark',
`jmt-string-delimiter' and `font-lock-comment-delimiter-face'."
:group 'delimiter-faces)
(defvar jmt--early-initialization-was-begun nil)
(defface jmt-expression-keyword; [MDF, RF]
`((t . (:inherit jmt-principal-keyword)))
"The face for the keyword of an operator or other element of a formal Java expression."
:group 'keyword-faces)
(defvar jmt-f); [GVF]
(defun jmt-faces-are-equivalent (f1 f2)
"Tell whether Java Mode should treat face symbols F1 and F2 as equivalent."
(eq (jmt-untamed-face f1) (jmt-untamed-face f2))); [RF]
(defface jmt-HTML-end-tag-name; [NDF, RF]
`((t . (:inherit jmt-HTML-tag-name)))
"The face for the tag name in the end tag of an HTML element in a Javadoc comment."
:group 'javadoc-faces)
(defconst jmt-HTML-end-tag-name-f (jmt-make-Javadoc-tag-facing 'jmt-HTML-end-tag-name))
(defface jmt-HTML-start-tag-name; [NDF, RF]
`((t . (:inherit jmt-HTML-tag-name)))
"The face for the tag name in the start tag of an HTML element in a Javadoc comment."
:group 'javadoc-faces)
(defconst jmt-HTML-start-tag-name-f (jmt-make-Javadoc-tag-facing 'jmt-HTML-start-tag-name))
(defface jmt-HTML-tag-name; [NDF, RF]
`((t . (:inherit jmt-Javadoc-tag-name)))
"The face for the tag name of an HTML element in a Javadoc comment.
See also subfaces `jmt-HTML-start-tag-name' and `jmt-HTML-end-tag-name'."
:group 'javadoc-faces)
(defconst jmt-identifier-pattern (concat "[" jmt-name-character-set "]+")
"The regular-expression pattern of a Java identifier.")
(defface jmt-inline-rendered-parameter; [NDF, RF]
`((t . (:inherit jmt-inline-tag-parameter)))
"The face for a rendered parameter of a Javadoc in-line tag.
One that appears more-or-less literally in the resulting Javadocs, that is."
:group 'javadoc-faces)
(defconst jmt-inline-rendered-parameter-f (jmt-make-Javadoc-tag-facing 'jmt-inline-rendered-parameter))
(defface jmt-inline-tag-name; [NDF, RF]
`((t . (:inherit jmt-Javadoc-tag-name)))
"The face for the proper identifier of a Javadoc in-line tag."
:group 'javadoc-faces)
(defconst jmt-inline-tag-name-f (jmt-make-Javadoc-tag-facing 'jmt-inline-tag-name))
(defface jmt-inline-tag-parameter; [NDF, RF]
`((t . (:inherit jmt-Javadoc-tag)))
"The face for a parameter of a Javadoc in-line tag, or attribute of an HTML tag.
See also subface `jmt-inline-rendered-parameter'. And for block tags,
see `jmt-block-tag-parameter'."
:group 'javadoc-faces)
(defconst jmt-inline-tag-parameter-f (jmt-make-Javadoc-tag-facing 'jmt-inline-tag-parameter))
(defun jmt-is-annotation-ish-before (p)
"Tell whether the position before P (integer) might be within annotation."
(let ((f (get-text-property (1- p) 'face)))
(or (eq 'c-annotation-face (jmt-untamed-face f))
(eq 'jmt-annotation-string f)
(eq 'jmt-annotation-string-delimiter f)
(eq 'jmt-annotation-package-name f); A package name in an annotation type reference.
(and (eq 'jmt-separator f) (= ?. (char-before p)))))); A dot `.` in the package name.
(defun jmt-is-annotation-terminal-face (f)
"Tell whether face F (symbol) might occur on the last character of annotation."
(eq 'c-annotation-face (jmt-untamed-face f)))
(defun jmt-is-Java-Mode-tag-faced (p)
"Tell whether face property P (symbol or list) might occur on a Javadoc tag."
(and (consp p); Testing for precisely `(font-lock-doc-markup-face font-lock-doc-face)`. [PJF]
(eq 'font-lock-doc-markup-face (car p))
(eq 'font-lock-doc-face (car (setq p (cdr p))))
(null (cdr p))))
(defun jmt-is-Java-Mode-type-face (f)
"Tell whether face F (symbol) is a type face that Java Mode might have set."
(eq f 'font-lock-type-face)); Java Mode sets this face alone.
(defvar-local jmt--is-level-3 nil); An in-buffer cache of this boolean flag. It works only because any
;;; ‘customization of `font-lock-maximum-decoration` should be done *before* the file is visited’.
;;; https://www.gnu.org/software/emacs/manual/html_node/emacs/Font-Lock.html
(defun jmt-is-type-declarative-keyword (s)
"Tell whether string S is the principal keyword of a type declaration."
(or (string= s "class")
(string= s "interface")
(string= s "enum")
(string= s "record")));
(defun jmt-is-type-modifier-keyword (s)
"Tell whether string S is a type declaration modifier in keyword form."
;; Keyword form as opposed e.g. to annotation form, that is."
;; `ClassModifier` https://docs.oracle.com/javase/specs/jls/se15/html/jls-8.html#jls-8.1.1
;; `InterfaceModifier` https://docs.oracle.com/javase/specs/jls/se15/html/jls-9.html#jls-9.1.1
(or (string= s "public")
(string= s "final")
(string= s "static")
(string= s "private")
(string= s "abstract")
(string= s "protected")
(string= s "srictfp")))
(defface jmt-Javadoc-outer-delimiter; [CI]
`((t . (:inherit font-lock-doc-face)))
"The face for the outer delimiters of a Javadoc comment.
These comprise the outermost delimiters \\=`/**\\=` and \\=`*/\\=` that between
them contain the Javadoc comment, and the left-marginal asterisks \\=`*\\=`
that may lead any of its lines. Customize this face to better distinguish
these delimiters from the content they delimit; making them more prominent
or less prominent, for example."
:group 'delimiter-faces :group 'javadoc-faces)
(defface jmt-Javadoc-tag; [NDF, RF]
`((t . (:inherit font-lock-doc-markup-face)))
"The face for a Javadoc or HTML tag embedded in a Javadoc comment.
It inherits from `font-lock-doc-markup-face'; customize it to distinguish
Javadoc tags from other constructs that use `font-lock-doc-markup-face'.
See also subfaces `jmt-Javadoc-tag-delimiter', `jmt-Javadoc-tag-name'
and `jmt-inline-tag-parameter'."
:group 'javadoc-faces)
(defface jmt-Javadoc-tag-delimiter; [NDF, RF]
`((t . (:inherit jmt-Javadoc-tag)))
"The face for the delimiters of a Javadoc tag.
These comprise the \\=`@\\=`, \\=`{\\=` and \\=`}\\=` delimiters of a Javadoc tag,
and the \\=`<\\=`, \\=`</\\=`, \\=`/>\\=` and \\=`>\\=` delimiters of an HTML tag.
Customize this face to better distinguish these delimiters from the content
they delimit; making them more prominent or less prominent, for example.
See also subface `jmt-Javadoc-tag-mark'."
:group 'javadoc-faces)
(defconst jmt-Javadoc-tag-delimiter-f (jmt-make-Javadoc-tag-facing 'jmt-Javadoc-tag-delimiter))
(defface jmt-Javadoc-tag-mark; [NDF, RF]
`((t . (:inherit jmt-Javadoc-tag-delimiter)))
"The face for the \\=`@\\=` symbol denoting a Javadoc tag."
:group 'javadoc-faces)
(defconst jmt-Javadoc-tag-mark-f (jmt-make-Javadoc-tag-facing 'jmt-Javadoc-tag-mark))
(defface jmt-Javadoc-tag-name; [NDF, RF]
`((t . (:inherit jmt-Javadoc-tag)))
"The face for the proper identifier of a Javadoc or HTML tag.
See also subfaces `jmt-block-tag-name', `jmt-inline-tag-name'
and `jmt-HTML-tag-name'."
:group 'javadoc-faces)
(defconst jmt-Javadoc-tag-name-f (jmt-make-Javadoc-tag-facing 'jmt-Javadoc-tag-name))
(defun jmt-keyword-face (keyword beg end)
"The face (symbol) proper to a Java KEYWORD (string).
The keyword extends from buffer position BEG (number, inclusive)
to END (exclusive). Point is left indeterminate."
(defvar jmt-keyword-face-alist); [FV]
(let ((f (assoc keyword jmt-keyword-face-alist)))
(if (not f) 'jmt-principal-keyword; Giving either a default face,
(setq f (cdr f)) ; or, from `jmt-keyword-face-alist`,
(if (not (functionp f)) f ; a face either directly named
(funcall f beg end))))) ; or got from a named function.
(defconst jmt-keyword-face-alist
'(
;; Frequent
;; ────────
("assert" . jmt-principal-keyword); Of a statement.
;;; ("boolean" . jmt-type-keyword); (but faced rather as a type by Java Mode)
("break" . jmt-principal-keyword); Of a statement.
("else" . jmt-principal-keyword); Of a statement clause.
("final" . jmt-qualifier-keyword)
("if" . jmt-principal-keyword); Of a statement.
("import" . jmt-boilerplate-keyword)
;;; ("int" . jmt-type-keyword); (but faced rather as a type by Java Mode)
;;; ("long" . jmt-type-keyword); (but faced rather as a type by Java Mode)
("private" . jmt-qualifier-keyword)
("public" . jmt-qualifier-keyword)
("return" . jmt-principal-keyword); Of a statement.
("static" . jmt-keyword-face-static); (q.v.)
;; Infrequent; typically a few times per buffer
;; ──────────
("abstract" . jmt-qualifier-keyword)
("case" . jmt-principal-keyword); Of a statement clause.
("catch" . jmt-principal-keyword); Of a statement clause.
;;; ("char" . jmt-type-keyword); (but faced rather as a type by Java Mode)
("class" . jmt-keyword-face-class); (q.v.)
("continue" . jmt-principal-keyword); Of a statement.
("default" . jmt-keyword-face-default); (q.v.)
;;; ("float" . jmt-type-keyword); (but faced rather as a type by Java Mode)
("for" . jmt-principal-keyword); Of a statement.
("new" . jmt-expression-keyword)
("protected" . jmt-qualifier-keyword)
("super" . jmt-expression-keyword)
("synchronized" . jmt-keyword-face-sync); (q.v.)
("this" . jmt-expression-keyword)
("throw" . jmt-principal-keyword); Of a statement.
("throws" . jmt-qualifier-keyword)
("try" . jmt-principal-keyword); Of a statement.
;;; ("void" . jmt-type-keyword); (but faced rather as a type by Java Mode)
("while" . jmt-principal-keyword); Of a statement.
;; Rare; typically once per buffer, if at all
;; ────
;;; ("_" . jmt-misused-keyword); (reserved, yet unfaced by Java Mode)
;;; ("byte" . jmt-type-keyword); (but faced rather as a type by Java Mode)
("const" . jmt-qualifier-keyword); (but reserved)
("enum" . jmt-principal-keyword); Of a type declaration.
("do" . jmt-principal-keyword); Of a statement.
;;; ("double" . jmt-type-keyword); (but faced rather as a type by Java Mode)
("extends" . jmt-qualifier-keyword)
("finally" . jmt-principal-keyword); Of a statement clause.
("goto" . jmt-principal-keyword); Of a statement (but reserved)
("implements" . jmt-qualifier-keyword)
("instanceof" . jmt-expression-keyword)
("interface" . jmt-principal-keyword); Of a type declaration.
("native" . jmt-qualifier-keyword)
("package" . jmt-boilerplate-keyword)
("record" . jmt-principal-keyword); Of a type declaration.
;;; ("short" . jmt-type-keyword); (but faced rather as a type by Java Mode)
("strictfp" . jmt-qualifier-keyword)
("switch" . jmt-principal-keyword); Of a statement.
("transient" . jmt-qualifier-keyword)
("volatile" . jmt-qualifier-keyword))
"An alist relating Java keywords to their proper facing.
The car of each entry is a Java keyword (string), while the cdr is either
its proper face (symbol) or a function in the form of `jmt-keyword-face-class'
that gives a face symbol. The list excludes the keywords that Java Mode
does not face with `font-lock-keyword-face'.")
(defun jmt-keyword-face-class (beg _end)
"The face (symbol) proper to a \\=`class\\=` keyword.
The keyword extends from buffer position BEG (number, inclusive)
to _END (exclusive). Point is left indeterminate."
(goto-char beg)
(forward-comment most-negative-fixnum); [â†CW]
(if (eq ?. (char-before)); [NCE]
'jmt-expression-keyword
;;; https://docs.oracle.com/javase/specs/jls/se15/html/jls-15.html#jls-ClassLiteral
'jmt-principal-keyword)); Of a type declaration.
(defun jmt-keyword-face-default (_beg end)
"The face (symbol) proper to a \\=`default\\=` keyword.
The keyword extends from buffer position _BEG (number, inclusive)
to END (exclusive). Point is left indeterminate."
(goto-char end)
(forward-comment most-positive-fixnum); [CW→]
(let ((c (char-after)))
(if (or (eq ?: c) (eq ?- c)); [NCE]
'jmt-principal-keyword; Of a `switch` statement clause.
;;; https://docs.oracle.com/javase/specs/jls/se15/html/jls-14.html#jls-14.11
'jmt-qualifier-keyword))); Of an interface method declaration.
(defun jmt-keyword-face-static (beg end)
"The face (symbol) proper to a \\=`static\\=` keyword.
The keyword extends from buffer position BEG (number, inclusive)
to END (exclusive). Point is left indeterminate."
(goto-char beg)
(forward-comment most-negative-fixnum); [â†CW]
(setq end (point)); The presumed end of the preceding keyword.
(if (and (< (skip-chars-backward jmt-name-character-set) 0)
(string= "import" (buffer-substring-no-properties (point) end)))
'jmt-boilerplate-keyword; In a static import declaration. [SI]
'jmt-qualifier-keyword)); Elsewhere.
(defun jmt-keyword-face-sync (_beg end)
"The face (symbol) proper to a \\=`synchronized\\=` keyword.
The keyword extends from buffer position _BEG (number, inclusive)
to END (exclusive). Point is left indeterminate."
(goto-char end)
(forward-comment most-positive-fixnum); [CW→]
(if (eq ?\( (char-after)); [NCE]
'jmt-principal-keyword; Of a statement.
;;; https://docs.oracle.com/javase/specs/jls/se15/html/jls-14.html#jls-14.19
'jmt-qualifier-keyword))
(defvar jmt--late-initialization-was-begun nil)
;; jmt-make-Javadoc-tag-facing (defined above in § Preliminary declarations)
(cl-assert (fboundp 'jmt-make-Javadoc-tag-facing))
(defun jmt-message (format-string &rest arguments)
"Call ``message' FORMAT-STRING ARGUMENTS` without translating embedded quotes.
Any quote characters \\=`\\=`\\=` or \\=`\\='\\=` in the FORMAT-STRING are output as is."
(message "%s" (apply #'format format-string arguments)))
;; jmt-name-character-set (defined above in § Preliminary declarations)
(cl-assert (boundp 'jmt-name-character-set))
(defface jmt-named-literal; [MDF, RF]
`((t . (:inherit font-lock-constant-face)))
"The face for literal of type boolean or null; namely \\=`true\\=`, \\=`false\\=` or \\=`null\\=`.
It inherits from `font-lock-constant-face'; customize it to distinguish named
literals from other constructs that use `font-lock-constant-face', or to subdue
the facing if you prefer to have these literals not stand out."
:group 'jmt)
(defun jmt-new-fontifiers-2 ()
"Build a `font-lock-keywords' list for fast, untamed highlighting.
See also `java-font-lock-keywords-1', which is for minimal untamed highlighting."
(java-font-lock-keywords-2)); [L2U]
(defun jmt-new-fontifiers-3 ()
"Build a `font-lock-keywords' list for accurate, tamed highlighting."
(defvar jmt-specific-fontifiers-3); [FV]
(nconc
;; Underlying Java Mode fontifiers, lightly modified
;; ───────────────────────────────
(let* ((kk (java-font-lock-keywords-3)); List of Java Mode’s fontifiers.
was-found-annotation; Whether the annotation fontifier of was found in `kk`.
(k kk); Current fontifier element of `kk`.
k-last); Previous fontifier element.
(while; Searching the list, fontifier by fontifier.
(progn
(if (equal (car k) '(eval list "\\<\\(@[a-zA-Z0-9]+\\)\\>" 1 c-annotation-face))
;; Dud fontifier: works under Java Mode, fails under JMT Mode unless
;; changed in two places `"\\_<\\(@[a-zA-Z0-9]+\\)\\>" 1 c-annotation-face t`.
(progn; 1 ↑ 2 ↑
;; Moreover its pattern does not cover the complete, valid form of annotation.
;; Therefore `jmt-new-fontifiers-3` adds a more general, replacement fontifier.
(setq was-found-annotation t)
(setcdr k-last (cdr k))); Deleting this one here in case somehow it starts working
(setq k-last k ; and interferes with the replacement.
k (cdr k)))
(and (not was-found-annotation) k)))
(unless was-found-annotation
(jmt-message "(jmt-mode): Failed to remove unwanted Java Mode fontifier: `%s` = nil"
(symbol-name 'was-found-annotation)))
kk)
;; Overlying fontifiers to tame them
;; ────────────────────
jmt-specific-fontifiers-3))
(defvar jmt-p); [GVF]
(defface jmt-package-name; [MDF, RF]
`((t . (:inherit font-lock-constant-face)))
"The face for each segment of a package name in a type reference.
It inherits from `font-lock-constant-face'; customize it to distinguish
package names from other constructs that use `font-lock-constant-face'."
:group 'jmt)
(defface jmt-package-name-declared; [MDF, RF]
`((t . (:inherit jmt-package-name)))
"The face for each segment of a package name in a package declaration.
Customize it to better distinguish between a package name appearing
in that context versus one appearing in a type reference."
:group 'jmt)
(defface jmt-param-tag-parameter `((t . (:inherit jmt-block-tag-parameter)))
"The face for the parameter-name parameter of a Javadoc `param` tag.
An exception applies to type parameters; for those, see instead
`jmt-type-variable-tag-parameter'."
:group 'javadoc-faces)
(defun jmt--patch (source source-name-base function-symbol patch-function)
"Apply a source-based monkey patch to function FUNCTION-SYMBOL.
You must call \\=`jmt--patch\\=` from a temporary buffer syntactically equivalent
to a buffer in Emacs Lisp mode. It monkey-patches the function denoted
by FUNCTION-SYMBOL, originally defined in file SOURCE (with SOURCE-NAME-BASE
as its `file-name-base'). For this, it uses the named PATCH-FUNCTION,
which must give t on success and nil on failure."; [ELM]
(condition-case x
(progn
;; Verify assumptions
;; ──────────────────
(unless (functionp function-symbol)
(signal 'jmt-x `("No such function loaded" ,function-symbol)))
(let ((load-file (symbol-file function-symbol)))
(unless (string= (file-name-base load-file) source-name-base)
(signal 'jmt-x `("Function loaded from file of base name contradictory to source file"
,function-symbol ,load-file ,source))))
(let ((function-name (symbol-name function-symbol))
beg function-name-beg function-name-end patched-function-name patched-function-symbol)
;; Restrict the temporary buffer to the function definition alone
;; ─────────────────────────────
(goto-char (point-min))
(unless (re-search-forward
(concat "^(defun[[:space:]\n]+\\(" function-name "\\)[[:space:]\n]*(") nil t)
(signal 'jmt-x `("Function definition not found in source file" ,source ,function-symbol)))
(setq beg (match-beginning 0)
function-name-beg (match-beginning 1)
function-name-end (match-end 1))
(narrow-to-region beg (scan-lists beg 1 0))
;; Patch the function definition
;; ─────────────────────────────
(goto-char beg)
(unless (funcall patch-function)
(signal 'jmt-x `("Patch failed to apply" ,function-symbol)))
;; Load the patched function under a new name
;; ─────────────────────────
(setq patched-function-name (concat "jmt-advice/" function-name))
(delete-region function-name-beg function-name-end)
(goto-char function-name-beg)
(insert patched-function-name)
(eval-buffer)
;; Remove the buffer restriction
;; ─────────────────────────────
;;; (delete-region beg (point-max)); Removing the definition, in hope it speeds later patching.
;;;;;; The deletion time is too likely to exceed the time saved.
(widen); Undoing the `narrow-to-region` above.
;; Replicate the compilation state of the original function
;; ───────────────────────────────
(setq patched-function-symbol (intern-soft patched-function-name))
(cl-assert patched-function-symbol); Avoiding a silent failure.
(when (byte-code-function-p (symbol-function function-symbol))
(run-with-idle-timer; Compile during idle time. This might improve package load times,
1.3 nil ; though early tests (with a single patch) showed no such effect.
(lambda ()
(unless (byte-compile patched-function-symbol)
(jmt-message
"(jmt-mode): Patched function `%s` is running uncompiled" function-name)))))
;; Replace the original function with the patched version
;; ──────────────────────────────────────────────────────
(advice-add function-symbol :override patched-function-symbol)))
;; Recover from failure, if any
;; ────────────────────
(jmt-x
(widen); Undoing any `narrow-to-region` still in effect above.
(delay-warning 'jmt-mode (error-message-string x) :error)))); [DW]
(defun jmt-preceding->-marks-generic-return-type ()
"Tell whether the \\=`>\\=` before point might terminate a generic return type.
Point is left indeterminate."
(when
(condition-case nil
(progn (forward-sexp -1) t); Move backward to the front of the leading delimiter.
(scan-error nil))
(forward-comment most-negative-fixnum); [â†CW]
(not (eq (char-before) ?.)))); [NCE]
;;; Here a `.` would indicate a call to the method, as opposed to its declaration.
(defvar jmt--present-fontification-beg 0)
(defvar jmt--present-fontification-end 0); Non-zero only when Font Lock is fontifying via
;;; the global `font-lock-fontify-region-function`.
(defface jmt-principal-keyword; [MDF, RF]
`((t . (:inherit font-lock-keyword-face)))
"The face for the principal keyword of a declaration, statement or clause.
Cf. `jmt-qualifier-keyword'. See also subfaces
`jmt-boilerplate-keyword' and `jmt-expression-keyword'."
:group 'keyword-faces)
(defvar jmt-q); [GVF]
(defface jmt-qualifier-keyword; [MDF, RF]
`((t . (:inherit font-lock-keyword-face)))
"The face for a secondary keyword in a declaration.
Cf. `jmt-principal-keyword'."
:group 'keyword-faces)
(defface jmt-round-bracket `((t . (:inherit jmt-bracket)))
"The face for a round bracket, \\=`(\\=` or \\=`)\\=`."
:group 'delimiter-faces)
(defface jmt-separator `((t . (:inherit jmt-delimiter)))
"The face for a comma \\=`,\\=` semicolon \\=`;\\=` colon \\=`:\\=` or dot \\=`.\\=` separator."
:group 'delimiter-faces)
(defun jmt-set-for-buffer (variable value)
"Set buffer-local VARIABLE (a symbol) to VALUE.
Signal an error if the binding is not actually buffer-local.
This might happen, for example, if an externally defined VARIABLE
that was documented as being buffer-local no longer is."
(set variable value)
(cl-assert (local-variable-p variable)))
(defface jmt-shebang `((t . (:inherit font-lock-comment-delimiter-face)))
"The face for a shebang \\=`#!\\=`."
:group 'shebang-faces)
(defface jmt-shebang-body `((t . (:inherit font-lock-comment-face)))
"The face for the body of a shebang line.
The body excludes the shebang itself and any trailing comment."
:group 'shebang-faces)
(defface jmt-shebang-comment `((t . (:inherit font-lock-comment-face)))
"The face for the body of a trailing comment in a shebang line.
Such a comment may appear in case of an \\=`env\\=` interpreter."
:group 'shebang-faces
:link '(url-link "https://www.gnu.org/software/coreutils/manual/html_node/env-invocation.html"))
(defface jmt-shebang-comment-delimiter
`((t . (:inherit font-lock-comment-delimiter-face)))
"The face for the delimiter \\=`\\c\\=` of a trailing comment in a shebang line.
Such a comment may appear in case of an \\=`env\\=` interpreter."
:group 'shebang-faces
:link '(url-link "https://www.gnu.org/software/coreutils/manual/html_node/env-invocation.html"))
(defconst jmt-specific-fontifiers-3
(list
;; â•â•â•â•â•â•â•â•â•â•
;; Annotation [A, T↓]
;; â•â•â•â•â•â•â•â•â•â•
(list; Fontify each instance of annotation, overriding any misfontification of Java Mode.
(lambda (limit)
(catch 'to-fontify
(let ((m1-beg (point)); Presumed start of leading annotation mark `@`.
(m1-beg-limit (1- limit)); Room for two characters, the minimal length.
eol face m1-end m2-beg m2-end m3-beg m3-end m4-beg m4-end m5-beg m5-end)
(while (< m1-beg m1-beg-limit)
(setq m1-end (1+ m1-beg))
(if (/= ?@ (char-after m1-beg))
(setq m1-beg m1-end)
(goto-char m1-end)
(catch 'is-annotation
(when (eolp) (throw 'is-annotation nil)); [SL]
(while; Capture as group 2 the simple annotation name.
(progn
(skip-syntax-forward "-" limit); Though unconventional, whitespace is allowed
;;; between `@` and name. Nevertheless this fontifier excludes newlines; also
;;; commentary, which would be perverse here, not worth coding for. [AST, SL]
(setq m2-beg (point))
(skip-chars-forward jmt-name-character-set limit)
(setq m2-end (point))
(unless (< m2-beg m2-end) (throw 'is-annotation nil))
(setq face (get-text-property m2-beg 'face))
(if (eq face 'font-lock-constant-face); [P↓] Then the (mis)captured name should
(progn; be dot terminated, so forming a segment of a package name. [PPN]
(skip-syntax-forward "-" limit); [SL]
(unless (eq ?. (char-after)); [NCE]
(throw 'is-annotation nil))
(forward-char); Past the `.`.
t); Continuing the loop, so skipping past this segment of the name.
(unless (or (null face); The most common case. Else a misfontification:
(eq face 'font-lock-function-name-face); This one occurs in the case,
;;; for instance, of an empty `()` annotation qualifier.
(jmt-is-Java-Mode-type-face face)); [T↓]
(throw 'is-annotation nil))
nil))); Quitting the loop, having matched the simple annotation name.
(skip-syntax-forward "-" limit); [SL]
(when (eq ?\( (char-after)); [NCE]
(setq m3-beg (point); Start of trailing qualifier, it would be.
eol (line-end-position))
(condition-case nil
(progn
(forward-list 1)
(setq m5-end (point))); End of qualifier. Point now stays here.
(scan-error
(setq m5-end (point-max)))); Forcing the qualifier to be ignored below.
(if (> m5-end eol); The qualifier crosses lines, or a `scan-error` occured above.
(goto-char m2-end); Ignoring it. [SL]
;; Qualified
;; ─────────
(setq m3-end (1+ m3-beg); `(`
m4-beg m3-end
m5-beg (1- m5-end); `)`
m4-end m5-beg)
(set-match-data (list m1-beg m5-end m1-beg m1-end m2-beg m2-end m3-beg m3-end
m4-beg m4-end m5-beg m5-end (current-buffer)))
(goto-char m5-end)
(throw 'to-fontify t))); With point (still) at `m5-end` as Font Lock stipulates.
;; Unqualified
;; ───────────
(set-match-data (list m1-beg m2-end m1-beg m1-end m2-beg m2-end (current-buffer)))
(goto-char m2-end)
(throw 'to-fontify t))
(setq m1-beg (point)))))
nil))
'(1 'jmt-annotation-mark t) '(2 'c-annotation-face t) '(3 'jmt-annotation-delimiter t t)
'(4 'jmt-annotation-qualifier nil t) '(5 'jmt-annotation-delimiter t t))
;; â•â•â•â•â•â•â•
;; Keyword [K, T↓]
;; â•â•â•â•â•â•â•
(cons; Reface each Java keyword as defined in `jmt-keyword-face-alist`.
(let (match-beg match-end)
(lambda (limit)
(setq match-beg (point)); Presumptively.
(catch 'to-reface
(while (< match-beg limit)
(setq match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (eq 'font-lock-keyword-face (get-text-property match-beg 'face))
(setq jmt-f (jmt-keyword-face
(buffer-substring-no-properties match-beg match-end) match-beg match-end))
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'to-reface t))
(setq match-beg match-end))
nil)))
'(0 jmt-f t))
(cons; Fontify each `assert` and `record` keyword that was misfaced by Java Mode, or left unfaced.
(let (f match-beg)
(lambda (limit)
(catch 'to-reface
(while (re-search-forward "\\_<\\(?:assert\\|record\\)\\_>" limit t)
(setq match-beg (match-beginning 0)
f (get-text-property match-beg 'face))
(when (or (null f) (jmt-is-Java-Mode-type-face f)); [T↓]
;;; Misfacing as a type name has been seen for both `assert` and `record` keywords.
;;; For an instance of `assert` misfacing, see `assert stators.getClass()`. [AM]
;;; [https://github.com/Michael-Allan/waymaker/blob/3eaa6fc9f8c4137bdb463616dd3e45f340e1d34e/waymaker/gen/KittedPolyStatorSR.java#L58]
;;; More commonly the `assert` keyword is left unfaced, but no instance of this
;;; has been seen in the case of the `record` keyword.
(setq jmt-f (jmt-keyword-face (match-string-no-properties 0) match-beg (match-end 0)))
(throw 'to-reface t)))
nil)))
'(0 jmt-f t))
;; â•â•â•â•â•â•â•â•â•
;; Type name [↑K, T]
;; â•â•â•â•â•â•â•â•â•
(cons; Unface each terminal token of a static import incorrectly faced as a type name by Java Mode.
(let (i j)
(lambda (limit)
(setq i (point)); Presumptively.
(catch 'to-reface
(while (< i limit)
(setq j (next-single-property-change i 'face (current-buffer) limit))
(when (and (eq 'jmt-boilerplate-keyword (get-text-property i 'face)); [↑K]
(string= "static" (buffer-substring-no-properties i j)))
(goto-char j)
(when (and (re-search-forward
(concat "[[:space:]\n." jmt-name-character-set "]+\\_>"
;;; └───────────────────────────────────────┘
;;; TypeName [SI]
"\\.\\(" jmt-identifier-pattern "\\);")
;;; · └──────────────────────┘ ·
;;; dot Identifier ;
limit t)
(jmt-is-Java-Mode-type-face (get-text-property (match-beginning 1) 'face)))
(throw 'to-reface t)))
(setq i j))
nil)))
'(1 'default t))
(list; Reface each Java type name using either `jmt-type-declaration` or `jmt-type-reference`.
(lambda (limit)
(catch 'to-reface
(while (< (point) limit)
(let* ((match-beg (point)); Presumptively.
(match-end (next-single-property-change match-beg 'face (current-buffer) limit)))
(when (jmt-is-Java-Mode-type-face (get-text-property match-beg 'face))
(forward-comment most-negative-fixnum); [â†CW]
;; Either defining a type
;; ───────────────
(when; Keyword `class`, `enum`, `record` or `interface` directly precedes the type name.
(let ((p (point)))
(and (< (skip-chars-backward jmt-name-character-set) 0)
(jmt-is-type-declarative-keyword (buffer-substring-no-properties (point) p))))
(setq jmt-f 'jmt-type-declaration)
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'to-reface t))
;; Or referring to one already defined
;; ────────────
(setq jmt-f 'jmt-type-reference)
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'to-reface t))
(goto-char match-end)))
nil))
'(0 jmt-f t t))
;; Type declaration
;; ────────────────
(cons; Face each name of a type declaration that was misfaced or left unfaced by Java Mode.
(lambda (limit)
(catch 'to-face
(while (< (point) limit)
(let* ((p (point))
(match-end (next-single-property-change p 'face (current-buffer) limit))
f keyword match-beg)
(when (and (eq 'jmt-principal-keyword (get-text-property p 'face)); [↑K]
(jmt-is-type-declarative-keyword
(setq keyword (buffer-substring-no-properties (point) match-end))))
(goto-char match-end)
(forward-comment most-positive-fixnum); [CW→]
(setq match-beg (point)); Presumptively.
(when (and (< match-beg limit)
(> (skip-chars-forward jmt-name-character-set limit) 0)); A name follows.
(setq f (get-text-property match-beg 'face))
(cond
;; Record declaration
;; ──────────────────
((and (string= keyword "record") ; Always it is misfaced as
(eq f 'font-lock-function-name-face)); a function declaration.
(set-match-data (list match-beg (point) (current-buffer)))
(throw 'to-face t))
;; Other type declaration, viz. based on a `class`, `enum` or `interface` keyword
;; ──────────────────────
((not f); The type name is unfaced (misfacing has not been seen)
(setq match-end (point))
(let ((annotation-count 0))
(goto-char p); Back to the type-declarative keyword.
(forward-comment most-negative-fixnum); [â†CW]
(when (eq (char-before (point)) ?@); [NCE] A `@` marks this declaration
(backward-char); as that of an annotation type. Move back past the `@`.
(forward-comment most-negative-fixnum)); [â†CW]
(catch 'is-modifier; Thrown as nil on discovery the answer is negative.
(while t; Now point should (invariant) be directly after such a modifier. So test:
(when (eq (char-before (point)) ?\)); [NCE] Presumeably a list
(condition-case nil ; of annotation parameters.
(forward-sexp -1); Skip to the front of it.
(scan-error (throw 'is-modifier nil)))
(forward-comment most-negative-fixnum)); [â†CW]
;;; Holding still the (would be) loop invariant.
(setq p (point))
(when (zerop (skip-chars-backward jmt-name-character-set))
(throw 'is-modifier nil))
;; The modifier should be either a keyword or annotation.
(if (jmt-is-type-modifier-keyword (buffer-substring-no-properties (point) p))
;; Keyword, the modifier is a keyword
;; ───────
(if (zerop annotation-count)
(forward-comment most-negative-fixnum); [â†CW]
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'to-face t)); The keyword precedes annotation. With this,
;;; Java Mode fails at times to face the type name. This was seen,
;;; for instance, here in the sequence `public @ThreadSafe class ID`.
;;; [https://github.com/Michael-Allan/waymaker/blob/3eaa6fc9f8c4137bdb463616dd3e45f340e1d34e/waymaker/spec/ID.java#L8`]
;;; It seems Java Mode expects to find keywords *before* annotation,
;;; which, although it ‘is customary’, is nevertheless ‘not required’.
;;; [https://docs.oracle.com/javase/specs/jls/se15/html/jls-8.html#jls-8.1.1]
;;; Here therefore the missing face is applied.
;; Annotation, the modifier is an annotation modifier, or should be
;; ──────────
(forward-comment most-negative-fixnum); [â†CW]
;;; A form unconventional, but allowed. [AST]
(unless (eq (char-before (point)) ?@); [NCE]
(throw 'is-modifier nil))
(setq annotation-count (1+ annotation-count))
(backward-char); To before the `@`.
(forward-comment most-negative-fixnum))))))))); [â†CW]
(goto-char match-end)))
nil))
'(0 'jmt-type-declaration t))
;; Formal catch parameter [FCP]
;; ──────────────────────
(let (eol match-beg match-end); Face each type identifier and parameter identifier
(list ; left unfaced by Java Mode.
;; anchor, the whole parameter declaration, aka `CatchFormalParameter` [FCP]
;; ┈┈┈┈┈┈
(lambda (limit); (anchoring matcher)
(setq match-beg (point)); Presumptively.
(catch 'to-face
(while (< match-beg limit)
(setq match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (and (eq 'jmt-principal-keyword (get-text-property match-beg 'face)); [↑K]
(string= "catch" (buffer-substring-no-properties match-beg match-end)))
(goto-char match-end)
(setq eol (line-end-position))
(forward-comment most-positive-fixnum); To the opening paranthesis `(`. [CW→]
(catch 'needs-facing; Thrown as nil on discovery the answer is negative.
(unless (eq ?\( (char-after)); [NCE]
(throw 'needs-facing nil)); Malformed catch block.
(forward-char); Past the `(`.
(forward-comment most-positive-fixnum); To the start of the parameter declaration. [CW→]
(setq match-beg (point))
(up-list); To just after the closing paranthesis `)`.
(unless (eq ?\) (char-before)); On `up-list` error, ‘point is unspecified.’ [NCE]
(throw 'needs-facing nil)); Malformed catch block.
(when (or (> (point) eol); [SL]
(> (point) limit))
(throw 'needs-facing nil)); Out of bounds.
(backward-char); Before the `)`.
(forward-comment most-negative-fixnum); To the end of the parameter declaration. [â†CW]
(setq match-end (point)) ; Thence to the start of parameter identifier:
(when (zerop (skip-chars-backward jmt-name-character-set))
(throw 'needs-facing nil)); Malformed catch block.
(when (get-text-property (point) 'face)
;; Already faced, in which case Java Mode always faces the type identifier(s), too.
(throw 'needs-facing nil))
(set-match-data (list match-beg match-end (point) match-end (current-buffer)))
(goto-char match-end)
(setq jmt-p match-beg; Saving the anchor’s bounds.
jmt-q match-end)
(throw 'to-face t)))
(setq match-beg match-end))
nil))
;; parameter identifier
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
'(1 'font-lock-variable-name-face); (regular highlighter)
;; type identifiers
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
(list; (anchored highlighter)
;; ii) define matches, popping the bounds of each segment from (i)
(lambda (limit); (anchored matcher)
(catch 'to-face
(while (re-search-forward jmt-identifier-pattern limit t)
(let ((beg (match-beginning 0))
(case-fold-search nil))
;; Aside from the sought type identifiers, all that could match here is already faced,
;; either by Java Mode or the preceding highlighter (parameter identifier), with one
;; exception, an edge case in which Java Mode leaves a package qualifier unfaced.
;; Assuming ∴ that package names begin in lower case [BUG], these guards should suffice.
(when (and (null (get-text-property beg 'face)); Unfaced, and the first character is
(string-match-p "[[:upper:]]" (char-to-string (char-after beg)))); upper case.
(throw 'to-face t))))
nil))
;; i) pre-position to the start of the parameter declaration
'(progn; (pre-form)
(goto-char jmt-p); To `match-beg` of the anchor effectively.
jmt-q); Limiting the search region (∵ return value is > point) effectively to `match-end`.
;; iv) clean up, recovering the proper position
'(goto-char jmt-q); (post-form) To `match-end` effectively.
;; iii) reface each matched identifier
'(0 'jmt-type-reference))))
;; â•â•â•â•â•â•â•â•â•â•â•â•
;; Package name, or a type name misfaced as such [↑A, ↑K, P, T]
;; â•â•â•â•â•â•â•â•â•â•â•â•
;; Package declaration
;; ───────────────────
(let; Reface each name segment of a package declararation using face `jmt-package-name-declared`.
(face last-seg-was-found match-beg match-end)
(list
(lambda (limit); (1) Anchoring on the `package` keyword that begins each declaration.
(setq match-beg (point)); Presumptively.
(catch 'is-package-declaration
(while (< match-beg limit)
(setq match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (and (eq 'jmt-boilerplate-keyword (get-text-property match-beg 'face)); [↑K]
(string= "package" (buffer-substring-no-properties match-beg match-end)))
(setq last-seg-was-found nil)
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'is-package-declaration t))
(setq match-beg match-end))
nil))
(list; (2, anchored highlighter) Thence scanning rightward for each name segment.
(lambda (limit)
(catch 'to-reface
(when last-seg-was-found (throw 'to-reface nil)); The last segment was already refaced.
(while (< (point) limit); Now point should (invariant) be before any remaining name segment,
(skip-syntax-forward "-" limit); with at most whitespace intervening. [PPN, SL]
(setq match-beg (point))
(skip-chars-forward jmt-name-character-set limit)
(setq match-end (point))
(unless (< match-beg match-end) (throw 'to-reface nil)); Malformed or multi-line. [SL]
(skip-syntax-forward "-" limit); [SL]
(if (eq ?. (char-after)); [NCE]
(forward-char); To the (would be) loop invariant.
(setq last-seg-was-found t))
(setq face (get-text-property match-beg 'face))
(when (or (null face); Java Mode leaves unfaced all but the last segment.
(eq face 'font-lock-constant-face))
(set-match-data (list match-beg (point) match-beg match-end (current-buffer)))
(throw 'to-reface t)))
nil))
nil nil '(1 'jmt-package-name-declared t))))
;; Package qualifier on an annotation type reference
;; ─────────────────
(let (match-beg match-end seg-beg seg-end); Reface each package name segment using
(list ; face `jmt-annotation-package-name`.
;; anchor, the simple type name of each annotation type reference
;; ┈┈┈┈┈┈
(lambda (limit); (anchoring matcher)
(setq match-beg (point)); Presumptively.
(catch 'is-type-ref
(while (< match-beg limit)
(setq match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (eq 'c-annotation-face (get-text-property match-beg 'face)); [↑A]
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(setq jmt-p match-beg; Saving the anchor’s bounds.
jmt-q match-end)
(throw 'is-type-ref t))
(setq match-beg match-end))
nil))
;; name segments
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈
(list; (anchored highlighter)
;; ii) define matches, popping the bounds of each segment from (i)
(lambda (limit); (anchored matcher)
(when (setq seg-beg (car jmt-f))
(set 'jmt-f (cdr jmt-f)); Popping the bounds from the stack.
(setq seg-end (car jmt-f))
(set 'jmt-f (cdr jmt-f))
(cl-assert (<= seg-end limit))
(set-match-data (list seg-beg (goto-char seg-end) (current-buffer)))
t))
;; i) seek segments leftward of the anchor, stacking the bounds of each [PPN]
'(let (seg-beg seg-end); (pre-form)
(set 'jmt-f nil); The stack of bounds, two per segment, initially empty.
(goto-char jmt-p); To `match-beg` effectively.
(while
(progn; Now point should (invariant) be after the dot delimiter of any preceding segment,
(skip-syntax-backward "-"); with at most whitespace intervening. [SL]
(when (eq ?. (char-before)); [NCE]
(backward-char); To before the dot.
(skip-syntax-backward "-"); [SL]
(setq seg-end (point))
(skip-chars-backward jmt-name-character-set)
(setq seg-beg (point))
(when (< seg-beg seg-end)
(set 'jmt-f (cons seg-end jmt-f)); Pushing the bounds to the stack.
(set 'jmt-f (cons seg-beg jmt-f))))))
jmt-p); Limiting the search region (∵ return value is > point) effectively to `match-beg`.
;; iv) clean up, recovering the proper position
'(goto-char jmt-q); (post-form) To `match-end` effectively.
;; iii) reface each matched segment
'(0 'jmt-annotation-package-name t))))
;; Package name occuring elsewhere
;; ────────────
(cons; Reface each name segment using face `jmt-package-name`, and each apparently misfaced
;;; type name using face `jmt-type-reference`.
(let (c match-beg match-end)
(lambda (limit)
(setq match-beg (point)); Presumptively.
(catch 'to-reface
(while (< match-beg limit)
(setq match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (eq 'font-lock-constant-face (get-text-property match-beg 'face))
(goto-char match-end)
(forward-comment most-positive-fixnum); [CW→, PPN]
(when (eobp) (throw 'to-reface nil))
(setq c (char-after))
(when (= ?. c)
(setq jmt-f
(if (string= "Lu" (get-char-code-property (char-after match-beg) 'general-category))
'jmt-type-reference; Workaround for a probable misfacing by Java Mode.
;;; It occurs e.g. with a type name qualifying a reference to a type member,
;;; e.g. `Foo.BAR` or `Foo.Bar`. Java Mode misfaces the type name (`Foo`) as
;;; a package name segment. This workaround assumes that a real segment would
;;; begin in lower case, an assumption that itself is not quite correct. [BUG]
'jmt-package-name))
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'to-reface t))
(when (= ?< c) ; Then it cannot be a name segment. Rather it is likely
(setq jmt-f 'jmt-type-reference ); a type name qualifying a reference to a type member.
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'to-reface t)))
(setq match-beg match-end))
nil)))
'(0 jmt-f t))
;; â•â•â•â•â•â•â•â•â•
;; Delimiter
;; â•â•â•â•â•â•â•â•â•
(cons; Face each Java delimiter that was left unfaced by Java Mode.
(let (i j match-beg match-end)
(lambda (limit)
(setq match-beg (point)); Presumptively.
(set
'jmt-f
(catch 'face
(while (< match-beg limit)
(setq i (syntax-after match-beg)
j (car i); Numeric syntax code.
match-end (1+ match-beg))
(when (or (= j 4) (= j 5)); When it has bracket syntax, that is.
(setq j (cdr i)); The character of the opposing bracket.
;; Angle bracket
;; ─────────────
(when (or (= j ?<)
(= j ?>))
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'face 'jmt-angle-bracket))
;; Curly bracket
;; ─────────────
(when (or (= j ?{)
(= j ?}))
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'face 'jmt-curly-bracket))
;; Round bracket
;; ─────────────
(when (or (= j ?\()
(= j ?\)))
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'face 'jmt-round-bracket))
;; Square bracket
;; ──────────────
(when (or (= j ?\[)
(= j ?\]))
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'face 'jmt-square-bracket)))
;; Separator
;; ─────────
(setq j (char-after match-beg))
(when (or (= j ?,)
(= j ?\;)
(= j ?:)
(= j ?.))
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'face 'jmt-separator))
(setq match-beg match-end))
nil))))
'(0 jmt-f))
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; Javadoc comment
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; Outer delimiter
;; ───────────────
(cons; Reface each Javadoc outermost delimiter `/**` using face `jmt-Javadoc-outer-delimiter`.
(let (p)
(lambda (limit)
(catch 'to-reface
(while (search-forward "/**" limit t)
(setq p (match-beginning 0))
(when (and (eq 'font-lock-doc-face (get-text-property p 'face)); When inside is a Javadoc,
(or (= p (point-min)) ; but outside is not.
(not (eq 'font-lock-doc-face (get-text-property (1- p) 'face)))))
(throw 'to-reface t)))
nil)))
'(0 'jmt-Javadoc-outer-delimiter prepend)); [PJF]
(cons; Reface each Javadoc left-marginal delimiter `*` using face `jmt-Javadoc-outer-delimiter`.
(lambda (limit)
(catch 'to-reface
(while (re-search-forward "^\\s-*\\(\\*\\)" limit t)
(when (eq 'font-lock-doc-face (get-text-property (match-beginning 1) 'face))
(throw 'to-reface t)))
nil))
'(1 'jmt-Javadoc-outer-delimiter prepend)); [PJF]
(cons; Reface each Javadoc outermost delimiter `*/` using face `jmt-Javadoc-outer-delimiter`.
(let (p)
(lambda (limit)
(catch 'to-reface
(while (search-forward "*/" limit t)
(setq p (match-end 0))
(when (and (eq 'font-lock-doc-face (get-text-property (1- p) 'face)); When inside is,
(or (= p (point-max)) ; but outside is not, a Javadoc.
(not (eq 'font-lock-doc-face (get-text-property p 'face)))))
(throw 'to-reface t)))
nil)))
'(0 'jmt-Javadoc-outer-delimiter prepend)); [PJF]
;; In-Line tag
;; ───────────
(list; Reface each Javadoc in-line tag. [JIL]
(let (match-beg tag-name)
(lambda (limit)
(defvar jmt-value-tag-name-f); [FV]
(catch 'to-reface
(while (re-search-forward
(concat "\\({\\)\\s-*\\(@\\)\\s-*\\([[:alnum:]]+\\)"; This search might be made
;;; · · └──────────────┘ more reliable. [JIL]
;;; { @ tag name
"\\(?:\\s-+\\([^[:space:]}\n]+\\)\\)?\\(?:\\s-+\\([^}\n]*\\)\\)?\\(}\\)"); [SL]
;;; └──────────────────┘ └─────────┘ ·
;;; parameters 1, 2, … }
limit t)
(setq match-beg (match-beginning 0))
(when (and (jmt-is-Java-Mode-tag-faced (get-text-property match-beg 'face))
(>= (match-end 0); And that facing is uniform.
(next-single-property-change match-beg 'face (current-buffer) limit)))
(setq tag-name (match-string-no-properties 3))
(cond ((or (string= tag-name "link")
(string= tag-name "linkplain"))
(setq jmt-f jmt-inline-tag-name-f
jmt-p jmt-inline-tag-parameter-f
jmt-q jmt-inline-rendered-parameter-f))
((string= tag-name "value")
(setq jmt-f jmt-value-tag-name-f
jmt-p jmt-inline-tag-parameter-f; (if any)
jmt-q jmt-inline-tag-parameter-f))
((or (string= tag-name "code")
(string= tag-name "index")
(string= tag-name "literal")
(string= tag-name "summary"))
(setq jmt-f jmt-inline-tag-name-f
jmt-p jmt-inline-rendered-parameter-f
jmt-q jmt-inline-tag-parameter-f)); (if any)
(t; All the rest.
(setq jmt-f jmt-inline-tag-name-f
jmt-p jmt-inline-tag-parameter-f; (if any)
jmt-q jmt-inline-tag-parameter-f)))
(throw 'to-reface t)))
nil)))
'(1 jmt-Javadoc-tag-delimiter-f t) '(2 jmt-Javadoc-tag-mark-f t)
'(3 jmt-f t) '(4 jmt-p t t) '(5 jmt-q t t) '(6 jmt-Javadoc-tag-delimiter-f t))
;; HTML tag
;; ────────
(list; Reface each HTML tag.
(let (match-beg match-end)
(lambda (limit)
(setq match-beg (point)); Presumptively.
(catch 'to-reface
(while (< match-beg limit)
(setq match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (and (= ?< (char-after match-beg))
(jmt-is-Java-Mode-tag-faced (get-text-property match-beg 'face)))
(goto-char match-beg)
(save-restriction
(narrow-to-region match-beg match-end)
;; End tag
;; ───────
(when (looking-at "\\\(./\\)\\([[:alnum:]]+\\)\\(\\s-*\\)\\(>\\)$"); `$` [NBE]
;;; └────┘ └──────────────┘ ·
;;; </ tag name >
(setq jmt-f jmt-HTML-end-tag-name-f
jmt-p jmt-inline-tag-parameter-f); (actually this is just space, if present)
(goto-char match-end)
(throw 'to-reface t))
;; Start tag
;; ─────────
(when (looking-at "\\(.\\)\\([[:alnum:]]+\\)\\(\\s-.*\\)?\\(/?>\\)$"); `$` [NBE]
;;; · └──────────────┘ └────────┘ · ·
;;; < tag name attributes / >
(setq jmt-f jmt-HTML-start-tag-name-f
jmt-p jmt-inline-tag-parameter-f); (or maybe just space, if present at all)
(goto-char match-end)
(throw 'to-reface t))))
(setq match-beg match-end))
nil)))
'(1 jmt-Javadoc-tag-delimiter-f t) '(2 jmt-f t) '(3 jmt-p t t) '(4 jmt-Javadoc-tag-delimiter-f t))
;; Block tag
;; ─────────
(let; Reface each Javadoc block tag. [JBL]
(match-beg match-end tag-name)
(list
(lambda (limit); (1) Anchoring on the `@` mark and name that begins each tag.
(setq match-beg (point)); Presumptively.
(catch 'to-reface
(while (< match-beg limit)
(setq match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (and (= ?@ (char-after match-beg))
(jmt-is-Java-Mode-tag-faced (get-text-property match-beg 'face)))
(goto-char match-beg)
(save-restriction
(narrow-to-region match-beg match-end)
(when (looking-at "\\(.\\)\\([[:alnum:]]+\\)$"); `$` [NBE]
;;; · └──────────────┘
;;; @ tag name
(setq tag-name (match-string-no-properties 2))
(goto-char match-end)
(throw 'to-reface t))))
(setq match-beg match-end))
nil))
'(1 jmt-Javadoc-tag-mark-f t) '(2 jmt-block-tag-name-f t)
(list; (2, anchored highlighter) Thence rightward, refacing any parameter that needs it.
(lambda (_limit)
(catch 'to-reface
(cond
((string= tag-name "param")
(when (looking-at (concat "\\s-+<\\s-*\\([" jmt-name-character-set "]+\\).*$"))
(setq jmt-f 'jmt-type-variable-tag-parameter)
(goto-char (match-end 0))
(throw 'to-reface t))
(when (looking-at (concat "\\s-+\\([" jmt-name-character-set "]+\\).*$"))
(setq jmt-f 'jmt-param-tag-parameter)
(goto-char (match-end 0))
(throw 'to-reface t)))
((string= tag-name "see")
(when (looking-at "\\s-+\\([^<\n].*\\)$"); Excepting an HTML tag.
(setq jmt-f 'jmt-block-tag-parameter)
(goto-char (match-end 0))
(throw 'to-reface t)))
((or (string= tag-name "throws")
(string= tag-name "exception"))
(when (looking-at (concat "\\s-+\\([." jmt-name-character-set "]+\\).*$"))
(setq jmt-f 'jmt-throws-tag-parameter)
(goto-char (match-end 0))
(throw 'to-reface t)))
((or (string= tag-name "uses")
(string= tag-name "provides"))
(when (looking-at "\\s-+\\([^[:space:]\n]+\\).*$")
(setq jmt-f 'jmt-block-tag-parameter)
(goto-char (match-end 0))
(throw 'to-reface t)))
((or (string= tag-name "since")
(string= tag-name "author")
(string= tag-name "version"))
(when (looking-at "\\s-+\\([^[:space:]\n].+\\)$")
(setq jmt-f 'jmt-block-tag-parameter)
(goto-char (match-end 0))
(throw 'to-reface t)))
((string= tag-name "serial")
(when (looking-at "\\s-+\\(\\(?:ex\\|in\\)clude\\)\\s-*$")
(setq jmt-f 'jmt-block-tag-parameter)
(goto-char (match-end 0))
(throw 'to-reface t)))
((string= tag-name "serialField")
(when (looking-at (concat "\\s-+\\([" jmt-name-character-set
"]+\\s-+[" jmt-name-character-set "]+\\).*$"))
(setq jmt-f 'jmt-block-tag-parameter)
(goto-char (match-end 0))
(throw 'to-reface t))))
nil))
nil nil '(1 jmt-f prepend)))); [PJF]
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; Method or constructor identifier [↑A, ↑K, ↑T]
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
(cons; Fontify each identifier that was misfaced by Java Mode, or incorrectly left unfaced.
(let (face i match-beg match-end predecessor-end)
(lambda (limit)
(set
'jmt-f
(catch 'face
(while (re-search-forward jmt-identifier-pattern limit t)
(setq match-beg (match-beginning 0); Presumptively.
match-end (match-end 0)
face (get-text-property match-beg 'face))
(when (or (null face) (eq face 'font-lock-function-name-face)
(eq face 'jmt-type-reference)); [↑T]
;;; Vanguard, redundant but for sake of speed. See the other face guards below.
(forward-comment most-positive-fixnum); [CW→]
(and; Any nil evaluation among the following advances `while` to the next identifier.
(eq ?\( (char-after)); Else this identifier names neither a method nor contructor. [NCE]
;; Constructor declaration
;; ───────────────────────
;; Or some cases of method declaration in need; this section may fontify those, too,
;; just because it happens to precede the method declaration section, below.
(catch 'goto-next
(setq predecessor-end nil); [◦↓◦]
(unless (or (null face) (eq face 'jmt-type-reference)); [↑T]
(throw 'goto-next t)); Only identifiers left unfaced
;;; or misfaced as type references have been seen. See for instance
;;; the sequences `public @Warning("non-API") ApplicationX()` at
;;; `https://github.com/Michael-Allan/waymaker/blob/3eaa6fc9f8c4137bdb463616dd3e45f340e1d34e/waymaker/gen/ApplicationX.java#L23`,
;;; and `ID( final String string, final int cN ) throws MalformedID` at
;;; `https://github.com/Michael-Allan/waymaker/blob/3eaa6fc9f8c4137bdb463616dd3e45f340e1d34e/waymaker/spec/ID.java#L30`.
;; After the identifier, in any parameter list
;; ·····················
(forward-char); Past the `(`.
(forward-comment most-positive-fixnum); [CW→]
(setq i (point))
(when (> (skip-chars-forward jmt-name-character-set) 0)
(when (string= "final" (buffer-substring-no-properties i (point)))
(goto-char match-end)
(throw 'face 'font-lock-function-name-face))
(catch 'is-past-package; Leaving `i` at either the next token to deal with,
(while t; or the buffer end, scan past any itervening package name.
;; Now point lies (invariant) directly after a name (in form).
(forward-comment most-positive-fixnum); [CW→, PPN]
(when (eobp) (throw 'is-past-package t))
(unless (= ?. (char-after)) ; Namely the delimiting dot of a
(throw 'is-past-package t)); preceding package name segment.
(forward-char); Past the `.`.
(forward-comment most-positive-fixnum); [CW→] To the next token.
(setq i (point)); What follows the package name follows its last dot.
(when (zerop (skip-chars-forward jmt-name-character-set))
(throw 'is-past-package t)))))
(when (and (/= i (point-max))
(or (= ?@ (char-after i))
(eq (get-text-property i 'face) 'jmt-type-reference))); [↑T]
(goto-char match-end)
(throw 'face 'font-lock-function-name-face))
;; Before the identifier
;; ·····················
(goto-char match-beg)
(forward-comment most-negative-fixnum); [â†CW]
(when (bobp) (throw 'goto-next nil)); Skip any remaining §§.
(setq predecessor-end (point)); [◦↓◦]
;;; (when (= (char-before) ?>)
;;; (if (jmt-preceding->-marks-generic-return-type)
;;; (goto-char match-end)
;;; (throw 'face 'font-lock-function-name-face)
;;; (throw 'goto-next t)))
;;;;;;;;; Disabled pending resolution of several problems: 1) Point is left indeterminate
;;; by the call to `jmt-preceding->-marks-generic-return-type`, breaking the code
;;; that follows; 2) nominally a call to `jmt-preceding->-marks-generic-return-type`
;;; makes no sense for constructors which necessarily declare no return type;
;;; and 3) the same code may end up running redundantly in the section that follows.
;; A constructor modifier here before point would also indicate a declaration.
;; However, the earlier test of `final` (above) has eliminated the only case
;; in which Java Mode is known to fail when a keyword modifier appears here.
;; That leaves only the case of an *annotation* modifier to remedy.
(when (jmt-is-annotation-terminal-face (get-text-property (1- (point)) 'face)); [↑A]
(goto-char match-end)
(throw 'face 'font-lock-function-name-face))
t)
;; Method declaration
;; ──────────────────
(catch 'goto-next
(when face (throw 'goto-next t))
;;; No misfaced definitions have been seen, only unfaced. For instance,
;;; see the sequence `public @Override @Warning("non-API") void onCreate()`.
;;; [https://github.com/Michael-Allan/waymaker/blob/3eaa6fc9f8c4137bdb463616dd3e45f340e1d34e/waymaker/gen/ApplicationX.java#L40]
(if predecessor-end; [◦↕◦]
(goto-char predecessor-end)
(goto-char match-beg)
(forward-comment most-negative-fixnum); [â†CW]
(when (bobp) (throw 'goto-next nil)); Skip any remaining §§.
(setq predecessor-end (point)))
(setq i (char-before)); The predecessor would have to be the method’s return type.
(when (= i ?\]); Return type declared as an array.
(goto-char match-end)
(throw 'face 'font-lock-function-name-face))
(when (= i ?>)
(if (jmt-preceding->-marks-generic-return-type)
(goto-char match-end)
(throw 'face 'font-lock-function-name-face)
(throw 'goto-next t)))
;; The return type may be declared simply by a type name.
(setq i (get-text-property (1- (point)) 'face))
(when (eq i 'jmt-type-reference); [↑T]
(goto-char match-end); Indeed it appears to be a type name.
(throw 'face 'font-lock-function-name-face))
(unless i; What would be the return type has been left unfaced by Java Mode.
;;; Maybe ∵ it became confused by prior annotation? Try moving there:
(when (< (skip-chars-backward jmt-name-character-set) 0)
(forward-comment most-negative-fixnum); [â†CW]
(when (jmt-is-annotation-terminal-face (get-text-property (1- (point)) 'face)); [↑A]
(goto-char match-end); Indeed annotation precedes what would be the return type.
(throw 'face 'font-lock-function-name-face))))
t)
;; Method call
;; ───────────
(catch 'goto-next
(unless (eq face 'font-lock-function-name-face) (throw 'goto-next t))
;;; Only calls misfaced as declarations have been seen.
(if predecessor-end; [◦↑◦]
(goto-char predecessor-end)
(goto-char match-beg)
(forward-comment most-negative-fixnum); [â†CW]
(when (bobp) (throw 'goto-next nil))); Skip any remaining §§.
(when; When the possibility of the method identifier being proper to a declaration
;; as opposed to a call is excluded because it directly follows either: [AM]
(or (= (char-before) ?.)
;;; (a) The character `.`, as in the sequence `assert stators.getClass()` at
;;; `https://github.com/Michael-Allan/waymaker/blob/3eaa6fc9f8c4137bdb463616dd3e45f340e1d34e/waymaker/gen/KittedPolyStatorSR.java#L58`.
(eq (get-text-property (1- (point)) 'face) 'jmt-principal-keyword)); [↑K]
;;; (b) A principal keyword, as in the sequence `assert verify(blocks)` at
;;; `https://github.com/oracle/graal/blob/968c592cc6c1b3e6ee6b23b086adbc3c5007e6be/compiler/src/org.graalvm.compiler.core.common/src/org/graalvm/compiler/core/common/cfg/DominatorOptimizationProblem.java#L52`.
(goto-char match-end)
(throw 'face 'default))
t))
(goto-char match-end))); Whence the next leg of the search begins.
nil))))
'(0 jmt-f t))
;; â•â•â•â•â•â•â•â•â•â•â•â•â•
;; Named literal
;; â•â•â•â•â•â•â•â•â•â•â•â•â•
(cons; Reface each literal of type boolean or null.
(let (m match-beg match-end)
(lambda (limit)
(setq match-beg (point)); Presumptively.
(catch 'to-reface
(while (< match-beg limit)
(setq match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (eq 'font-lock-constant-face (get-text-property match-beg 'face))
(setq m (buffer-substring-no-properties match-beg match-end))
(when (or (string= "true" m) (string= "false" m) (string= "null" m))
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'to-reface t)))
(setq match-beg match-end))
nil)))
'(0 'jmt-named-literal t))
;; â•â•â•â•â•â•â•â•â•â•â•â•
;; Shebang line, as described in `http://openjdk.java.net/jeps/330#Shebang_files`
;; â•â•â•â•â•â•â•â•â•â•â•â•
(list; Fontify any shebang line in a source-launch file.
"\\`\\(#!\\)\\(.+?\\)\\(?:\\(\\\\c\\)\\(.*\\)\\)?$"
;;; · └─────┘ └───────────────────────┘
;;; #! body comment [CSL]
'(1 'jmt-shebang t) '(2 'jmt-shebang-body t) '(3 'jmt-shebang-comment-delimiter t t)
'(4 'jmt-shebang-comment t t))
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; String literal [↑A]
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•
(list; Refontify each Java string literal using face `jmt-string-delimiter`,
;;; `or faces jmt-annotation-string` and `jmt-annotation-string-delimiter`.
(let (body-beg body-end f match-beg match-end)
(lambda (limit)
(setq match-beg (point)); Presumptively.
(catch 'to-refontify
(while (< match-beg limit)
(setq match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (eq 'font-lock-string-face (get-text-property match-beg 'face))
(setq body-beg (1+ match-beg)
body-end (1- match-end)
f (get-text-property match-end 'face))
(if (or (eq f 'jmt-annotation-delimiter); A rough test only, it could fail. [↑A, BUG]
(eq f 'jmt-annotation-qualifier))
(progn
;; Within annotation
;; ─────────────────
(setq jmt-f 'jmt-annotation-string-delimiter)
(set-match-data (list match-beg match-end match-beg body-beg body-beg body-end
body-end match-end (current-buffer))))
;; Elsewhere
;; ─────────
(setq jmt-f 'jmt-string-delimiter)
;;; (when (>= (- match-end match-beg) 7); Then hypothesize a text block.
;;; (let* ((body-beg? (+ match-beg 3)); Allowing for the longer delimiters.
;;; (body-end? (- match-end 3))
;;; (beg-delimiter (buffer-substring-no-properties match-beg body-beg?))
;;; (end-delimiter (buffer-substring-no-properties match-end body-end?))
;;; (expected "\"\"\"")); In fact `beg-delimiter` would have to end in a newline
;;; ;;; optionally preceded by whitespace, hence the 7 in the guard above.
;;; (when (and (string= beg-delimiter expected) (string= end-delimiter expected))
;;; (setq body-beg body-beg?; Hypothesis verified.
;;; body-end body-end?))))
;;;;;; No point at present, Java Mode has stopped facing text blocks as strings. [TB]
(set-match-data (list match-beg match-end match-beg body-beg nil nil
body-end match-end (current-buffer))))
(goto-char match-end)
(throw 'to-refontify t))
(setq match-beg match-end))
nil)))
'(1 jmt-f t) '(2 'jmt-annotation-string t t) '(3 jmt-f t))
;; â•â•â•â•â•â•â•â•â•â•â•â•â•
;; Type variable in a type parameter declaration [↑A, ↑T]
;; â•â•â•â•â•â•â•â•â•â•â•â•â•
(cons; Reface each variable using face `jmt-type-variable-declaration`. See optimization note. [TV]
(let (depth i j match-beg match-end p p-min)
(lambda (limit)
(catch 'to-reface
(while (< (point) limit)
(setq match-beg (point); Presumptively.
match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (eq 'jmt-type-reference (get-text-property match-beg 'face)); [↑T]
(setq p-min (point-min))
(while; Skipping back over both any commentary and/or the annotations that
(progn; may appear here, and setting `p` to the resulting point. [TP]
(forward-comment most-negative-fixnum); [â†CW]
(setq p (point))
(if (or (= p p-min)
(not (jmt-is-annotation-ish-before p))); [↑A]
nil; Quitting the `while` loop.
(goto-char (previous-single-property-change p 'face))
t))); Continuing the loop.
(setq p (1- p)); Before what should be the delimiter of a type variable list. [TVL]
(when
(and
(>= p p-min)
(progn
(setq i (char-after p))
(or; And the character after `p` is indeed such a list delimiter, viz. one of:
(eq 'c-<-as-paren-syntax (setq j (get-text-property p 'category))); `<`
(eq 'c->-as-paren-syntax j) ; `>`
(and (eq (get-text-property p 'c-type) 'c-<>-arg-sep) ; `,`
(eq i ?,)))); Not `&`, that is. [NCE]
;;; Leaving `i` set to that delimiter character.
(catch 'is-proven; And the matched name occurs at the top level of that list (depth
;; of angle brackets 1). And the list directly follows either (a) the identifier
;; of a type declaration, indicating the declaration of a generic class or inter-
;; face, or (b) neither a type name, type variable nor `.` delimiter (of a method
;; call), indicating the declaration of a generic method or constructor. [MC]
(setq depth 1); Nested depth of name in brackets, presumed to be 1 as required.
(while; Ensure `p` has emerged from all brackets,
(progn; moving it leftward as necessary.
(cond ((= i ?<); Ascending from the present bracket pair.
(setq depth (1- depth))
(when (zerop depth); Then presumeably `p` has emerged left of list.
(goto-char p)
(forward-comment most-negative-fixnum); [â†CW]
(when (bobp) (throw 'is-proven t))
;;; Apparently a generic method or constructor declaration,
;;; though outside of any class body and so misplaced.
(setq p (1- (point)); Into direct predecessor of variable list.
i (char-after p))
(when (or (= i ?.); `.` delimiter of a method call.
(= i ?<)); Scan position `p` had *not* emerged, so the
;;; type variable is *not* at top level, after all.
(throw 'is-proven nil))
(setq j (get-text-property p 'face))
(throw 'is-proven; As the type parameter declaration of:
(or (eq 'jmt-type-declaration j); [↑T]
;;; (a) a generic class or interface declaration;
(not (eq 'font-lock-type-face
(jmt-untamed-face j)))))))
;;; (b) a generic method or constructor declaration.
((= i ?>); Descending into another bracket pair.
(setq depth (1+ depth))))
(if (= p p-min)
nil; Quitting the `while` loop.
(setq p (1- p))
(setq i (char-after p))
t))); Continuing the loop.
nil))
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'to-reface t)))
(goto-char match-end))
nil)))
'(0 'jmt-type-variable-declaration t))
;; â•â•â•â•â•â•â•â•
;; Variable identifier in a variable declaration
;; â•â•â•â•â•â•â•â•
(cons; Reface each loop-variable identifier that was misfaced by Java Mode.
(let (match-beg match-end)
(lambda (limit)
(setq match-beg (point)); Presumptively.
(catch 'to-reface
(while (< match-beg limit)
(setq match-end (next-single-property-change match-beg 'face (current-buffer) limit))
(when (eq 'font-lock-function-name-face (get-text-property match-beg 'face))
;;; Only an identifier misfaced as a function name has been seen.
(goto-char match-end)
(forward-comment most-positive-fixnum); [CW→]
(when (eobp) (throw 'to-reface nil))
(when (= ?: (char-after)); Indicating for context an enhanced `for` loop.
;;; Only here has a misfacing been seen. (And only where the expression on the
;;; right side is a function call, as with `foo` in `for( Foo foo: getFooList() )`.)
(set-match-data (list match-beg (goto-char match-end) (current-buffer)))
(throw 'to-reface t)))
(setq match-beg match-end))
nil)))
'(0 'font-lock-variable-name-face t)))
"Elements of `jmt-new-fontifiers-3' which are specific to JMT Mode.")
(defface jmt-square-bracket `((t . (:inherit jmt-bracket)))
"The face for a square bracket, \\=`[\\=` or \\=`]\\=`."
:group 'delimiter-faces)
(defface jmt-string-delimiter; [BC, LF, RF]
`((t . (:inherit font-lock-string-face)))
"The face for the delimiter of a string literal or character literal.
These are \", \"\"\" or \\='. Customize this face to better distinguish these
delimiters from the content they delimit; making them less prominent,
for example. See also `jmt-delimiter' and the faces that inherit from it."
:group 'delimiter-faces)
(defface jmt-throws-tag-parameter `((t . (:inherit jmt-block-tag-parameter)))
"The face for the type-reference parameter of a Javadoc `throws` tag."
:group 'jmt)
(defface jmt-type-declaration; [MDF, RF]
`((t . (:inherit font-lock-type-face)))
"The face for the identifier of a class or interface in a type declaration.
Customize it to highlight the identifier where initially it is defined (like
`font-lock-variable-name-face' does for variable identifiers), as opposed
to merely referenced after the fact. See also face `jmt-type-reference'."
:group 'jmt)
(defface jmt-type-reference; [MDF, RF]
`((t . (:inherit font-lock-type-face)))
"The face for the identifier in a type reference.
This is the identifier of a class, interface or type parameter (viz.
type variable) where it appears as a type reference. See also
faces `jmt-type-declaration' and `jmt-type-variable-declaration'."
:group 'jmt)
(defface jmt-type-variable-declaration; [TP, MDF, RF]
`((t . (:inherit jmt-type-declaration)))
"The face for a type variable in a type parameter declaration.
Customize it to highlight the variable where initially it is declared
\(as `font-lock-variable-name-face' does for non-type variables), rather than
merely referenced after the fact. See also face `jmt-type-reference'."
:group 'jmt)
(defface jmt-type-variable-tag-parameter; [NDF, RF]
`((t . (:inherit jmt-Javadoc-tag)))
"The face for a type variable in a Javadoc \\=`param\\=` tag."
;; Java Mode has misfaced it as an HTML tag (the two have the same delimiters). Therefore this face
;; (like `jmt-HTML-tag-name`, and unlike `jmt-param-tag-parameter`) is necessarily a replacement
;; face for `font-lock-doc-markup-face` (via `jmt-Javadoc-tag` as it happens). A better solution
;; would be to repair Java Mode’s error in order to elimate this complication. [BUG]
:group 'javadoc-faces)
(defun jmt-untamed-face (face)
"FACE itself if untamed, else its nearest untamed ancestor.
Every face defined by JMT Mode (tamed face) ultimately inherits
from an untamed ancestral face defined elsewhere."
(catch 'untamed-face
(while (string-prefix-p "jmt-" (symbol-name face))
(setq face (face-attribute face :inherit nil nil))
(when (eq 'unspecified face)
(throw 'untamed-face 'default)))
face))
(defface jmt-value-tag-name; [NDF, RF]
`((t . (:inherit jmt-inline-tag-name)))
"The face for the proper identifier \\=`value\\=` of a Javadoc value tag."
:group 'javadoc-faces)
(defconst jmt-value-tag-name-f (jmt-make-Javadoc-tag-facing 'jmt-value-tag-name))
(defgroup keyword-faces nil
"Faces for Java keywords."
:group 'jmt
:prefix "jmt-")
(defgroup shebang-faces nil
"Faces for a shebang line atop a source-launch file."
:group 'jmt
:prefix "jmt-"
:link '(url-link "http://openjdk.java.net/jeps/330#Shebang_files"))
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; P a c k a g e p r o v i s i o n
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
(unless jmt--early-initialization-was-begun
(setq jmt--early-initialization-was-begun t
c-default-style (cons '(jmt-mode . "java") c-default-style))); Setting the default style
;;; (of indentation etc.) to `java` style, the same as underlying Java Mode.
;;;###autoload (set 'auto-mode-alist (cons (cons "\\.java\\'" 'jmt-mode) auto-mode-alist))
;;;###autoload (set 'interpreter-mode-alist (cons (cons "\\(?:--split-string=\\|-S\\)?java" 'jmt-mode) interpreter-mode-alist))
;;;###autoload
(define-derived-mode jmt-mode java-mode
"JMT Mode"
"A major mode affording better control of Emacs's Java mode.
For more information, see URL `http://reluk.ca/project/Java/Emacs/'."
:group 'jmt
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; II. Late set-up, if necessary
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; Deferred till now, after loading the first Java file, not to needlessly delay the start of Emacs.
(unless jmt--late-initialization-was-begun
(setq jmt--late-initialization-was-begun t)
;; Verify assumptions
;; ──────────────────
(cl-assert (= ?> (char-syntax ?\n))); Newlines have *endcomment* syntax.
;;; (Consequently they have no whitespace syntax.)
(cl-assert parse-sexp-ignore-comments)
;; Tell Java Mode of additional faces II
;; ─────────────────────────────────────
(set 'c-literal-faces
(append c-literal-faces; [LF]
'(jmt-annotation-string
jmt-annotation-string-delimiter
jmt-string-delimiter)))
;; Apply monkey patches Adding or removing a patch below?
;; ──────────────────── Sync with §*Changes to Emacs* at top.
(define-error 'jmt-x "Broken monkey patch")
(let (source source-name-base)
(condition-case x
(progn
;; `cc-fonts` functions
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
(setq source (locate-library "cc-fonts.el" t)
source-name-base (file-name-base source))
(unless source (signal 'jmt-x `("No such source file on load path: `cc-fonts.el`")))
(with-temp-buffer; [ELM]
(setq-local parse-sexp-ignore-comments t)
(with-syntax-table emacs-lisp-mode-syntax-table
(insert-file-contents source)
;; `c-fontify-recorded-types-and-refs` [AW]
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
(jmt--patch
source source-name-base #'c-fontify-recorded-types-and-refs
(lambda ()
(let (is-patched)
(while (search-forward "(c-put-font-lock-face " nil t)
(replace-match "(jmt--c-put-face-unless-wild " t t); [SFP]
(setq is-patched t))
is-patched)))
;; `c-font-lock-<>-arglists` [AW]
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
(jmt--patch
source source-name-base #'c-font-lock-<>-arglists
(lambda ()
(let (is-patched)
(while (search-forward "(eq id-face" nil t)
(replace-match "(jmt-faces-are-equivalent id-face" t t)
(setq is-patched t))
is-patched)))
;; `c-font-lock-doc-comments` [AW]
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
(jmt--patch
source source-name-base #'c-font-lock-doc-comments
(lambda ()
(let (is-patched)
(while (search-forward "(c-put-font-lock-face " nil t)
(replace-match "(jmt--c-put-face-tamed " t t); [SFP]
(setq is-patched t))
is-patched)))
;; `c-font-lock-declarations` [AW]
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
(jmt--patch
source source-name-base #'c-font-lock-declarations
(lambda ()
(when (re-search-forward
(concat "(\\(eq\\) (get-text-property (point) 'face)[[:space:]\n]*"
"'font-lock-keyword-face)")
nil t)
(replace-match "jmt-faces-are-equivalent" t t nil 1)
t))))))
;; `c-font-lock-labels` [AW]
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
;;; (jmt--patch
;;; source source-name-base #'c-font-lock-labels
;;; (lambda ()
;;; (when (re-search-forward
;;; (concat "(\\(eq\\) (get-text-property (1- (point)) 'face)[[:space:]\n]*"
;;; "c-label-face-name)"); [FLC]
;;; nil t)
;;; (replace-match "jmt-faces-are-equivalent" t t nil 1)
;;; t))))))
;;;;;; ‘This function is only used on decoration level 2’, ∴ no patch is needed. [L2U]
(jmt-x (delay-warning 'jmt-mode (error-message-string x) :error))); [DW]
(condition-case x
(progn
;; `cc-mode` functions
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
(setq source (locate-library "cc-mode.el" t)
source-name-base (file-name-base source))
(unless source (signal 'jmt-x `("No such source file on load path: `cc-mode.el`")))
(with-temp-buffer; [ELM]
(setq-local parse-sexp-ignore-comments t)
(with-syntax-table emacs-lisp-mode-syntax-table
(insert-file-contents source)
;; `c-before-change` [AW]
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
(jmt--patch
source source-name-base #'c-before-change
(lambda (); Java Mode uses the following list of faces for a `memq` test.
(when (search-forward "'(font-lock-comment-face font-lock-string-face)" nil t)
(backward-char); Before the trailing `)`, insert their replacement faces: [BC]
(insert
" jmt-annotation-string jmt-annotation-string-delimiter jmt-string-delimiter")
t))))))
(jmt-x (delay-warning 'jmt-mode (error-message-string x) :error)))); [DW]
;; `font-lock-fontify-region-function` (global binding), typically `font-lock-default-fontify-region`
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
(advice-add
(default-value 'font-lock-fontify-region-function) :around
;;; Locally CC Mode has bound `font-lock-fontify-region-function` to `c-font-lock-fontify-region`,
;;; a function that simply calls the original (globally bound) function with an expanded region.
;;; In order to track that expansion, the present advice attaches to the globally bound function.
(lambda (function-name &rest arguments)
(let ((a arguments))
(setq jmt--present-fontification-beg (pop a)
jmt--present-fontification-end (pop a)))
(prog1 (apply function-name arguments)
(setq jmt--present-fontification-end 0)))
'((name . "jmt-advice/font-lock-fontify-region-function")
(depth . 100))); Deepest.
;; `javadoc-font-lock-doc-comments`
;; ┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈
(let* ((fontifier (nth 1 javadoc-font-lock-doc-comments)); The block tag fontifier.
(pattern (car fontifier))
(pattern-end "\\(@[a-z]+\\)"))
(condition-case x
(if (not (string-suffix-p pattern-end pattern))
(signal 'jmt-x `("Patch failed to apply" javadoc-font-lock-doc-comments))
(setq pattern (substring pattern 0 (- (length pattern-end))); Cutting `pattern-end` and
pattern (concat pattern "\\(@[a-zA-Z]+\\)")); replacing it with a version modified
;;; to allow for upper case letters, as in the standard tag `serialData`. [JBL]
(setcar fontifier pattern))
(jmt-x (delay-warning 'jmt-mode (error-message-string x) :error))))); [DW]
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; I. Early set-up
;; â•â•â•â•â•â•â•â•â•â•â•â•â•â•â•
;; Cache the decoration level in `jmt--is-level-3`, q.v.
;; ──────────────────────────
(let ((level (font-lock-value-in-major-mode font-lock-maximum-decoration)))
(setq jmt--is-level-3 (or (eq level t) (and (numberp level) (>= level 3)))))
;; Tell Java Mode of additional faces I
;; ────────────────────────────────────
(jmt-set-for-buffer
'c-maybe-decl-faces
(append c-maybe-decl-faces; [MDF]
;; Quoted individually only because `c-maybe-decl-faces` “must be evaluated (with `eval`)
;; ↙ at runtime to get the actual list of facesâ€; e.g. `(eval c-maybe-decl-faces)`.
'('jmt-annotation-package-name
'jmt-boilerplate-keyword
'jmt-expression-keyword
'jmt-named-literal
'jmt-package-name
'jmt-package-name-declared
'jmt-principal-keyword
'jmt-qualifier-keyword
'jmt-type-declaration
'jmt-type-variable-declaration
'jmt-type-reference)))
;; Define the fontification levels
;; ───────────────────────────────
(jmt-set-for-buffer 'font-lock-defaults
'((java-font-lock-keywords-1; 0 or nil The alternative values of `font-lock-keywords`,
java-font-lock-keywords-1; 1 each ordered according to the value of `font-lock-
jmt-new-fontifiers-2 ; 2 -maximum-decoration` that selects it. [MD]
jmt-new-fontifiers-3)))) ; 3 or t
(provide 'jmt-mode)
;; NOTES
;; ─────
;; ◦↓◦ Code that is order dependent with like-marked code (◦↕◦, ◦↑◦) that comes after.
;;
;; ◦↕◦ Code that is order dependent with like-marked code (◦↓◦, ◦↕◦, ◦↑◦) that comes before and after.
;;
;; ◦↑◦ Code that is order dependent with like-marked code (◦↓◦, ◦↕◦) that comes before.
;;
;; A ·· Section *Annotation* of `jmt-specific-fontifiers-3`.
;;
;; ↑A ·· Code that must execute after section *Annotation*.
;;
;; AM · This marks misfacings that likely are related. See the *assert keyword* section
;; at `http://reluk.ca/project/Java/Emacs/notes.brec.xht`.
;;
;; AST At-sign as a token. ‘It is possible to put whitespace between it and the TypeName,
;; but this is discouraged as a matter of style.’
;; https://docs.oracle.com/javase/specs/jls/se15/html/jls-9.html#jls-9.7.1
;;
;; AW · Applying a wrapper using a source-based patch (`jmt--patch`). A patch so marked either
;; replaces a call to an original function with a call to a wrapper function, or it could be
;; implemented this way making the alternatives below applicable all the same.
;; (1) One alternative would be advice on a containing function that temporarily advises the
;; original function for the duration of the call in order to wrap the call. But temporary advice
;; would be both non-trivial to code and likely to result in slower execution.
;; (2) Another alternative would be advice on a containing function that temporarily redefines
;; the original function symbol to that of the wrapper. This is infeasible, however, because the
;; wrapper call itself entails a call to the original function. [PGV]
;; In the case of patches that replace macro calls `c-put-font-lock-face` with function calls,
;; the symbol to redefine (after macro expansion) would be that of `put-text-property`, a function
;; the replacement wrapper itself would have to call (invalid self-reference). The alternative of
;; redefining the macro symbol seems infeasible, too, considering it would have to be done prior
;; to macro expansion.
;;
;; BC · `c-before-change`: Any replacement face [RF] for a face referenced by this function
;; must be included in its monkey patch.
;;
;; BUG This code is incorrect.
;;
;; CI · Conservative inheritance. This face inherits from `font-lock-doc-face` only to preserve
;; the original appearance of the fontified text in default of user action to change it,
;; and not because it is a replacement face; in fact, it is a prepended face. [PJF, RF]
;;
;; CSL A comment in a shebang line is supported by the `env` interpreter.
;; https://www.gnu.org/software/coreutils/manual/html_node/env-invocation.html
;;
;; â†CW · Backward across commentary (which in Java Mode includes newlines) and whitespace.
;;
;; CW→ Forward across commentary (including newlines) and whitespace.
;;
;; DW · Use of `display-warning` (as opposed to `delay-warning`) would cause all fontifiers
;; of JMT Mode to fail silently.
;;
;; ELM The syntax-related code that directly follows the opening of the temporary buffer effects a
;; fast simulation of Emacs Lisp mode, faster presumeably than would a call to `emacs-lisp-mode`.
;;
;; FCP Formal catch parameters, aka `CatchFormalParameter` in the language specification.
;; https://docs.oracle.com/javase/specs/jls/se15/html/jls-14.html#jls-CatchFormalParameter
;; In multi-type parameters, Java Mode tends to leave unfaced the type and variable identi-
;; fiers. https://docs.oracle.com/javase/7/docs/technotes/guides/language/catch-multiple.html
;; It does the same in rare cases of single-type catch parameter. For example, it leaves
;; unfaced both `FooException` and `x` in this catch block:``catch( @y.A FooException x ) {}`.
;; The corrective fontifier implemented here becomes unstable when annotations are attached
;; to the parameter declaration. The likely cause is Java Mode making buffer changes outside
;; the region under fontification by Font Lock. [BUG]
;;
;; FLC `font-lock-constant-face`: the Java Mode code refers to `font-lock-constant-face` indirectly
;; by way of variables `c-constant-face-name`, `c-doc-markup-face-name`, `c-label-face-name`
;; and `c-reference-face-name`.
;;
;; FV · Suppressing sporadic compiler warnings ‘reference to free variable’
;; or ‘assignment to free variable’.
;;
;; GVF A global variable for the use of fontifiers, e.g. from within forms they quote and pass
;; to Font Lock to be evaluated outside of their lexical scope.
;;
;; JBL Javadoc block tags.
;; https://docs.oracle.com/en/java/javase/13/docs/specs/javadoc/doc-comment-spec.html#block-tags
;;
;; JIL Javadoc in-line tags. Double anchoring the tag search on the bounds of a `jmt-is-Java-Mode-
;; -tag-faced` region, like the other tag fontifiers do, might make it more reliable.
;;
;; https://docs.oracle.com/en/java/javase/13/docs/specs/javadoc/doc-comment-spec.html#inline-tags
;;
;; K ·· Section *Keyword* of `jmt-specific-fontifiers-3`.
;;
;; ↑K ·· Code that must execute after section *Keyword*.
;;
;; L2U Level-two highlighting is untamed. “L2U†marks code that enforces the fact and code
;; that depends on it.
;;
;; LF · `c-literal-faces`: Any replacement face of a face listed in `c-literal-faces` must itself
;; be appended to that list. This applies only to replacement faces, not to prepended faces;
;; all tests against `c-literal-faces` are done using `c-got-face-at`, which knows how to deal
;; with prepended faces. [PJF, RF]
;;
;; MC · Method call. See `MethodInvocation` at
;; `https://docs.oracle.com/javase/specs/jls/se15/html/jls-15.html#jls-15.12`.
;;
;; MD · How the value of `font-lock-maximum-decoration` governs the value of `font-lock-keywords`
;; is described inconsistently by Emacs. See instead the `font-lock-choose-keywords` function
;; of `http://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/font-lock.el`. It verifies the cor-
;; rectness of `https://www.gnu.org/software/emacs/manual/html_node/elisp/Font-Lock-Basics.html`.
;;
;; MDF `c-maybe-decl-faces`: Any replacement face [RF] for a face listed in `c-maybe-decl-faces`
;; must itself be appended to that list.
;;
;; NBE Not `\'` to match only the buffer end. Rather `$` to include the line end in the event
;; the (narrowed) buffer happens to cross lines. [SL]
;;
;; NCE Not `char-equal` or `=`, which fail if the position is out of bounds.
;; Rather `eq` which instead gives nil in that case.
;;
;; NDF Not a declaration face, therefore it need not be appended to `c-maybe-decl-faces`. [MDF]
;; The face only appears in Javadoc comments. Meanwhile `c-maybe-decl-faces` is only used,
;; in conjunction with `c-decl-start-re`, as a bounding argument in a call to `c-find-decl-spots`.
;; [http://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/progmodes/cc-fonts.el?id=fd1b34bfba#n1490]
;; A trace in the source of both references indicates that a “decl-spot†is not something
;; that would appear in a Javadoc comment.
;;
;; P↓ · Code that must execute before section *Package name* of `jmt-specific-fontifiers-3`.
;;
;; P ·· Section *Package name* itself.
;;
;; PGV Patching via generalized variables (`setf`, `cl-letf`) as opposed to source (`jmt--patch`).
;; Where a ‘patch is just to call an alternative function’ in lieu of the original, it might
;; be implemented by applying advice that temporarily redefines the function symbol to that of
;; a replacement function. https://github.com/melpa/melpa/pull/7131#issuecomment-699530740
;; The advantage would be simpler code and a faster patch. Yet to apply this method in cases
;; where the original function must be called from within the replacement is problematic. [AW]
;; https://emacs.stackexchange.com/a/16810/21090
;;
;; PJF Prepending to the Javadoc face. In order to duplicate the behaviour of Java Mode
;; (e.g. see `jmt-is-Java-Mode-tag-faced`), a special face applied within a Javadoc comment
;; (e.g. to a Javadoc tag) must not replace the `font-lock-doc-face` of the surrounding comment,
;; but rather prepend to it. ‘If any face … but those above is used in comments, it doesn’t
;; replace them.’ http://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/progmodes/cc-fonts.el
;; See also e.g. the `prepend` value of the highlighter `override` argument.
;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Search_002dbased-Fontification.html
;;
;; PPN Parsing a package name segment. Compare with similar code elsewhere.
;;
;; RF · Replacement face: a tamed face used by JMT Mode to override and replace a face
;; earlier applied by Java Mode. Every replacement face ultimately inherits from the face
;; it replaces. Function `jmt-faces-are-equivalent` depends on this.
;;
;; SFP Stabilization of face properties. This stops the underlying Java Mode code obliterating
;; the fontifications of JMT Mode.
;;
;; SI · Static import declaration.
;; https://docs.oracle.com/javase/specs/jls/se15/html/jls-7.html#jls-7.5.3
;;
;; SL · Restricting the fontifier to a single line. Multi-line fontifiers can be hairy. [BUG]
;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Multiline-Font-Lock.html
;;
;; SLS Source-launch files encoded with a shebang.
;; https://docs.oracle.com/en/java/javase/17/docs/specs/man/java.html#using-source-file-mode-to-launch-single-file-source-code-programs
;; http://openjdk.java.net/jeps/330#Shebang_files
;;
;; For a source-launch file that has no `.java` extension, if its shebang uses `-S` instead of
;; `--split-string`, then it would have to omit the space that typically follows. If it had the
;; following shebang line, for instance, then auto-mode would fail:
;;
;; #!/usr/bin/env -S ${JDK_HOME}/bin/java --source 17
;;
;; With the above shebang, an `interpreter-mode-alist` entry would have only `-S`
;; to match against, which does not suffice to indicate a Java file. To avoid this,
;; the shebang line would have to appear as:
;;
;; #!/usr/bin/env -S${JDK_HOME}/bin/java --source 17
;;
;; Yet, while the above seems to work (GNU coreutils 8.3), omitting the space in this manner
;; is undescribed. Therefore it might be better to avoid `-S` in favour of the long form,
;; `--split-string`, which conventionally uses `=` as a separator instead of a space.
;; https://www.gnu.org/software/coreutils/manual/html_node/env-invocation.html
;;
;; T↓ · Code that must execute before section *Type name* of `jmt-specific-fontifiers-3`.
;;
;; T ·· Section *Type name* itself, or code that must execute in unison with it.
;;
;; ↑T ·· Code that must execute after section *Type name*.
;;
;; TB · Text blocks. https://docs.oracle.com/javase/specs/jls/se15/html/jls-3.html#jls-3.10.6
;;
;; Java Mode stopped facing text blocks as strings sometime between Emacs 26.3 and 27.1. [BUG]
;; Repair would likely be difficult. http://reluk.ca/project/Java/Emacs/notes.brec.xht
;;
;; TP · See `TypeParameter`. https://docs.oracle.com/javase/specs/jls/se15/html/jls-4.html#jls-4.4
;;
;; TV · Type variable in a type parameter declaration. One might think it slow to seek every
;; type reference, as this fontifier does, and test each against the form of a type variable.
;; Yet anchoring the search instead on the relatively infrequent characters that delimit type
;; variable lists, while it would reduce the number of tests, might not yield the time savings
;; one would expect; the anchoring matcher would have to extend across multiple lines and the
;; addition to `font-lock-extend-region-functions` that this entails would burden all fontifiers.
;;
;; TVL Type variable list, aka `TypeParameters`.
;; https://docs.oracle.com/javase/specs/jls/se15/html/jls-8.html#jls-8.1.2
;;; jmt-mode.el ends here