;;; 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) 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