Logitec Kanji tablet interface

k505.el

;;; -*- Mode: Emacs-Lisp; coding:shift_jis -*-

;;; Logitec K-505 Kanji tablet (漢字入力装置) interface for XEmacs.

(provide 'k505)

(if (string-match "XEmacs" emacs-version)
(progn

(defun k505-string-bytes (str)
  (mapcar 'char-to-int str))

;;; I feel I must be missing something about events.  Why can't Lisp
;;; code enqueue events?
(defun k505-process-char (char)
  (let ((event (if (symbolp char)
                   (make-event 'key-press (list 'key char))
                   (character-to-event char))))
    (enqueue-eval-event 'dispatch-event event)))

)
(progn

(eval-when-compile (require 'cl))

;; GNU Emacs version
(defun k505-string-bytes (str)
  (mapcar 'identity str))

(defun k505-process-char (char)
  (execute-kbd-macro (vector char)))

)
)

(defvar k505-serial-port "/dev/ttyS0" "Serial port to which Kanji table is attached.")

(defvar k505-process nil "Kanji table inferior process")

(defvar k505-pending nil "List of input from Kanji table to be processed")

(defun k505-filter (proc str)
  (setq k505-pending (nconc k505-pending (k505-string-bytes str)))
  (if (>= (length k505-pending) 2)
      (let ((char (k505-char (pop k505-pending) (pop k505-pending))))
        (if char
            (k505-process-char char)
            (beep)))))

(defun start-k505 ()
  "Start an inferior process talking to the Kanji tablet."
  (interactive)
  (stop-k505)
  (shell-command-to-string (concat "stty -F " k505-serial-port " speed 1200 raw"))
  (setq k505-process (let ((process-connection-type nil))
                       (start-process "k505" nil "cat" k505-serial-port)))
  (set-process-coding-system k505-process 'binary 'binary)
  (set-process-filter k505-process 'k505-filter))

(defun stop-k505 ()
  "Stop the Kanji table process."
  (interactive)
  (if k505-process
      (kill-process 
       (prog1 k505-process (setq k505-process nil)))))

(defun k505-char (b1 b2)
  (if (>= b1 #x80) (decf b1 #x80))
  (if (>= b2 #x80) (decf b2 #x80))
  (cond ((= b1 #x00)
         ;; Command.  These are in this order in the manual.  I am not
         ;; 100% sure what all of these are supposed to do.
         (case b2
           (#x60 )                      ;実行
           (#x61 )                      ;解除
           (#x62 )                      ;登録
           (#x63 )                      ;呼出
           (#x64 )                      ;印字
           (#x65 )                      ;印字停止
           (#x7F 'delete)               ;1字抹消 DEL
           (#x18 'cancel)               ;入カ訂正 CAN
           (#x12 'insert)               ;挿入 INS
           (#x05 'end)                  ;後部消去 EL
           (#x0B 'home)                 ;ホーム HOME
           (#x1D 'left)
           (#x1C 'right)
           (#x1E 'up)
           (#x1F 'down)
           (#x66 'next)
           (#x67 'prior)
           (#x08 'backspace)            ;後退 BS
           (#x0A 'linefeed)             ;改行 LF
           (#x09 'tab)                  ;タブ HT
           (#x5C )                      ;外字 EXC
           (#x68 )                      ;リスト LIST
           (#x69 )                      ;右づめ
           (#x31 )                      ;領域指定 AS
           (#x2B )                      ;揃え JF
           (#x4A )                      ;縦書 VWF
           (#x4B )                      ;横書 HWF
           (#x6A )                      ;改頁
           (#x6B )                      ;倍角
           (#x6C )                      ;全角
           (#x5E )                      ;半角 HSS
           (#x28 )                      ;書式設定 KGS
           (#x23 )                      ;タブ 設定
           (#x6D )                      ;ア ンダーラインモ ード
           (#x6E )                      ;ア ンダーライン付
           (#x6F )                      ;ア ンダーライン消
           (#x2A )                      ;強調 HL
           (#x0E )                      ;拡大 SO
           (#x0F )                      ;縮小 SI
           (#x5D )                      ;戻わ RBS
           (#x11 )                      ;コピー DUP
           (#x34 )                      ;画面消去 KED
           ))
        ((> b1 #x20)
         ;; Ordinary graphic character.
         (make-char 'japanese-jisx0208 b1 b2))))