Andy Kopra
f855c5ccae
doc/edit/ now holds a shared Python implementation of the language's structural layer (klammertext_edit.py) and a dependency-free language server (klammertext_ls.py), with integrations for Emacs, Sublime Text, Vim, and Visual Studio Code. The editor test suite in tst/ covers the core's API and CLI, the language server protocol, the VS Code extension, headless Vim, and Emacs byte-equality. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
685 lines
31 KiB
EmacsLisp
685 lines
31 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 just "code".
|
|
|
|
(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))
|
|
|
|
;; Seed the list through the same entry point future users will use.
|
|
(klammertext-add-literal-klammer "code")
|
|
|
|
;; --- 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)
|
|
(let ((close (concat (regexp-quote name) "@")))
|
|
(if (re-search-forward close nil t)
|
|
(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) 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
|
|
(let ((close (concat (regexp-quote name) "@")))
|
|
(unless (re-search-forward close nil t) (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 (search-forward (concat name "@") nil t)
|
|
(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)))
|
|
(unless (or (eq (char-before op) ?@) ; @@NAME = definition
|
|
(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
|