;;; thogai.el --- Stenotyping software -*- lexical-binding: t -*- ;; Stenotyping software for Emacs ;; Copyright (C) 2022 Arun Isaac ;; ;; Author: Arun Isaac ;; Version: 0.1.0 ;; Keywords: abbrev, convenience, hardware ;; Homepage: https://git.systemreboot.net/thogai ;; Package-Requires: ((emacs "27.1")) ;; This file is part of thogai. ;; thogai 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. ;; thogai 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 thogai. If not, see . ;;; Commentary: ;; ;; thogai is stenotyping software. It interfaces with steno machines ;; using the Gemini protocol, and translates strokes using a steno ;; dictionary in the Plover dictionary format. ;; ;; Usage: ;; ;; Connect to your steno machine using the Gemini protocol with ;; ;; M-x thogai-connect ;; ;; Chord away! ;;; Code: (require 'map) (require 'pcase) (require 'seq) (require 'subr-x) (require 'term) (defvar thogai-dictionary-files (list "~/.config/plover/main.json" "~/.config/plover/commands.json") "List of dictionary files in order of increasing precedence. All files should be in the Plover dictionary format, and are read and loaded into memory when `thogai-load-dictionaries' is run.") (defvar thogai-user-dictionary-alist nil "Additional dictionary entries. This is an association list specifying additional translations not present in `thogai-dictionary-files'. For example, (setq thogai-user-dictionary-alist '((\"PER\" . \"perfect\") (\"THO/TKPWAOEU\" . \"thogai\")))") (defvar thogai-dictionary (make-hash-table :test 'equal) "Hash table used as the steno dictionary by thogai. This variable is loaded from files listed in `thogai-dictionary-files' on running `thogai-load-dictionaries'.") (defvar thogai-stroke-ring-size 1000 "Size of `thogai-stroke-ring'. This is the number of past strokes thogai keeps track of. Among other things, it affects the number of strokes one can undo back to.") (defvar thogai-stroke-ring (make-ring thogai-stroke-ring-size) "Ring tracking all past strokes.") (defvar thogai-attach-next nil "Flag indicating whether to attach the next translation. If non-nil, the next part of the translation is attached without a space, and the variable is reset to nil.") (defvar thogai-glue nil "Flag indicating whether to glue the next translation. If non-nil and the next part of the translation also starts with a glue operator, it is attached without a space, and the variable is reset to nil.") (defvar thogai-capitalize-next-word nil "Flag indicating whether to capitalize the next word. If non-nil, the first letter of the next word is capitalized and the variable is reset to nil.") (defvar thogai-uncapitalize-next-word nil "Flag indicating whether to uncapitalize the next word. If non-nil, the first letter of the next word is uncapitalized and the variable is reset to nil.") (defun thogai-load-dictionaries () "Load dictionary files in THOGAI-DICTIONARY-FILES." (interactive) ;; Reset hash table. (clrhash thogai-dictionary) (let ((thogai-dictionary-longest-key 0)) (dolist (dictionary-file thogai-dictionary-files) (maphash (lambda (key value) ;; Load key, value pair into hash table. (puthash key value thogai-dictionary) ;; Update length of longest key. (setq thogai-dictionary-longest-key (max thogai-dictionary-longest-key (length (split-string key "/"))))) ;; Parse JSON dictionary file. (with-temp-buffer (insert-file-contents dictionary-file) (json-parse-buffer)))) ;; Enlarge `thogai-stroke-ring' if it is too small. (when (< (ring-size thogai-stroke-ring) thogai-dictionary-longest-key) (ring-resize thogai-stroke-ring thogai-dictionary-longest-key))) (message "Loaded %d dictionary entries" (hash-table-count thogai-dictionary))) (defun thogai-lookup (stroke) "Lookup STROKE in dictionary. STROKE is looked up in `thogai-user-dictionary-alist' and `thogai-dictionary' with `thogai-user-dictionary-alist' having higher precedence. If STROKE is in neither, nil is returned." (or (map-elt thogai-user-dictionary-alist stroke) (map-elt thogai-dictionary stroke))) (defun thogai-longest-match (state) "Return the longest sublist of STATE that maps to a stroke. STATE is a list of strokes, oldest first. STATE should typically be the list of elements in `thogai-stroke-ring', or a subset thereof." (if (thogai-lookup (string-join state "/")) state (pcase state (`(,_ . ,tail) (thogai-longest-match tail))))) (defun thogai-delete (string) "Delete STRING before point, if it is present. If STRING is not present before point, do nothing." (let ((start (- (point) (length string))) (end (point))) (when (and (>= start (point-min)) (string= (buffer-substring start end) string)) (delete-region start end)))) (defun thogai-compose (&rest functions) "Return a composition of FUNCTIONS. The last function in FUNCTIONS is applied first." (lambda (arg) (seq-reduce (lambda (result function) (funcall function result)) functions arg))) (defun thogai-insert-space () "Insert space at point if necessary. Insert space at point unless at the beginning of a line or `thogai-attach-next' is non-nil." (unless (or (= (line-beginning-position) (point)) thogai-attach-next) (insert " "))) (defun thogai-insert-literal (literal-translation) "Insert LITERAL-TRANSLATION at point. Insert LITERAL-TRANSLATION at point, respecting `thogai-capitalize-next-word' and `thogai-uncapitalize-next-word'." (insert (funcall (thogai-compose ;; Capitalize first letter. (if thogai-capitalize-next-word (lambda (str) (setq thogai-capitalize-next-word nil) (concat (upcase (substring str 0 1)) (substring str 1))) 'identity) ;; Uncapitalize first letter. (if thogai-uncapitalize-next-word (lambda (str) (setq thogai-uncapitalize-next-word nil) (concat (downcase (substring str 0 1)) (substring str 1))) 'identity)) literal-translation)) ;; Reset `thogai-attach-next' and `thogai-glue'. (setq thogai-attach-next nil thogai-glue nil)) (defun thogai-insert-translation (translation &optional non-first-part-p) "Insert TRANSLATION at point. TRANSLATION is a string mapped to in a steno dictionary. If NON-FIRST-PART-P is non-nil, no literal parts of TRANSLATION have been processed yet. This is an internal recursion variable. External callers should always pass nil as the value." (pcase (save-match-data (string-match (rx string-start (or (one-or-more (not ?{)) (sequence ?{ (one-or-more (not ?{)) ?}))) translation) (list (match-string 0 translation) (substring translation (match-end 0)))) (`(,translation ,rest-of-translation) (pcase translation ;; Attach operator ("{^}" (setq thogai-attach-next t)) ;; Infix ((pred (lambda (str) (and (string-prefix-p "{^" str) (string-suffix-p "^}" str)))) (thogai-insert-literal (string-remove-prefix "{^" (string-remove-suffix "^}" translation))) (setq thogai-attach-next t)) ;; Prefix ((pred (lambda (str) (string-suffix-p "^}" str))) (unless non-first-part-p (thogai-insert-space)) (thogai-insert-literal (string-remove-prefix "{" (string-remove-suffix "^}" translation))) (setq thogai-attach-next t)) ;; Glue operator ((pred (lambda (str) (and (string-prefix-p "{&" str) (string-suffix-p "}" str)))) (unless (or non-first-part-p thogai-glue) (thogai-insert-space)) (thogai-insert-literal (string-remove-prefix "{&" (string-remove-suffix "}" translation))) (setq thogai-glue t)) ;; Capitalize next word. ("{-|}" (setq thogai-capitalize-next-word t)) ;; Capitalize previous word. ("{*-|}" (save-excursion (left-word) (upcase-region (point) (1+ (point))))) ;; Uncapitalize next word. ("{>}" (setq thogai-uncapitalize-next-word t)) ;; Uncapitalize previous word. ("{*>}" (save-excursion (left-word) (downcase-region (point) (1+ (point))))) ;; Retroactively delete space. ("{*!}" (save-excursion (left-word) (delete-char -1))) ;; Simple literal translation (_ (unless non-first-part-p (thogai-insert-space)) (thogai-insert-literal translation))) ;; Recurse for rest of translation. (unless (string= rest-of-translation "") (thogai-insert-translation rest-of-translation ;; Carry through non-first-part-p on pure command translation ;; parts that do not insert anything. (if (member translation (list "{^}" "{-|}" "{*-|}" "{>}" "{*>}" "{*!}")) non-first-part-p t)))))) (defun thogai-reverse-strokes (strokes) "Reverse the effects of STROKES. STROKES is a list of strokes, oldest first. `thogai-stroke-ring' is unaltered." (thogai-delete (with-temp-buffer (thogai-inject-strokes strokes (make-ring (length strokes))) (buffer-string)))) (defun thogai-inject-strokes (strokes &optional stroke-ring) "Inject STROKES into STROKE-RING. Inject STROKES, a list of strokes, into STROKE-RING as though they were really stroked on the steno machine. If unspecified, STROKE-RING is `thogai-stroke-ring'. The first element of STROKES is injected first." (let ((stroke-ring (or stroke-ring thogai-stroke-ring))) ;; Inject strokes one by one. (dolist (stroke strokes) (ring-insert stroke-ring stroke) (thogai-insert-stroke stroke-ring)))) (defun thogai-insert-stroke (stroke-ring) "Translate the most recent stroke and insert it at point. STROKE-RING is the ring representing the current state, and should typically be `thogai-stroke-ring'." (if (string= (ring-ref stroke-ring 0) "*") ;; Special case to handle the undo operation (progn ;; Drop the "*" stroke from the state ring. (ring-remove stroke-ring 0) (let ((matched-strokes (or (thogai-longest-match (reverse (ring-elements stroke-ring))) (list (ring-ref stroke-ring 0))))) ;; Reverse the previous group of strokes. (thogai-reverse-strokes matched-strokes) ;; Delete space before strokes unless we are at the ;; beginning of the line. Note that attached and glued ;; strokes do not emit spaces. So, we cannot mindlessly ;; delete a character without checking if it is a space. (unless (= (line-beginning-position) (point)) (thogai-delete " ")) ;; Re-insert the previous group of strokes except for the ;; newest stroke. (pcase (reverse matched-strokes) (`(,_ . ,other-strokes) (thogai-inject-strokes (reverse other-strokes) (make-ring (length other-strokes)))))) ;; Remove the newest stroke from the state ring. (ring-remove stroke-ring 0)) (let ((matched-strokes (thogai-longest-match (reverse (ring-elements stroke-ring))))) ;; Delete translation for earlier strokes that are captured by ;; this translation. If no strokes were matched, skip this step. (unless (null matched-strokes) (thogai-reverse-strokes (butlast matched-strokes))) ;; Insert literal stroke if it is not in the dictionary. Else, ;; insert the actual translation. (if (null matched-strokes) (thogai-insert-translation (ring-ref stroke-ring 0)) (thogai-insert-translation (thogai-lookup (string-join matched-strokes "/"))))))) (defun thogai-byte-to-bits (byte) "Convert BYTE to a list of 8 bits. Each element of the returned list is a boolean, and the first element is the most significant bit." (seq-map (lambda (i) (not (zerop (logand byte (lsh 1 i))))) (number-sequence 7 0 -1))) (defun thogai-filter-mapn (function &rest sequences) "Map FUNCTION over SEQUENCES and return only non-nil results. Map FUNCTION over all SEQUENCES using `seq-mapn', but return a list of only the non-nil results." (seq-filter 'identity (apply 'seq-mapn function sequences))) (defun thogai-mapcatn (function &rest sequences) "Map FUNCTION over SEQUENCES and concatenate the results. Map FUNCTION over all SEQUENCES using `seq-mapn', and concatenate the results into a list." (apply 'seq-concatenate 'list (apply 'seq-mapn function sequences))) ;; See ;; https://github.com/openstenoproject/plover/blob/master/plover/machine/geminipr.py ;; for protocol documentation. (defun thogai-gemini-decode-stroke (bytes) "Decode stroke represented by BYTES from the Gemini protocol. BYTES is a list of 6 bytes in the Gemini protocol." (let* ((keys '(("Fn" "#1" "#2" "#3" "#4" "#5" "#6") ("S1-" "S2-" "T-" "K-" "P-" "W-" "H-") ("R-" "A-" "O-" "*1" "*2" "res1" "res2") ("pwr" "*3" "*4" "-E" "-U" "-F" "-R") ("-P" "-B" "-L" "-G" "-T" "-S" "-D") ("#7" "#8" "#9" "#A" "#B" "#C" "-Z"))) (pressed-keys (thogai-mapcatn (lambda (byte keys) (thogai-filter-mapn (lambda (selectp key) (and selectp key)) (seq-drop (thogai-byte-to-bits byte) 1) keys)) bytes keys))) ;; NOTE: We recognize only a subset of keys supported by the ;; Gemini protocol. For example, we recognize only a single S, not ;; S1 and S2. (let ((left (seq-mapcat (lambda (key) (string-trim-right key (rx (one-or-more (or ?1 ?2 ?-))))) (seq-filter (lambda (key) (or (string= key "#1") (and (not (member key (list "A-" "O-"))) (string-suffix-p "-" key)))) pressed-keys) 'string)) (vowel-or-star (seq-mapcat (lambda (key) (string-trim key "-" (rx (or ?- ?1)))) (seq-filter (lambda (key) (member key (list "A-" "O-" "*1" "-E" "-U"))) pressed-keys) 'string)) (right (seq-mapcat (lambda (key) (string-remove-prefix "-" key)) (seq-filter (lambda (key) (and (not (member key (list "-E" "-U"))) (string-prefix-p "-" key))) pressed-keys) 'string))) (concat left vowel-or-star ;; Add hyphen if there is no vowel but there are ;; right-side keys. (if (and (string= vowel-or-star "") (not (string= right ""))) "-" "") right)))) (let ((bytes nil)) (defun thogai-gemini-protocol-filter (process output) "Process filter for the Gemini serial protocol." (let ((bytes-per-stroke 6)) (dolist (byte (string-to-list output)) (push byte bytes) ;; The Gemini protocol represents each stroke by 6 ;; bytes. Decode stroke once 6 bytes are received. (when (= (length bytes) bytes-per-stroke) (let ((stroke (thogai-gemini-decode-stroke (reverse bytes)))) ;; Log to paper tape. (with-current-buffer (process-buffer process) (insert stroke) (insert "\n")) ;; Insert into stroke ring, and process translation. (ring-insert thogai-stroke-ring stroke) (thogai-insert-stroke thogai-stroke-ring)) (setq bytes nil)))))) (defun thogai-connect (port speed) "Connect to steno machine at serial PORT with SPEED." (interactive (list (serial-read-name) (serial-read-speed))) (make-serial-process :port port :buffer "*thogai-paper-tape*" :speed speed :filter 'thogai-gemini-protocol-filter) (message "Connected to steno machine at %s via the Gemini protocol" port)) (provide 'thogai) ;;; thogai.el ends here