ack
e4f1307aa9
A character written in the ^...^ mnemonic form -- ^oe^, ^zz^, ^hello^ --
used to kill ktext outright: no message, no output, and an exit status
that looked like a crash because it was one. Only the forms that happen
to spell hexadecimal digits escaped, and they were right by luck rather
than by reading. Any caret form that names no character is now a located
error that quotes what was written.
A klammer may now sit inside square brackets and braces as it already
could inside parentheses, and may be followed by the punctuation that
ends a sentence: [@i word@], {@b word@}, @i word@'s. The rule is a fixed
list of characters, because none of them can occur inside a klammer name
and so none of them is ambiguous next to a delimiter. A letter still
cannot: "x@" is the named closing delimiter, so a letter before "@" has
two readings and no rule can separate them.
The abbreviations an author writes -- the hyphen form @i-word, a klammer
glued to its neighbouring punctuation -- are now recognised as author
conveniences only. They are not applied to @@ definitions or @@@ system
commands, which are written by someone who needs no such shorthand and
whose forms are already whole.
Also fixed, each of them silent: an exported shell function in the
environment broke every @eval in the document; a line break written with
@nl was destroyed when it passed through a klammer that generates a
table, printing as \textbackslash{}newline in the finished PDF; and
"kdesc --coverage" shortened its file column by comparing the spelling of
a path rather than the path, so a klammer set reached by a symbolic link
showed a full path where its neighbours showed a short one.
New in the distribution: ref/, a small klammerset that describes the
Klammermachine's own tables in Klammertext. It currently provides the
character tables -- the diacritics and the extended Latin letters -- as
klammers that render to any target, so the documentation of what can be
written cannot drift from what the machine accepts. It is early, and
will grow.
The Klammertext taxonomy now has a section on targets, describes the
@@@klammerset system command alongside the other three, and states the
precedence of "^" -- what a caret means before a letter, a digit, a
punctuation character, and a quote, in one ordered list.
(from dev 6594c7ff8c1f)
706 lines
32 KiB
EmacsLisp
706 lines
32 KiB
EmacsLisp
;;; klammertext-mode.el --- Major mode for Klammertext files -*- lexical-binding: t; -*-
|
|
|
|
;; An Emacs major mode for editing Klammertext files. It highlights:
|
|
;;
|
|
;; Text-removal ("ignore") constructs:
|
|
;; # ... remove to end of line
|
|
;; ## ... remove to end of buffer
|
|
;; #[ ... ]# remove enclosed text (nestable)
|
|
;;
|
|
;; Klammer applications:
|
|
;; @name opening delimiter + name
|
|
;; name@ named closing delimiter
|
|
;; @ bare closing delimiter
|
|
;;
|
|
;; Klammer definitions (@@), analogous to applications:
|
|
;; @@name opening delimiter + name
|
|
;; name@@ named closing delimiter
|
|
;; @@ bare closing delimiter
|
|
;;
|
|
;; System/target commands (@@@), analogous again:
|
|
;; @@@name opening delimiter + name
|
|
;; name@@@ named closing delimiter
|
|
;; @@@ bare closing delimiter
|
|
;;
|
|
;; Independent faces carry each pair of colors: removed content vs. the removal
|
|
;; marker characters; and, for applications (@name), definitions (@@name) and
|
|
;; system commands (@@@name), each construct's opening vs. its close.
|
|
;;
|
|
;; The same mode serves both .kt (content) and .k (klammer definition) files:
|
|
;; the .k/.kt split is a filing convention, not a lexical difference.
|
|
;;
|
|
;; Everything is driven by ONE left-to-right scanner (`klammertext--fontify').
|
|
;; That is what makes the interactions correct: inside removed text and inside
|
|
;; literal-klammer spans the scanner jumps over the content, so it is never
|
|
;; re-interpreted as klammers or comments.
|
|
;;
|
|
;; It also matches klammer APPLICATION delimiters for `show-paren-mode' (both
|
|
;; directions, with mismatched-name flagging); see the show-paren section below.
|
|
;;
|
|
;; Not handled yet (deliberately):
|
|
;; * The bodies of definitions (@@) and system commands (@@@) are highlighted
|
|
;; like ordinary Klammertext (an @i ... @ inside shows as a normal
|
|
;; application), rather than being treated specially.
|
|
;; * Inside a `literal' argument (e.g. @code ... code@) neither # nor @ is a
|
|
;; marker. The scanner highlights the opening @code and closing code@ but
|
|
;; leaves the interior as normal text, for any klammer registered in
|
|
;; `klammertext-literal-klammers'.
|
|
|
|
;;; Code:
|
|
|
|
(defgroup klammertext nil
|
|
"Editing Klammertext files."
|
|
:group 'text)
|
|
|
|
;; --- Faces: colors from a central palette table -------------------------
|
|
;;
|
|
;; All highlighting colors live in one table, `klammertext--palette', so they
|
|
;; can be tuned in a single place. Each face carries a DARK-background value
|
|
;; and a LIGHT-background value; Emacs picks automatically from the frame or
|
|
;; terminal background (there is no "dark mode" toggle to set).
|
|
;;
|
|
;; The DARK column is a systematic scheme (developed for the Sublime Text port):
|
|
;; three tier hues — application blue, definition green, system orange — each
|
|
;; opening bright and its close the same hue at 0.80 intensity.
|
|
;;
|
|
;; The LIGHT column is a hybrid tuned by eye: the three delimiter opens are the
|
|
;; original Emacs colors (RoyalBlue2 / green4 / orange3), each close = 0.60 x its
|
|
;; open (from the open name's X11 RGB #436eee/#008b00/#cd8500); the marker and
|
|
;; mismatch light values are the systematic ones; the ignored (gray) light value
|
|
;; is the systematic gray reduced by 0.90 (#9a9a9a -> #8b8b8b).
|
|
|
|
(defconst klammertext--palette
|
|
;; (face dark light description [extra-attrs])
|
|
'((klammertext-ignored-face "#8a8272" "#8b8b8b" "removed (ignored) content")
|
|
(klammertext-marker-face "#ff6b6b" "#994040" "removal markers # ## #[ ]#")
|
|
(klammertext-klammer-open-face "#89ddff" "RoyalBlue2" "application opening @name")
|
|
(klammertext-klammer-close-face "#6eb1cc" "#28428f" "application close name@ or bare @")
|
|
(klammertext-def-open-face "#c3e88d" "green4" "definition opening @@name")
|
|
(klammertext-def-close-face "#9cba71" "#005300" "definition close name@@ or bare @@")
|
|
(klammertext-system-open-face "#ffab70" "orange3" "system opening @@@name")
|
|
(klammertext-system-close-face "#cc895a" "#7b5000" "system close name@@@ or bare @@@")
|
|
(klammertext-mismatch-face "#ff5555" "#c02020" "mismatched/unbalanced delimiter"
|
|
(:weight bold)))
|
|
"Klammertext face colors: (FACE DARK LIGHT DESCRIPTION [EXTRA-ATTRS]).
|
|
DARK is the foreground on dark backgrounds, LIGHT on light backgrounds; each
|
|
face is generated with both. EXTRA-ATTRS, if present, is a plist merged into
|
|
both grounds. See the notes above the table.")
|
|
|
|
;; Generate the faces from the table. Using `custom-declare-face' (what
|
|
;; `defface' expands to) keeps each face customizable via M-x customize-face.
|
|
(dolist (entry klammertext--palette)
|
|
(let ((face (nth 0 entry))
|
|
(dark (nth 1 entry))
|
|
(light (nth 2 entry))
|
|
(desc (nth 3 entry))
|
|
(extra (nth 4 entry)))
|
|
(custom-declare-face
|
|
face
|
|
`((((background dark)) :foreground ,dark ,@extra)
|
|
(((background light)) :foreground ,light ,@extra))
|
|
(format "Klammertext highlighting for %s.\nColor is set from the `klammertext--palette' table." desc)
|
|
:group 'klammertext)))
|
|
|
|
;; --- Klammers whose literal content must not be interpreted -------------
|
|
|
|
(defcustom klammertext-literal-klammers nil
|
|
"Names of klammers whose content is a `literal' argument.
|
|
Such a klammer must be closed with the full NAME@ form (e.g. @code ... code@),
|
|
because its content is verbatim. This list is consulted in two places:
|
|
|
|
* Font-lock leaves the verbatim interior as normal text (#, @, etc. inside
|
|
are not interpreted).
|
|
* Delimiter matching (`show-paren-mode' and `klammertext-jump-to-match')
|
|
pairs the opening @NAME with its closing NAME@ *by name* rather than by
|
|
depth counting, so a literal close is matched even though its content may
|
|
contain unbalanced @ characters.
|
|
|
|
Any klammer that declares a `literal' argument should be registered here.
|
|
Register one with `klammertext-add-literal-klammer', e.g. in your init file:
|
|
(klammertext-add-literal-klammer \"mycode\")"
|
|
:type '(repeat string)
|
|
:group 'klammertext)
|
|
|
|
;; SYNC: the shared Python core doc/edit/shared/klammertext_edit.py (used by
|
|
;; the Sublime, Vim, and VS Code integrations and the language server) holds
|
|
;; this list as LITERAL_KLAMMERS, and the static per-editor syntax files
|
|
;; restate it (a tokenizer cannot read a defcustom or a Python module). When
|
|
;; you add or remove a literal klammer, mirror it in ALL of:
|
|
;; * LITERAL_KLAMMERS in doc/edit/shared/klammertext_edit.py
|
|
;; * the @NAME literal rule + literal_NAME context in
|
|
;; doc/edit/sublime/Klammertext.sublime-syntax
|
|
;; * the @NAME verbatim region in doc/edit/vim/syntax/klammertext.vim
|
|
;; * the @NAME rule in doc/edit/vscode/syntaxes/klammertext.tmLanguage.json
|
|
;; All are currently seeded with "code" and "c" (@c is the inline form of
|
|
;; @code and took a literal argument 2026-08-16; the miscounted stack from an
|
|
;; unrecognized "@c ... c@" shifted a whole document's indentation by one).
|
|
|
|
(defun klammertext-add-literal-klammer (name)
|
|
"Register NAME as a klammer whose literal content must not be interpreted.
|
|
NAME is the klammer name without the leading @ (e.g. \"code\")."
|
|
(add-to-list 'klammertext-literal-klammers name))
|
|
|
|
(defun klammertext--search-literal-close (name &optional bound)
|
|
"Move point past the exact close token NAME@ at or after point.
|
|
Return the position after the close, or nil if there is none before BOUND.
|
|
NAME@ preceded by a name character is verbatim content, not a close --
|
|
\"basic@\" does not close @c, and \"barcode@\" does not close @code
|
|
\(the engine's close is a whole katom). Mirrors the shared core's
|
|
find_literal_close."
|
|
(let ((close (concat (regexp-quote name) "@")) (found nil))
|
|
(while (and (setq found (re-search-forward close bound t))
|
|
(let ((b (match-beginning 0)))
|
|
(and (> b (point-min))
|
|
(klammertext--name-char-p (char-before b))))))
|
|
found))
|
|
|
|
;; Seed the list through the same entry point future users will use.
|
|
(klammertext-add-literal-klammer "code")
|
|
(klammertext-add-literal-klammer "c")
|
|
|
|
;; --- Helpers -----------------------------------------------------------
|
|
|
|
(defun klammertext--escaped-p (pos)
|
|
"Non-nil if the character at POS is escaped by an odd run of ^ before it.
|
|
In Klammertext `^#' and `^@' are literal, so such a character is not a
|
|
marker or a delimiter."
|
|
(let ((n 0) (i (1- pos)))
|
|
(while (and (>= i (point-min)) (eq (char-after i) ?^))
|
|
(setq n (1+ n) i (1- i)))
|
|
(= (mod n 2) 1)))
|
|
|
|
(defun klammertext--name-char-p (ch)
|
|
"Non-nil if CH can be part of a klammer name (letter, digit or _).
|
|
A hyphen is NOT a name character: in the abbreviated form
|
|
@name-arg1-arg2 the hyphen separates the name from its arguments, so a
|
|
klammer name ends at the first hyphen."
|
|
(and ch (or (and (>= ch ?a) (<= ch ?z))
|
|
(and (>= ch ?A) (<= ch ?Z))
|
|
(and (>= ch ?0) (<= ch ?9))
|
|
(eq ch ?_))))
|
|
|
|
(defun klammertext--block-end (from)
|
|
"Return the position just after the ]# that closes a #[ block.
|
|
FROM is the position just after the opening #[. Counts nested #[ ... ]#
|
|
pairs; returns `point-max' if the block is never closed."
|
|
(goto-char from)
|
|
(let ((depth 1))
|
|
(while (and (> depth 0)
|
|
(re-search-forward "#\\[\\|]#" nil t))
|
|
(if (string= (match-string 0) "#[")
|
|
(setq depth (1+ depth))
|
|
(setq depth (1- depth))))
|
|
(if (> depth 0) (point-max) (point))))
|
|
|
|
(defun klammertext--set-match (wb we &rest groups)
|
|
"Set match data covering WB..WE with up to nine GROUPS.
|
|
Each group is a cons (BEG . END), or nil for an absent group (whose
|
|
highlight spec must use LAXMATCH)."
|
|
(let ((md (list wb we)))
|
|
(dotimes (_ 9)
|
|
(let ((g (pop groups)))
|
|
(setq md (append md (if g (list (car g) (cdr g)) (list nil nil))))))
|
|
(set-match-data md)))
|
|
|
|
;; --- Token emitters (called by the scanner) ----------------------------
|
|
;; Each returns non-nil when it has emitted a highlight token (and set the
|
|
;; match data + moved point past it), or nil to let the scanner keep going.
|
|
;; Groups: 1 removal-marker 2 removed-content 3 removal-close-marker
|
|
;; 4 app-open (@name) 5 app-close (name@ or bare @)
|
|
;; 6 def-open (@@name) 7 def-close (name@@ or bare @@)
|
|
;; 8 sys-open (@@@name) 9 sys-close (name@@@ or bare @@@)
|
|
|
|
(defun klammertext--emit-removal (pos _limit)
|
|
"POS is at a #. Point is at POS+1 on entry."
|
|
(let ((next (char-after (1+ pos))))
|
|
(cond
|
|
;; ## ... end of buffer
|
|
((eq next ?#)
|
|
(klammertext--set-match pos (point-max)
|
|
(cons pos (+ pos 2))
|
|
(cons (+ pos 2) (point-max))
|
|
nil nil nil)
|
|
(put-text-property pos (point-max) 'font-lock-multiline t)
|
|
(goto-char (point-max))
|
|
t)
|
|
;; #[ ... ]# (nestable)
|
|
((eq next ?\[)
|
|
(let* ((end (klammertext--block-end (+ pos 2)))
|
|
(close (if (and (>= end (+ pos 4))
|
|
(eq (char-before end) ?#)
|
|
(eq (char-before (1- end)) ?\]))
|
|
(- end 2) end)))
|
|
(klammertext--set-match pos end
|
|
(cons pos (+ pos 2))
|
|
(cons (+ pos 2) close)
|
|
(cons close end)
|
|
nil nil)
|
|
(put-text-property pos end 'font-lock-multiline t)
|
|
(goto-char end)
|
|
t))
|
|
;; #+ #/ #- are whitespace operators, NOT removals: keep scanning.
|
|
((memq next '(?+ ?/ ?-))
|
|
nil)
|
|
;; # ... end of line
|
|
(t
|
|
(let ((eol (line-end-position)))
|
|
(klammertext--set-match pos eol
|
|
(cons pos (1+ pos))
|
|
(cons (1+ pos) eol)
|
|
nil nil nil)
|
|
(goto-char eol)
|
|
t)))))
|
|
|
|
(defun klammertext--emit-klammer (pos _limit)
|
|
"POS is at an @. Point is at POS+1 on entry.
|
|
Dispatch by the length of the @-run at POS: a single @ is a klammer
|
|
APPLICATION (@name / name@ / @); @@ is a klammer DEFINITION (@@name /
|
|
name@@ / @@); @@@ is a system/target command (@@@name / name@@@ / @@@)."
|
|
(let ((before (and (> pos (point-min)) (char-before pos))))
|
|
(cond
|
|
;; Mid-run @ (previous char is @): the run's first @ drives everything,
|
|
;; so skip this one (e.g. the @ after an escaped ^@).
|
|
((eq before ?@)
|
|
(goto-char (1+ pos))
|
|
nil)
|
|
;; @@@ (or longer): system/target command (@@@target, @@@argtype, ...).
|
|
((and (eq (char-after (1+ pos)) ?@)
|
|
(eq (char-after (+ pos 2)) ?@))
|
|
(klammertext--emit-system pos before))
|
|
;; @@ : klammer definition delimiter
|
|
((eq (char-after (1+ pos)) ?@)
|
|
(klammertext--emit-def pos before))
|
|
;; single @ : klammer application
|
|
(t
|
|
(klammertext--emit-application pos before)))))
|
|
|
|
(defun klammertext--emit-application (pos before)
|
|
"Emit a single-@ klammer-application token at POS (groups 4 open / 5 close).
|
|
BEFORE is the character before POS."
|
|
(let ((after (char-after (1+ pos))))
|
|
(cond
|
|
;; @name : opening application (the @ and name are one unit). The name
|
|
;; ends at the first hyphen; any -arg1-arg2 abbreviation stays uncolored.
|
|
((klammertext--name-char-p after)
|
|
(goto-char (1+ pos))
|
|
(skip-chars-forward "A-Za-z0-9_")
|
|
(let* ((name-end (point))
|
|
(name (buffer-substring-no-properties (1+ pos) name-end)))
|
|
;; For a literal klammer, first locate the closing NAME@ and move the
|
|
;; scanner to its start (skipping the verbatim interior); the closing
|
|
;; is highlighted on the next scanner call. The search must happen
|
|
;; BEFORE `klammertext--set-match', because `re-search-forward'
|
|
;; clobbers the match data.
|
|
(if (member name klammertext-literal-klammers)
|
|
(if (klammertext--search-literal-close name)
|
|
(let ((close-end (point)))
|
|
(put-text-property pos close-end 'font-lock-multiline t)
|
|
(goto-char (- close-end (length name) 1)))
|
|
(put-text-property pos (point-max) 'font-lock-multiline t)
|
|
(goto-char (point-max)))
|
|
(goto-char name-end))
|
|
;; Set the match data for the opening LAST, so it survives to the
|
|
;; highlight step.
|
|
(klammertext--set-match pos name-end
|
|
nil nil nil
|
|
(cons pos name-end) ; 4: @name opening
|
|
nil)
|
|
t))
|
|
;; A @ preceded by name characters is either a named close NAME@, or the
|
|
;; bare close of a compact no-argument application @name@. They differ by
|
|
;; what precedes the name run: an @ there means the name belongs to the
|
|
;; opening (@name@), so this @ is a bare close and only it is coloured;
|
|
;; otherwise the whole NAME@ is the closing token.
|
|
((klammertext--name-char-p before)
|
|
(let ((name-start (save-excursion
|
|
(goto-char pos)
|
|
(skip-chars-backward "A-Za-z0-9_")
|
|
(point))))
|
|
(if (and (> name-start (point-min))
|
|
(eq (char-before name-start) ?@))
|
|
(klammertext--set-match pos (1+ pos) ; @name@ -> bare @
|
|
nil nil nil nil
|
|
(cons pos (1+ pos)))
|
|
(klammertext--set-match name-start (1+ pos) ; NAME@ named close
|
|
nil nil nil nil
|
|
(cons name-start (1+ pos))))
|
|
(goto-char (1+ pos))
|
|
t))
|
|
;; bare @ : unnamed closing delimiter
|
|
(t
|
|
(klammertext--set-match pos (1+ pos)
|
|
nil nil nil
|
|
nil
|
|
(cons pos (1+ pos))) ; 5: bare @ close
|
|
(goto-char (1+ pos))
|
|
t))))
|
|
|
|
(defun klammertext--emit-def (pos before)
|
|
"Emit a @@ klammer-definition delimiter token at POS (groups 6 open / 7 close).
|
|
POS and POS+1 are both @. BEFORE is the character before POS. Mirrors
|
|
`klammertext--emit-application', with @@ in place of @."
|
|
(let ((after (char-after (+ pos 2)))) ; char right after the @@
|
|
(cond
|
|
;; @@name : opening definition (the @@ and name are one unit). The name
|
|
;; ends at the first non-name char (a space, or the .target suffix).
|
|
((klammertext--name-char-p after)
|
|
(goto-char (+ pos 2))
|
|
(skip-chars-forward "A-Za-z0-9_")
|
|
(let ((name-end (point)))
|
|
(klammertext--set-match pos name-end
|
|
nil nil nil nil nil
|
|
(cons pos name-end) ; 6: @@name opening
|
|
nil)
|
|
(goto-char name-end)
|
|
t))
|
|
;; name@@ (named close) or the bare close of a compact no-body @@name@@.
|
|
;; As with applications, an @ before the name run means the name belongs
|
|
;; to the opening, so only the @@ is the closing token.
|
|
((klammertext--name-char-p before)
|
|
(let ((name-start (save-excursion
|
|
(goto-char pos)
|
|
(skip-chars-backward "A-Za-z0-9_")
|
|
(point))))
|
|
(if (and (> name-start (point-min))
|
|
(eq (char-before name-start) ?@))
|
|
(klammertext--set-match pos (+ pos 2) ; @@name@@ -> bare @@
|
|
nil nil nil nil nil nil
|
|
(cons pos (+ pos 2)))
|
|
(klammertext--set-match name-start (+ pos 2) ; NAME@@ named close
|
|
nil nil nil nil nil nil
|
|
(cons name-start (+ pos 2))))
|
|
(goto-char (+ pos 2))
|
|
t))
|
|
;; bare @@ : unnamed closing delimiter
|
|
(t
|
|
(klammertext--set-match pos (+ pos 2)
|
|
nil nil nil nil nil nil
|
|
(cons pos (+ pos 2))) ; 7: bare @@ close
|
|
(goto-char (+ pos 2))
|
|
t))))
|
|
|
|
(defun klammertext--emit-system (pos before)
|
|
"Emit a @@@ system/target delimiter token at POS (groups 8 open / 9 close).
|
|
POS, POS+1 and POS+2 are all @. BEFORE is the character before POS. These
|
|
commands (@@@target, @@@argtype, @@@state, @@@klammerset) do not nest, so
|
|
each delimiter is
|
|
coloured independently, mirroring `klammertext--emit-def' with @@@ for @@."
|
|
(let ((after (char-after (+ pos 3)))) ; char right after the @@@
|
|
(cond
|
|
;; @@@name : opening command (the @@@ and name are one unit).
|
|
((klammertext--name-char-p after)
|
|
(goto-char (+ pos 3))
|
|
(skip-chars-forward "A-Za-z0-9_")
|
|
(let ((name-end (point)))
|
|
(klammertext--set-match pos name-end
|
|
nil nil nil nil nil nil nil
|
|
(cons pos name-end) ; 8: @@@name opening
|
|
nil)
|
|
(goto-char name-end)
|
|
t))
|
|
;; name@@@ (named close) or the bare close of a compact @@@name@@@.
|
|
((klammertext--name-char-p before)
|
|
(let ((name-start (save-excursion
|
|
(goto-char pos)
|
|
(skip-chars-backward "A-Za-z0-9_")
|
|
(point))))
|
|
(if (and (> name-start (point-min))
|
|
(eq (char-before name-start) ?@))
|
|
(klammertext--set-match pos (+ pos 3) ; @@@name@@@ -> bare @@@
|
|
nil nil nil nil nil nil nil nil
|
|
(cons pos (+ pos 3)))
|
|
(klammertext--set-match name-start (+ pos 3) ; NAME@@@ named close
|
|
nil nil nil nil nil nil nil nil
|
|
(cons name-start (+ pos 3))))
|
|
(goto-char (+ pos 3))
|
|
t))
|
|
;; bare @@@ : unnamed closing delimiter
|
|
(t
|
|
(klammertext--set-match pos (+ pos 3)
|
|
nil nil nil nil nil nil nil nil
|
|
(cons pos (+ pos 3))) ; 9: bare @@@ close
|
|
(goto-char (+ pos 3))
|
|
t))))
|
|
|
|
;; --- The single scanning matcher ---------------------------------------
|
|
|
|
(defun klammertext--fontify (limit)
|
|
"Font-lock matcher: emit the next Klammertext token up to LIMIT.
|
|
Removed and literal-klammer regions are jumped over, so their interiors
|
|
are never re-interpreted."
|
|
(let ((result nil))
|
|
(while (and (not result)
|
|
(re-search-forward "[#@]" limit t))
|
|
(let* ((pos (1- (point)))
|
|
(ch (char-after pos)))
|
|
(setq result
|
|
(cond
|
|
((klammertext--escaped-p pos) nil) ; ^# or ^@
|
|
((eq ch ?#) (klammertext--emit-removal pos limit))
|
|
(t (klammertext--emit-klammer pos limit))))))
|
|
result))
|
|
|
|
(defvar klammertext-font-lock-keywords
|
|
'((klammertext--fontify
|
|
(1 'klammertext-marker-face t t)
|
|
(2 'klammertext-ignored-face t t)
|
|
(3 'klammertext-marker-face t t)
|
|
(4 'klammertext-klammer-open-face t t)
|
|
(5 'klammertext-klammer-close-face t t)
|
|
(6 'klammertext-def-open-face t t)
|
|
(7 'klammertext-def-close-face t t)
|
|
(8 'klammertext-system-open-face t t)
|
|
(9 'klammertext-system-close-face t t)))
|
|
"Font-lock keywords for `klammertext-mode'.")
|
|
|
|
;; --- show-paren support (klammer applications only) --------------------
|
|
;;
|
|
;; show-paren cannot use the syntax table for Klammertext (the same @ is both
|
|
;; open and close, delimiters are multi-character, and open/close is decided by
|
|
;; context), so matching is driven by `show-paren-data-function'. Only single-@
|
|
;; APPLICATION delimiters are matched: @name <-> its closing @ or name@. The
|
|
;; matcher steps over @@/@@@ runs, removed text, other literal spans and escaped
|
|
;; ^@; the abbreviated @name-arg form opens no span. A LITERAL klammer (one in
|
|
;; `klammertext-literal-klammers', e.g. @code) is matched by name — @code <->
|
|
;; code@ — with its verbatim content opaque, since a depth scan would miscount
|
|
;; unbalanced @ inside it. A named close name@ whose name disagrees with its
|
|
;; opening @name is reported as a mismatch.
|
|
|
|
(defun klammertext--at-run-end (pos)
|
|
"Return the position just after the run of @ that begins at POS."
|
|
(let ((p pos)) (while (eq (char-after p) ?@) (setq p (1+ p))) p))
|
|
|
|
(defun klammertext--next-app-delim (limit)
|
|
"From point, find the next single-@ application delimiter before LIMIT.
|
|
Step over @@/@@@ runs, removed text, literal spans, escaped ^@, and the
|
|
abbreviated @name-arg form (which opens no span). Move point past the
|
|
delimiter (or skipped region) and return (POS . KIND) with KIND `open or
|
|
`close, or nil when none is found."
|
|
(catch 'found
|
|
(while (re-search-forward "[@#]" limit t)
|
|
(let ((hit (1- (point))))
|
|
(cond
|
|
((klammertext--escaped-p hit)) ; ^@ / ^# : keep going
|
|
((eq (char-after hit) ?#) ; removal: step over it
|
|
(let ((next (char-after (1+ hit))))
|
|
(goto-char (cond ((eq next ?#) (point-max))
|
|
((eq next ?\[) (klammertext--block-end (+ hit 2)))
|
|
((memq next '(?+ ?/ ?-)) (1+ hit))
|
|
(t (line-end-position))))))
|
|
((eq (char-after (1+ hit)) ?@) ; @@ / @@@ : step over run
|
|
(goto-char (klammertext--at-run-end hit)))
|
|
((klammertext--name-char-p (char-after (1+ hit))) ; @name : opening?
|
|
(goto-char (1+ hit))
|
|
(skip-chars-forward "A-Za-z0-9_")
|
|
(let ((name (buffer-substring-no-properties (1+ hit) (point))))
|
|
(cond
|
|
((member name klammertext-literal-klammers) ; literal span: skip
|
|
(unless (klammertext--search-literal-close name)
|
|
(goto-char (point-max))))
|
|
((eq (char-after) ?-)) ; @name-arg : no span
|
|
(t (throw 'found (cons hit 'open))))))
|
|
(t ; name@ / bare @ : closing
|
|
(goto-char (1+ hit))
|
|
(throw 'found (cons hit 'close))))))
|
|
nil))
|
|
|
|
(defun klammertext--match-forward (open-pos)
|
|
"OPEN-POS is the @ of an opening application. Return the matching close @
|
|
position, or nil if unbalanced."
|
|
(save-excursion
|
|
(goto-char (1+ open-pos))
|
|
(skip-chars-forward "A-Za-z0-9_") ; past the opening name
|
|
(let ((depth 1) (result nil) (go t))
|
|
(while (and go (> depth 0))
|
|
(let ((d (klammertext--next-app-delim nil)))
|
|
(if (null d)
|
|
(setq go nil)
|
|
(if (eq (cdr d) 'open)
|
|
(setq depth (1+ depth))
|
|
(setq depth (1- depth))
|
|
(when (= depth 0) (setq result (car d)))))))
|
|
result)))
|
|
|
|
(defun klammertext--match-backward (close-pos)
|
|
"CLOSE-POS is the @ of a closing application. Return the matching open @
|
|
position, or nil if unbalanced. Scans forward from `point-min' with a stack."
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(let ((stack nil) (result nil) (go t))
|
|
(while go
|
|
(let ((d (klammertext--next-app-delim (1+ close-pos))))
|
|
(cond
|
|
((null d) (setq go nil))
|
|
((eq (cdr d) 'open) (push (car d) stack))
|
|
(t (let ((open (pop stack)))
|
|
(when (= (car d) close-pos)
|
|
(setq result open go nil)))))))
|
|
result)))
|
|
|
|
(defun klammertext--app-delim-info (pos)
|
|
"If the char at POS is a single-@ application delimiter, return (POS . KIND)
|
|
with KIND `open or `close; else nil. The abbreviated @name-arg form (which
|
|
opens no span) returns nil."
|
|
(when (and (eq (char-after pos) ?@)
|
|
(not (eq (char-before pos) ?@))
|
|
(not (eq (char-after (1+ pos)) ?@))
|
|
(not (klammertext--escaped-p pos)))
|
|
(if (klammertext--name-char-p (char-after (1+ pos)))
|
|
(let ((name-end (save-excursion (goto-char (1+ pos))
|
|
(skip-chars-forward "A-Za-z0-9_")
|
|
(point))))
|
|
(unless (eq (char-after name-end) ?-)
|
|
(cons pos 'open)))
|
|
(cons pos 'close))))
|
|
|
|
(defun klammertext--open-name (open-pos)
|
|
"Name of the opening @name at OPEN-POS."
|
|
(save-excursion (goto-char (1+ open-pos))
|
|
(buffer-substring-no-properties
|
|
(point) (progn (skip-chars-forward "A-Za-z0-9_") (point)))))
|
|
|
|
(defun klammertext--close-name (close-pos)
|
|
"Name of a named close NAME@ at CLOSE-POS, or nil for a bare @ (incl. @name@)."
|
|
(save-excursion
|
|
(goto-char close-pos)
|
|
(let ((ns (progn (skip-chars-backward "A-Za-z0-9_") (point))))
|
|
(when (and (< ns close-pos)
|
|
(not (eq (char-before ns) ?@)))
|
|
(buffer-substring-no-properties ns close-pos)))))
|
|
|
|
(defun klammertext--paren-mismatch (open-pos close-pos)
|
|
"Non-nil if OPEN-POS/CLOSE-POS is unbalanced, or the named close disagrees
|
|
with the opening name."
|
|
(or (null open-pos) (null close-pos)
|
|
(let ((cname (klammertext--close-name close-pos)))
|
|
(and cname (not (string= cname (klammertext--open-name open-pos)))))))
|
|
|
|
(defun klammertext--literal-delim-name (pos kind)
|
|
"If the application delimiter at POS (KIND `open or `close) belongs to a
|
|
literal klammer (one in `klammertext-literal-klammers'), return its name;
|
|
else nil. A literal klammer must be closed with the full NAME@ form because
|
|
its content is verbatim, so its @NAME open and NAME@ close are matched by
|
|
name, not by depth counting."
|
|
(let ((name (if (eq kind 'open)
|
|
(klammertext--open-name pos)
|
|
(klammertext--close-name pos))))
|
|
(and name (member name klammertext-literal-klammers) name)))
|
|
|
|
(defun klammertext--literal-match-forward (open-pos name)
|
|
"Return the @ of the NAME@ that closes the literal @NAME at OPEN-POS, or nil.
|
|
The verbatim content is opaque, so we search for the literal close string."
|
|
(save-excursion
|
|
(goto-char (+ open-pos 1 (length name)))
|
|
(when (klammertext--search-literal-close name)
|
|
(1- (point)))))
|
|
|
|
(defun klammertext--literal-match-backward (close-pos name)
|
|
"Return the @ of the @NAME that opens the literal NAME@ whose @ is at
|
|
CLOSE-POS, or nil. Literal spans do not nest, so the nearest preceding real
|
|
@NAME is the opener."
|
|
(save-excursion
|
|
(goto-char close-pos)
|
|
(let ((open-str (concat "@" name)) (result nil))
|
|
(while (and (not result) (search-backward open-str nil t))
|
|
(let ((op (point)))
|
|
;; The name must end where the token ends: "@c" found inside
|
|
;; "@caption" is not an opener of @c.
|
|
(unless (or (eq (char-before op) ?@) ; @@NAME = definition
|
|
(klammertext--name-char-p
|
|
(char-after (+ op 1 (length name))))
|
|
(klammertext--escaped-p op))
|
|
(setq result op))))
|
|
result)))
|
|
|
|
(defun klammertext--app-match (pos kind)
|
|
"Return the matching application delimiter for the delimiter at POS of KIND
|
|
\(`open or `close), or nil.
|
|
A literal klammer (in `klammertext-literal-klammers') matches by name
|
|
(@NAME <-> NAME@) with its content opaque; other klammers match by depth."
|
|
(let ((lit (klammertext--literal-delim-name pos kind)))
|
|
(cond
|
|
((and lit (eq kind 'open)) (klammertext--literal-match-forward pos lit))
|
|
((and lit (eq kind 'close)) (klammertext--literal-match-backward pos lit))
|
|
((eq kind 'open) (klammertext--match-forward pos))
|
|
(t (klammertext--match-backward pos)))))
|
|
|
|
(defun klammertext--report-mismatch (open-pos close-pos)
|
|
"Show a minibuffer message describing a klammer application mismatch.
|
|
Either position may be nil (an unbalanced delimiter)."
|
|
(message "%s"
|
|
(cond
|
|
((null close-pos)
|
|
(format "Klammertext: opening @%s has no matching close"
|
|
(klammertext--open-name open-pos)))
|
|
((null open-pos)
|
|
"Klammertext: closing delimiter has no matching open")
|
|
(t
|
|
(format "Klammertext: closing %s@ does not match opening @%s"
|
|
(or (klammertext--close-name close-pos) "?")
|
|
(klammertext--open-name open-pos))))))
|
|
|
|
(defun klammertext--show-paren-data ()
|
|
"`show-paren-data-function' for klammer applications, both directions.
|
|
Returns (HERE-BEG HERE-END THERE-BEG THERE-END MISMATCH) or nil, and reports
|
|
any mismatch in the minibuffer."
|
|
(let* ((p (point))
|
|
(info (or (klammertext--app-delim-info p)
|
|
(and (> p (point-min))
|
|
(klammertext--app-delim-info (1- p))))))
|
|
(when info
|
|
(let* ((dpos (car info)) (kind (cdr info))
|
|
(match (klammertext--app-match dpos kind))
|
|
(open (if (eq kind 'open) dpos match))
|
|
(close (if (eq kind 'open) match dpos))
|
|
(mism (klammertext--paren-mismatch open close)))
|
|
(when mism (klammertext--report-mismatch open close))
|
|
(list dpos (1+ dpos) match (and match (1+ match)) mism)))))
|
|
|
|
;; --- Interactive: jump to the matching application delimiter -----------
|
|
|
|
(defun klammertext-jump-to-match ()
|
|
"Jump to the matching klammer application delimiter.
|
|
On an opening @name, move to its closing @ or name@; on a close, move to the
|
|
opening @name. Uses the same matcher as `show-paren-mode'. The starting
|
|
position is pushed to the mark ring, so \\`C-u C-SPC' jumps back."
|
|
(interactive)
|
|
(let* ((p (point))
|
|
(info (or (klammertext--app-delim-info p)
|
|
(and (> p (point-min))
|
|
(klammertext--app-delim-info (1- p))))))
|
|
(unless info
|
|
(user-error "Point is not on a klammer application delimiter (@)"))
|
|
(let* ((dpos (car info)) (kind (cdr info))
|
|
(match (klammertext--app-match dpos kind)))
|
|
(unless match
|
|
(user-error "No matching delimiter for this %s klammer"
|
|
(if (eq kind 'open) "opening" "closing")))
|
|
(push-mark nil t)
|
|
(goto-char match))))
|
|
|
|
;; --- The mode ----------------------------------------------------------
|
|
|
|
;;;###autoload
|
|
(define-derived-mode klammertext-mode text-mode "Klammertext"
|
|
"Major mode for editing Klammertext files."
|
|
(setq-local font-lock-multiline t)
|
|
(setq-local font-lock-defaults '(klammertext-font-lock-keywords))
|
|
;; Match klammer application delimiters with `show-paren-mode' (which must be
|
|
;; enabled separately; it is on by default in Emacs 28+).
|
|
(setq-local show-paren-data-function #'klammertext--show-paren-data)
|
|
;; Show a mismatched delimiter in bright red rather than the default purple
|
|
;; `show-paren-mismatch', but only in Klammertext buffers.
|
|
(setq-local face-remapping-alist
|
|
(cons '(show-paren-mismatch klammertext-mismatch-face)
|
|
face-remapping-alist)))
|
|
|
|
(define-key klammertext-mode-map (kbd "C-c C-j") #'klammertext-jump-to-match)
|
|
|
|
;;;###autoload
|
|
(add-to-list 'auto-mode-alist '("\\.kt\\'" . klammertext-mode))
|
|
;;;###autoload
|
|
(add-to-list 'auto-mode-alist '("\\.k\\'" . klammertext-mode))
|
|
|
|
(provide 'klammertext-mode)
|
|
;;; klammertext-mode.el ends here
|