diff options
| -rw-r--r-- | claude/claude-input.el | 473 |
1 files changed, 473 insertions, 0 deletions
diff --git a/claude/claude-input.el b/claude/claude-input.el new file mode 100644 index 0000000..ae7ff1f --- /dev/null +++ b/claude/claude-input.el @@ -0,0 +1,473 @@ +;;; 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 |