klammertext/doc/edit/emacs/klammertext-mode.el

;;; 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 Sublime Text port in doc/sublime/ duplicates this list statically
;; (a Sublime syntax/plugin cannot read this Emacs defcustom).  When you add or
;; remove a literal klammer, mirror it in ALL of:
;;   * LITERAL_KLAMMERS in doc/sublime/Klammertext.py
;;   * LITERAL_KLAMMERS in doc/sublime/Klammertext_indent.py
;;   * the @NAME literal rule + literal_NAME context in
;;     doc/sublime/Klammertext.sublime-syntax
;; All four 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