path: root/claude/claude-input.el

;;; claude-input.el --- Slot-based, buffered Zhuyin input for chinese-zozy  -*- lexical-binding: t; -*-

;; Copyright (C) 2026  Jean Sévère Durand

;; Keywords: i18n, convenience

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Improvements over the `chinese-zozy' Quail package (ZOZY.el), which
;; is left untouched.  Everything is done by advising Quail.
;;
;; 1. Slots.  A syllable has four slots: initial, medial, final and
;;    tone.  Typing a symbol whose slot is already taken replaces the
;;    old symbol, so the order of typing does not matter.  A tone
;;    finishes the syllable (its candidates are shown); typing any
;;    non-tone symbol afterwards starts a *new* character and leaves
;;    the finished one alone.
;;
;; 2. Buffering.  All characters of one composition are kept as
;;    "cells".  Move between cells with the keys in
;;    `claude-input-backward-keys' / `claude-input-forward-keys' and
;;    edit or delete them.  The composition ends with a key in
;;    `claude-input-commit-keys' (RET by default).
;;
;; Keys are classified through `quail-keyboard-translate', so the code
;; works with any `quail-keyboard-layout-type'.  Slots store the raw
;; keys that the user typed, because `quail-current-key' is raw as
;; well.
;;
;; Word-level selection (stage 2) is not implemented yet.
;;
;; Usage: (require 'claude-input), then select `chinese-zozy'.

;;; Code:

(require 'quail)
(require 'subr-x)

(defgroup claude-input nil
  "Slot-based, buffered Zhuyin input."
  :group 'quail)

(defcustom claude-input-package "chinese-zozy"
  "Name of the Quail package that this file improves."
  :type 'string)

(defcustom claude-input-backward-keys (list [left] (kbd "M-b"))
  "Key sequences moving to the previous cell inside a composition."
  :type '(repeat sexp))

(defcustom claude-input-forward-keys (list [right] (kbd "M-f"))
  "Key sequences moving to the next cell inside a composition."
  :type '(repeat sexp))

(defcustom claude-input-commit-keys (list (kbd "RET") (kbd "C-j"))
  "Key sequences that finish the whole composition."
  :type '(repeat sexp))

;;;; Slots

(defconst claude-input--slot-table
  (let ((table (make-hash-table :test #'eq)))
    ;; Keys are in the standard (QWERTY) layout, as used by ZOZY.el.
    (dolist (spec '((0 . "1q2wazsxedcrfv5tgbyhn") ; initials
                    (1 . "ujm")                   ; medials
                    (2 . "8ik,9ol.0p;/-")         ; finals
                    (3 . " 6347")))               ; tones
      (seq-doseq (c (cdr spec))
        (puthash c (car spec) table)))
    table)
  "Map a standard-layout key to its slot index (0 to 3).")

(defun claude-input--slot-of (char)
  "Return the slot index of the raw key CHAR, or nil if it is no symbol.
CHAR is first translated to the standard layout."
  (and (characterp char)
       (gethash (quail-keyboard-translate char) claude-input--slot-table)))

(defun claude-input--key (slots)
  "Return the normalised raw key string built from SLOTS."
  (apply #'string (delq nil (append slots nil))))

(defun claude-input--slots-from-key (key)
  "Return a fresh slot vector filled with the symbols in KEY."
  (let ((slots (make-vector 4 nil)))
    (seq-doseq (c key)
      (when-let* ((i (claude-input--slot-of c)))
        (aset slots i c)))
    slots))

;;;; Cells

;; A cell is a vector [SLOTS STR BEG END INDEX].  STR is the text of
;; the cell, BEG and END are markers around that text in the buffer,
;; and INDEX is the selected candidate.  The text of the current cell
;; is owned by Quail (`quail-overlay'); its markers are only refreshed
;; when we leave the cell.

(defvar claude-input--cells nil
  "Vector of cells of the composition in progress, or nil when inactive.")

(defvar claude-input--index 0
  "Index in `claude-input--cells' of the cell being edited.")

(defvar claude-input--slots (make-vector 4 nil)
  "Slots of the syllable being edited.")

(defvar claude-input--last-tone-p nil
  "Non-nil if the last key typed was a tone.")

(defvar claude-input--overlay nil
  "Overlay underlining the whole composition.")

(defsubst claude-input--active-p ()
  "Return non-nil if a buffered composition is in progress."
  (and claude-input--cells t))

(defsubst claude-input--cell-slots (cell) (aref cell 0))
(defsubst claude-input--cell-str (cell) (aref cell 1))
(defsubst claude-input--cell-beg (cell) (aref cell 2))
(defsubst claude-input--cell-end (cell) (aref cell 3))
(defsubst claude-input--cell-choice (cell) (aref cell 4))

(defun claude-input--make-cell (&optional slots str beg end choice)
  "Make a cell.  Markers are created if BEG and END are nil."
  (let ((b (make-marker)) (e (make-marker)))
    ;; BEG advances over text inserted at its position, END does not.
    ;; Together this keeps adjacent cells separated when the text of
    ;; one of them is replaced.
    (set-marker-insertion-type b t)
    (set-marker-insertion-type e nil)
    (when beg (set-marker b beg))
    (when end (set-marker e end))
    (vector (or slots (make-vector 4 nil)) (or str "") b e (or choice 0))))

(defun claude-input--current ()
  "Return the cell being edited."
  (aref claude-input--cells claude-input--index))

(defun claude-input--current-choice ()
  "Return the selected candidate index of the current translations."
  (if quail-current-translations
      (or (car-safe (car-safe quail-current-translations)) 0)
    0))

(defun claude-input--save-current ()
  "Save the state of the current cell, from Quail's, into the cell."
  (let ((cell (claude-input--current))
        (beg (overlay-start quail-overlay))
        (end (overlay-end quail-overlay)))
    (aset cell 0 (copy-sequence claude-input--slots))
    (aset cell 1 (or quail-current-str ""))
    (aset cell 4 (claude-input--current-choice))
    (when beg
      (set-marker (claude-input--cell-beg cell) beg)
      (set-marker (claude-input--cell-end cell) end))
    ;; Make Quail forget the text so that it stays in the buffer.
    (when end (move-overlay quail-overlay end end))
    (claude-input--normalize-cells cell)))

(defun claude-input--normalize-cells (current)
  "Order `claude-input--cells' by buffer position and track CURRENT.
Ties (empty cells share a position with their neighbours) are broken by
the old order, so the sort is stable.  `claude-input--index' is set to
the index of the cell CURRENT, found by identity.  This must be called
after the markers of CURRENT have been refreshed."
  (let ((i -1) (last-pos 0) keyed)
    (seq-doseq (cell claude-input--cells)
      (let ((pos (or (marker-position (claude-input--cell-beg cell)) last-pos)))
        (setq last-pos pos)
        (push (list pos (setq i (1+ i)) cell) keyed)))
    (setq claude-input--cells
          (vconcat
           (mapcar #'caddr
                   (sort (nreverse keyed)
                         (lambda (a b)
                           (or (< (car a) (car b))
                               (and (= (car a) (car b))
                                    (< (cadr a) (cadr b)))))))))
    (setq claude-input--index
          (or (seq-position claude-input--cells current #'eq) 0))))

(defun claude-input--release-cell (cell)
  "Release the markers of CELL."
  (set-marker (claude-input--cell-beg cell) nil)
  (set-marker (claude-input--cell-end cell) nil))

(defun claude-input--empty-cell-p (cell)
  "Return non-nil if CELL has no symbols at all."
  (not (seq-some #'identity (claude-input--cell-slots cell))))

(defun claude-input--enter (index)
  "Make the cell at INDEX the one being edited.
The previous current cell must already have been saved.  The text of
cell INDEX is handed over to Quail, and the candidates are rebuilt."
  (setq claude-input--index index)
  (let* ((cell (aref claude-input--cells index))
         (beg (marker-position (claude-input--cell-beg cell)))
         (end (marker-position (claude-input--cell-end cell))))
    (setq claude-input--slots (copy-sequence (claude-input--cell-slots cell))
          claude-input--last-tone-p nil
          quail-current-key (claude-input--key claude-input--slots))
    (cond
     ((and beg end)
      (move-overlay quail-overlay beg end)
      (goto-char end))
     (t (move-overlay quail-overlay (point) (point))))
    (setq quail-current-str (claude-input--cell-str cell))
    (if (string-empty-p quail-current-key)
        (quail-delete-region)
      (let ((choice (claude-input--cell-choice cell)))
        (quail-update-translation (quail-translate-key))
        ;; Restore the candidate that was selected earlier.
        (when (and quail-current-translations (> choice 0))
          (setcar (car quail-current-translations)
                  (min choice (1- (length (cdr quail-current-translations)))))
          (quail-update-current-translations)
          (quail-update-translation nil))))
    (claude-input--refresh-overlay)))

(defun claude-input--move (delta)
  "Save the current cell and edit the cell DELTA cells away from it.
Empty cells are dropped.  Return non-nil if we moved."
  (let ((target (aref claude-input--cells
                      (max 0 (min (+ claude-input--index delta)
                                  (1- (length claude-input--cells)))))))
    (unless (eq target (claude-input--current))
      (let ((cur (claude-input--current)))
        (claude-input--save-current)
        (when (claude-input--empty-cell-p cur)
          (claude-input--release-cell cur)
          (setq claude-input--cells (vconcat (delq cur (append claude-input--cells nil)))))
        (claude-input--enter (seq-position claude-input--cells target #'eq))
        t))))

(defun claude-input--insert-cell-after-current ()
  "Save the current cell and open a new empty cell right after it."
  (claude-input--save-current)
  (let ((pos (or (overlay-end quail-overlay) (point)))
        (idx (1+ claude-input--index)))
    (setq claude-input--cells
          (vconcat (seq-subseq claude-input--cells 0 idx)
                   (vector (claude-input--make-cell nil "" pos pos))
                   (seq-subseq claude-input--cells idx)))
    (setq claude-input--index idx
          claude-input--slots (make-vector 4 nil)
          claude-input--last-tone-p nil
          quail-current-key ""
          quail-current-str "")
    (goto-char pos)
    (move-overlay quail-overlay pos pos)))

;;;; Overlay

(defun claude-input--refresh-overlay ()
  "Underline all text of the composition."
  (when (claude-input--active-p)
    (let ((lo nil) (hi nil))
      (dotimes (i (length claude-input--cells))
        (let* ((cell (aref claude-input--cells i))
               (cur (= i claude-input--index))
               (b (if cur (overlay-start quail-overlay)
                    (marker-position (claude-input--cell-beg cell))))
               (e (if cur (overlay-end quail-overlay)
                    (marker-position (claude-input--cell-end cell)))))
          (when (and b e)
            (setq lo (if lo (min lo b) b)
                  hi (if hi (max hi e) e)))))
      (when lo
        (unless (overlayp claude-input--overlay)
          (setq claude-input--overlay (make-overlay lo hi nil nil t))
          (overlay-put claude-input--overlay 'face 'underline)
          (overlay-put claude-input--overlay 'priority -1))
        (move-overlay claude-input--overlay lo hi)))))

(defun claude-input--delete-overlay ()
  "Delete the composition overlay."
  (when (overlayp claude-input--overlay)
    (delete-overlay claude-input--overlay))
  (setq claude-input--overlay nil))

;;;; Translation advice

(defun claude-input--applies-p ()
  "Return non-nil if our advice should act in the current Quail package."
  (and (claude-input--active-p)
       (equal (quail-name) claude-input-package)))

(defun claude-input--translate-advice (orig &rest args)
  "Around advice for `quail-translate-key' (ORIG, ARGS).
Implements the slots; see the Commentary."
  (let ((char last-command-event))
    (cond
     ((not (claude-input--applies-p))
      (apply orig args))
     ;; A symbol key typed by the user.
     ((and (eq this-command 'quail-self-insert-command)
           (claude-input--slot-of char))
      (let* ((slot (claude-input--slot-of char))
             (tone-p (= slot 3))
             (finished (aref claude-input--slots 3)))
        ;; A finished syllable followed by a non-tone symbol (or by a
        ;; tone after a non-tone edit) starts a new character.  Several
        ;; tones in a row only replace the tone.
        (when (and finished (not (and tone-p claude-input--last-tone-p)))
          (claude-input--insert-cell-after-current))
        (setq claude-input--last-tone-p tone-p)
        (aset claude-input--slots slot char)
        (setq quail-current-key (claude-input--key claude-input--slots))
        (let ((res (apply orig args)))
          (when (numberp res)
            ;; No translation for this combination: keep what we had,
            ;; show the symbols typed so far.
            (setq quail-current-str
                  (or quail-current-str (quail-keyseq-translate quail-current-key))))
          (claude-input--refresh-overlay)
          ;; Only the commit keys finish the composition.
          nil)))
     ;; Anything else: a digit selecting a candidate, a backspace, or
     ;; a stray key that ends the composition.
     (t
      (let ((res (apply orig args)))
        (setq claude-input--slots
              (claude-input--slots-from-key quail-current-key))
        (claude-input--refresh-overlay)
        (cond ((eq res t) nil)          ; a selection is not the end
              (t res)))))))

;;;; Commands bound in the Quail translation keymap

(defun claude-input-backward ()
  "Edit the previous character of the composition."
  (interactive)
  (if (claude-input--active-p)
      (or (claude-input--move -1)
          (message "Beginning of composition"))
    (quail-error "Not composing")))

(defun claude-input-forward ()
  "Edit the next character of the composition."
  (interactive)
  (if (claude-input--active-p)
      (or (claude-input--move 1)
          (message "End of composition"))
    (quail-error "Not composing")))

(defun claude-input-delete-backward ()
  "Delete the last symbol of the current syllable.
When the syllable is already empty, delete the character itself and
move to a neighbour."
  (interactive)
  (cond
   ((not (claude-input--active-p)) (quail-delete-last-char))
   ((> (length quail-current-key) 1)
    (quail-delete-last-char))
   (t
    ;; One symbol left: remove the cell.
    (let ((cur claude-input--index)
          (n (length claude-input--cells)))
      (cond
       ((= n 1) (quail-abort-translation))
       (t
        (quail-delete-region)
        (claude-input--release-cell (claude-input--current))
        (setq claude-input--cells
              (vconcat (seq-subseq claude-input--cells 0 cur)
                       (seq-subseq claude-input--cells (1+ cur))))
        (setq claude-input--index (min cur (1- (length claude-input--cells))))
        ;; Previous cell if there is one, else the next.
        (when (> cur 0) (setq claude-input--index (1- cur)))
        (claude-input--enter claude-input--index)))))))

(defun claude-input-commit ()
  "Finish the whole composition and keep the text."
  (interactive)
  (when (claude-input--active-p)
    ;; Make the last cell the current one so that point ends up after
    ;; all of the text.
    (claude-input--move (length claude-input--cells)))
  (quail-terminate-translation))

(defun claude-input--bind-keys ()
  "Install our commands in the translation keymap of the package."
  (when-let* ((map (quail-translation-keymap)))
    ;; Quail binds ESC itself, which blocks meta keys such as M-b.
    ;; Shadow it with a prefix map.
    (unless (keymapp (lookup-key map [27]))
      (define-key map [27] (make-sparse-keymap)))
    (dolist (k claude-input-backward-keys)
      (define-key map k #'claude-input-backward))
    (dolist (k claude-input-forward-keys)
      (define-key map k #'claude-input-forward))
    (dolist (k claude-input-commit-keys)
      (define-key map k #'claude-input-commit))
    (define-key map "\177" #'claude-input-delete-backward)
    (define-key map [backspace] #'claude-input-delete-backward)))

;;;; Session management

(defun claude-input--start ()
  "Begin a composition."
  (setq claude-input--cells (vector (claude-input--make-cell))
        claude-input--index 0
        claude-input--slots (make-vector 4 nil)
        claude-input--last-tone-p nil))

(defun claude-input--end ()
  "Release everything."
  (when claude-input--cells
    (seq-doseq (cell claude-input--cells)
      (claude-input--release-cell cell)))
  (claude-input--delete-overlay)
  (setq claude-input--cells nil
        claude-input--index 0
        claude-input--slots (make-vector 4 nil)
        claude-input--last-tone-p nil))

(defun claude-input--start-translation-advice (orig key)
  "Around advice for `quail-start-translation' (ORIG, KEY).
Wrap the whole composition so that state is set up and cleaned."
  (if (not (equal (quail-name) claude-input-package))
      (funcall orig key)
    (claude-input--bind-keys)
    (claude-input--start)
    (unwind-protect
        (let* ((res (funcall orig key))
               (last (and claude-input--cells
                          (1- (length claude-input--cells)))))
          ;; If the loop ended while editing a cell in the middle,
          ;; put its text back ourselves and move after the last cell.
          (if (and last (/= claude-input--index last)
                   (stringp res) (> (length res) 0))
              (progn
                (insert res)
                (let ((e (marker-position
                          (claude-input--cell-end
                           (aref claude-input--cells last)))))
                  (when e (goto-char e)))
                "")
            res))
      (claude-input--end))))

;;;###autoload
(define-minor-mode claude-input-mode
  "Globally enable slot-based, buffered input for `chinese-zozy'."
  :global t
  (cond
   (claude-input-mode
    (advice-add 'quail-translate-key :around #'claude-input--translate-advice)
    (advice-add 'quail-start-translation :around
                #'claude-input--start-translation-advice))
   (t
    (advice-remove 'quail-translate-key #'claude-input--translate-advice)
    (advice-remove 'quail-start-translation
                   #'claude-input--start-translation-advice))))

;; (claude-input-mode 1)

(provide 'claude-input)
;;; claude-input.el ends here