(require 'quail)
(defvar tit-encode-list
'(("GB" euc-china "Chinese-GB")
("BIG5" cn-big5 "Chinese-BIG5")
("JIS" euc-japan "Japanese")
("KS" euc-kr "Korean")))
(defvar quail-cxterm-package-title-alist
'(("chinese-4corner" . "$(0(?-F(B")
("chinese-array30" . "$(0#R#O(B")
("chinese-ccdospy" . "$AKuF4(B")
("chinese-ctlau" . "$AAuTA(B")
("chinese-ctlaub" . "$(0N,Gn(B")
("chinese-ecdict" . "$(05CKH(B")
("chinese-etzy" . "$(06/0D(B")
("chinese-punct-b5" . "$(0O:(BB")
("chinese-punct" . "$A1j(BG")
("chinese-py-b5" . "$(03<(BB")
("chinese-py" . "$AF4(BG")
("chinese-qj-b5" . "$(0)A(BB")
("chinese-qj" . "$AH+(BG")
("chinese-sw" . "$AJWN2(B")
("chinese-tonepy" . "$A5wF4(B")
("chinese-ziranma" . "$AK+F4(B")
("chinese-zozy" . "$(0I\0D(B")))
(defsubst tit-read-key-value ()
(if (looking-at "[^ \t\n]+")
(car (read-from-string (concat "\"" (match-string 0) "\"")))))
(defun tit-make-quail-package-file-name (filename &optional dirname)
(expand-file-name
(concat (file-name-nondirectory (substring filename 0 -4)) ".el")
dirname))
(defconst tit-dictionary t)
(defvar tit-encode nil)
(defvar tit-default-encode "GB")
(defun tit-generate-key-bindings (keys function-symbol)
(let ((len (length keys))
(i 0)
(first t)
key)
(while (< i len)
(or first (princ "\n "))
(setq key (aref keys i))
(if (if (< key ?\ )
(eq (lookup-key quail-translation-keymap
(char-to-string key))
'quail-execute-non-quail-command)
(<= key 127))
(progn
(princ (cons (cond ((< key ?\ ) (format "\"\\C-%c\"" (+ key ?@)))
((< key 127) (format "\"%c\"" key))
(t "\"\\C-?\""))
function-symbol))
(setq first nil)))
(setq i (1+ i)))))
(defun tit-process-header (filename)
(message "Processing header part...")
(goto-char (point-min))
(let ((package (concat
"chinese-"
(substring (downcase (file-name-nondirectory filename))
0 -4)))
(tit-multichoice t)
(tit-prompt "")
(tit-comments nil)
(tit-backspace "\010\177")
(tit-deleteall "\015\025")
(tit-moveright ".>")
(tit-moveleft ",<")
(tit-keyprompt nil))
(princ ";; Quail package `")
(princ package)
(princ "' generated by the command `titdic-convert'\n;;\tDate: ")
(princ (current-time-string))
(princ "\n;;\tOriginal TIT dictionary file: ")
(princ (file-name-nondirectory filename))
(princ "\n\n;;; Comment:\n\n")
(princ ";; Byte-compile this file again after any modification.\n\n")
(princ ";;; Start of the header of original TIT dictionary.\n\n")
(while (not (eobp))
(let ((ch (following-char))
(pos (point)))
(cond ((= ch ?C) (cond ((looking-at "COMMENT")
(let ((pos (match-end 0)))
(end-of-line)
(setq tit-comments (cons (buffer-substring pos (point))
tit-comments))))))
((= ch ?M) (cond ((looking-at "MULTICHOICE:[ \t]*")
(goto-char (match-end 0))
(setq tit-multichoice (looking-at "YES")))
((looking-at "MOVERIGHT:[ \t]*")
(goto-char (match-end 0))
(setq tit-moveright (tit-read-key-value)))
((looking-at "MOVELEFT:[ \t]*")
(goto-char (match-end 0))
(setq tit-moveleft (tit-read-key-value)))))
((= ch ?P) (cond ((looking-at "PROMPT:[ \t]*")
(goto-char (match-end 0))
(setq tit-prompt (tit-read-key-value)))))
((= ch ?B) (cond ((looking-at "BACKSPACE:[ \t]*")
(goto-char (match-end 0))
(setq tit-backspace (tit-read-key-value)))
((looking-at "BEGINDICTIONARY")
(setq tit-dictionary t))
((looking-at "BEGINPHRASE")
(setq tit-dictionary nil))))
((= ch ?K) (cond ((looking-at "KEYPROMPT(\\(.*\\)):[ \t]*")
(let ((key-char (match-string 1)))
(goto-char (match-end 0))
(if (string-match "\\\\[0-9]+" key-char)
(setq key-char
(car (read-from-string (format "\"%s\""
key-char)))))
(setq tit-keyprompt
(cons (cons key-char (tit-read-key-value))
tit-keyprompt)))))))
(end-of-line)
(princ ";; ")
(princ (buffer-substring pos (point)))
(princ "\n")
(forward-line 1)))
(princ "\n;;; End of the header of original TIT dictionary.\n\n")
(princ ";;; Code:\n\n(require 'quail)\n\n")
(princ "(quail-define-package ")
(let ((title (cdr (assoc package quail-cxterm-package-title-alist))))
(princ "\"")
(princ package)
(princ "\" \"")
(princ (nth 2 (assoc tit-encode tit-encode-list)))
(princ "\" \"")
(princ (or title
(if (string-match "[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(B]+\\)" tit-prompt)
(substring tit-prompt (match-beginning 1) (match-end 1))
tit-prompt)))
(princ "\"\n"))
(if tit-keyprompt
(progn
(princ " '(")
(while tit-keyprompt
(princ " ")
(princ (format "(%d . \"%s\")\n"
(string-to-char (car (car tit-keyprompt)))
(cdr (car tit-keyprompt))))
(setq tit-keyprompt (cdr tit-keyprompt)))
(princ ")"))
(princ " t\n"))
(prin1
(mapconcat 'identity (cons tit-prompt (nreverse tit-comments)) "\n"))
(terpri)
(princ " '(")
(tit-generate-key-bindings tit-backspace 'quail-delete-last-char)
(princ "\n ")
(tit-generate-key-bindings tit-deleteall 'quail-abort-translation)
(princ "\n ")
(tit-generate-key-bindings tit-moveright 'quail-next-translation)
(princ "\n ")
(tit-generate-key-bindings tit-moveleft 'quail-prev-translation)
(princ ")\n")
(princ " nil")
(princ (if tit-multichoice " nil" " t"))
(princ (if tit-keyprompt " t t)\n\n" " nil nil)\n\n"))))
(defsubst tit-flush-translations (key translations)
(if (string-match "\\\\[0-9][0-9][0-9]" key)
(let ((newkey (concat (substring key 0 (match-beginning 0))
(car (read-from-string
(concat "\"" (match-string 0 key) "\"")))))
(idx (match-end 0)))
(while (string-match "\\\\[0-9][0-9][0-9]" key idx)
(setq newkey (concat
newkey
(substring key idx (match-beginning 0))
(car (read-from-string
(concat "\"" (match-string 0 key) "\"")))))
(setq idx (match-end 0)))
(setq key (concat newkey (substring key idx)))))
(prin1 (list key (if tit-dictionary translations
(vconcat (nreverse translations)))))
(princ "\n"))
(defun tit-process-body ()
(message "Formatting translation rules...")
(let* ((template (list nil nil))
(second (cdr template))
(prev-key "")
ch key translations pos)
(princ "(quail-define-rules\n")
(while (null (eobp))
(setq ch (following-char))
(if (or (= ch ?#) (= ch ?\n))
(forward-line 1)
(setq pos (point))
(skip-chars-forward "^ \t\n")
(setq key (buffer-substring pos (point)))
(skip-chars-forward " \t")
(setq ch (following-char))
(if (or (= ch ?#) (= ch ?\n))
(forward-line 1)
(or (string= key prev-key)
(progn
(if translations
(tit-flush-translations prev-key translations))
(setq translations nil
prev-key key)))
(if tit-dictionary
(progn
(setq pos (point))
(skip-chars-forward "^ \t#\n")
(setq translations
(if translations
(concat translations
(buffer-substring pos (point)))
(buffer-substring pos (point)))))
(while (not (eolp))
(setq pos (point))
(skip-chars-forward "^ \t\n")
(setq translations (cons (buffer-substring pos (point))
translations))
(skip-chars-forward " \t")
(setq ch (following-char))
(if (= ch ?#) (end-of-line))))
(forward-line 1))))
(if translations
(tit-flush-translations prev-key translations))
(princ ")\n")))
(defun titdic-convert (filename &optional dirname)
"Convert a TIT dictionary of FILENAME into a Quail package.
Optional argument DIRNAME if specified is the directory name under which
the generated Quail package is saved."
(interactive "FTIT dictionary file: ")
(with-temp-file (tit-make-quail-package-file-name filename dirname)
(set-buffer-file-coding-system 'iso-2022-7bit)
(let ((standard-output (current-buffer)))
(with-temp-buffer
(let ((coding-system-for-read 'no-conversion))
(insert-file-contents (expand-file-name filename)))
(set-buffer-multibyte t)
(if (not (search-forward "\nBEGIN" nil t))
(error "TIT dictionary doesn't have body part"))
(let ((limit (point))
coding-system slot)
(goto-char (point-min))
(if (re-search-forward "^ENCODE:[ \t]*" limit t)
(progn
(goto-char (match-end 0))
(setq tit-encode (tit-read-key-value)))
(setq tit-encode tit-default-encode))
(setq slot (assoc tit-encode tit-encode-list))
(if (not slot)
(error "Invalid ENCODE: value in TIT dictionary"))
(setq coding-system (nth 1 slot))
(message "Decoding with coding system %s..." coding-system)
(goto-char (point-min))
(decode-coding-region (point-min) (point-max) coding-system))
(goto-char (point-min))
(if (not (search-forward "\nBEGIN" nil t))
(error "TIT dictionary can't be decoded correctly"))
(forward-line 1)
(narrow-to-region (point-min) (point))
(tit-process-header filename)
(widen)
(with-current-buffer standard-output
(set-buffer-multibyte nil))
(set-buffer-multibyte nil)
(tit-process-body)))))
(defun batch-titdic-convert (&optional force)
"Run `titdic-convert' on the files remaining on the command line.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs.
For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(defvar command-line-args-left) (if (not noninteractive)
(error "`batch-titdic-convert' should be used only with -batch"))
(if (string= (car command-line-args-left) "-h")
(progn
(message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:")
(message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit")
(message "To convert XXX.tit into DIR/xxx.el:")
(message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit"))
(let (targetdir filename files file)
(if (string= (car command-line-args-left) "-dir")
(progn
(setq command-line-args-left (cdr command-line-args-left))
(setq targetdir (car command-line-args-left))
(setq command-line-args-left (cdr command-line-args-left))))
(while command-line-args-left
(setq filename (expand-file-name (car command-line-args-left)))
(if (file-directory-p filename)
(progn
(message "Converting all tit files in the directory %s" filename)
(setq files (directory-files filename t "\\.tit$")))
(setq files (list filename)))
(while files
(setq file (expand-file-name (car files)))
(when (or force
(file-newer-than-file-p
file (tit-make-quail-package-file-name file targetdir)))
(message "Converting %s to quail-package..." file)
(titdic-convert file targetdir))
(setq files (cdr files)))
(setq command-line-args-left (cdr command-line-args-left)))
(message "Byte-compile the created files by:")
(message " %% emacs -batch -f batch-byte-compile XXX.el")))
(kill-emacs 0))