1 ;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
4 ;; Licensed to the Free Software Foundation.
6 ;; Keywords: Quail, TIT, cxterm
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; Convert cxterm dictionary (of TIT format) to quail-package.
29 ;; Usage (within Emacs):
30 ;; M-x titdic-convert<CR>CXTERM-DICTIONARY-NAME<CR>
31 ;; Usage (from shell):
32 ;; % emacs -batch -l titdic-cnv -f batch-titdic-convert\
33 ;; [-dir DIR] [DIR | FILE] ...
35 ;; When you run titdic-convert within Emacs, you have a chance to
36 ;; modify arguments of `quail-define-package' before saving the
37 ;; converted file. For instance, you are likely to modify TITLE,
38 ;; DOCSTRING, and KEY-BINDINGS.
40 ;; Cxterm dictionary file (*.tit) is a line-oriented text (English,
41 ;; Chinese, Japanese, and Korean) file. The whole file contains of
42 ;; two parts, the definition part (`header' here after) followed by
43 ;; the dictionary part (`body' here after). All lines begin with
44 ;; leading '#' are ignored.
46 ;; Each line in the header part has two fields, KEY and VALUE. These
47 ;; fields are separated by one or more white characters.
49 ;; Each line in the body part has two fields, KEYSEQ and TRANSLATIONS.
50 ;; These fields are separated by one or more white characters.
52 ;; See the manual page of `tit2cit' of cxterm distribution for more
59 ;; List of values of key "ENCODE:" and the corresponding Emacs
60 ;; coding-system and language environment name.
61 (defvar tit-encode-list
62 '(("GB" euc-china
"Chinese-GB")
63 ("BIG5" cn-big5
"Chinese-BIG5")
64 ("JIS" euc-japan
"Japanese")
65 ("KS" euc-kr
"Korean")))
67 ;; List of package names and the corresponding titles.
68 (defvar quail-cxterm-package-title-alist
69 '(("chinese-4corner" .
"\e$(0(?-F\e(B")
70 ("chinese-array30" .
"\e$(0#R#O\e(B")
71 ("chinese-ccdospy" .
"\e$AKuF4\e(B")
72 ("chinese-ctlau" .
"\e$AAuTA\e(B")
73 ("chinese-ctlaub" .
"\e$(0N,Gn\e(B")
74 ("chinese-ecdict" .
"\e$(05CKH\e(B")
75 ("chinese-etzy" .
"\e$(06/0D\e(B")
76 ("chinese-punct-b5" .
"\e$(0O:\e(BB")
77 ("chinese-punct" .
"\e$A1j\e(BG")
78 ("chinese-py-b5" .
"\e$(03<\e(BB")
79 ("chinese-py" .
"\e$AF4\e(BG")
80 ("chinese-qj-b5" .
"\e$(0)A\e(BB")
81 ("chinese-qj" .
"\e$AH+\e(BG")
82 ("chinese-sw" .
"\e$AJWN2\e(B")
83 ("chinese-tonepy" .
"\e$A5wF4\e(B")
84 ("chinese-ziranma" .
"\e$AK+F4\e(B")
85 ("chinese-zozy" .
"\e$(0I\0D\e(B")))
87 ;; Return a value of the key in the current line.
88 (defsubst tit-read-key-value
()
89 (if (looking-at "[^ \t\n]+")
90 (car (read-from-string (concat "\"" (match-string 0) "\"")))))
92 ;; Return an appropriate quail-package filename from FILENAME (TIT
93 ;; dictionary filename). For instance, ".../ZOZY.tit" -> "ZOZY.el".
94 (defun tit-make-quail-package-file-name (filename &optional dirname
)
96 (concat (file-name-nondirectory (substring filename
0 -
4)) ".el")
99 ;; This value is nil if we are processing phrase dictionary.
100 (defconst tit-dictionary t
)
101 (defvar tit-encode nil
)
102 (defvar tit-default-encode
"GB")
104 ;; Generate elements of KEY-BINDINGS arg for `quail-define-package' so
105 ;; that each characters in KEYS invokes FUNCTION-SYMBOL.
106 (defun tit-generate-key-bindings (keys function-symbol
)
107 (let ((len (length keys
))
112 (or first
(princ "\n "))
113 (setq key
(aref keys i
))
115 (eq (lookup-key quail-translation-keymap
116 (char-to-string key
))
117 'quail-execute-non-quail-command
)
120 (princ (cons (cond ((< key ?\
) (format "\"\\C-%c\"" (+ key ?
@)))
121 ((< key
127) (format "\"%c\"" key
))
127 ;; Analyze header part of TIT dictionary and generate an appropriate
128 ;; `quail-define-package' function call.
129 (defun tit-process-header (filename)
130 (message "Processing header part...")
131 (goto-char (point-min))
133 ;; At first, generate header part of the Quail package while
134 ;; collecting information from the original header.
135 (let ((package (concat
137 (substring (downcase (file-name-nondirectory filename
))
139 ;; TIT keywords and the corresponding default values.
143 (tit-backspace "\010\177")
144 (tit-deleteall "\015\025")
149 (princ ";; Quail package `")
151 (princ "' generated by the command `titdic-convert'\n;;\tDate: ")
152 (princ (current-time-string))
153 (princ "\n;;\tOriginal TIT dictionary file: ")
154 (princ (file-name-nondirectory filename
))
155 (princ "\n\n;;; Comment:\n\n")
156 (princ ";; Byte-compile this file again after any modification.\n\n")
157 (princ ";;; Start of the header of original TIT dictionary.\n\n")
160 (let ((ch (following-char))
162 (cond ((= ch ?C
) ; COMMENT
163 (cond ((looking-at "COMMENT")
164 (let ((pos (match-end 0)))
166 (setq tit-comments
(cons (buffer-substring pos
(point))
168 ((= ch ?M
) ; MULTICHOICE, MOVERIGHT, MOVELEFT
169 (cond ((looking-at "MULTICHOICE:[ \t]*")
170 (goto-char (match-end 0))
171 (setq tit-multichoice
(looking-at "YES")))
172 ((looking-at "MOVERIGHT:[ \t]*")
173 (goto-char (match-end 0))
174 (setq tit-moveright
(tit-read-key-value)))
175 ((looking-at "MOVELEFT:[ \t]*")
176 (goto-char (match-end 0))
177 (setq tit-moveleft
(tit-read-key-value)))))
179 (cond ((looking-at "PROMPT:[ \t]*")
180 (goto-char (match-end 0))
181 (setq tit-prompt
(tit-read-key-value)))))
182 ((= ch ?B
) ; BACKSPACE, BEGINDICTIONARY,
184 (cond ((looking-at "BACKSPACE:[ \t]*")
185 (goto-char (match-end 0))
186 (setq tit-backspace
(tit-read-key-value)))
187 ((looking-at "BEGINDICTIONARY")
188 (setq tit-dictionary t
))
189 ((looking-at "BEGINPHRASE")
190 (setq tit-dictionary nil
))))
191 ((= ch ?K
) ; KEYPROMPT
192 (cond ((looking-at "KEYPROMPT(\\(.*\\)):[ \t]*")
193 (let ((key-char (match-string 1)))
194 (goto-char (match-end 0))
195 (if (string-match "\\\\[0-9]+" key-char
)
197 (car (read-from-string (format "\"%s\""
200 (cons (cons key-char
(tit-read-key-value))
204 (princ (buffer-substring pos
(point)))
208 (princ "\n;;; End of the header of original TIT dictionary.\n\n")
209 (princ ";;; Code:\n\n(require 'quail)\n\n")
211 (princ "(quail-define-package ")
212 ;; Args NAME, LANGUAGE, TITLE
213 (let ((title (cdr (assoc package quail-cxterm-package-title-alist
))))
217 (princ (nth 2 (assoc tit-encode tit-encode-list
)))
220 (if (string-match "[:\e$A!K\e$(0!(!J\e(B]+\\([^:\e$A!K\e$(0!(!K\e(B]+\\)" tit-prompt
)
221 (substring tit-prompt
(match-beginning 1) (match-end 1))
231 (princ (format "(%d . \"%s\")\n"
232 (string-to-char (car (car tit-keyprompt
)))
233 (cdr (car tit-keyprompt
))))
234 (setq tit-keyprompt
(cdr tit-keyprompt
)))
240 (mapconcat 'identity
(cons tit-prompt
(nreverse tit-comments
)) "\n"))
245 (tit-generate-key-bindings tit-backspace
'quail-delete-last-char
)
247 (tit-generate-key-bindings tit-deleteall
'quail-abort-translation
)
249 (tit-generate-key-bindings tit-moveright
'quail-next-translation
)
251 (tit-generate-key-bindings tit-moveleft
'quail-prev-translation
)
254 ;; Args FORGET-TRANSLATION, DETERMINISTIC, KBD-TRANSLATE, SHOW-LAYOUT.
255 ;; The remaining args are all nil.
257 (princ (if tit-multichoice
" nil" " t"))
258 (princ (if tit-keyprompt
" t t)\n\n" " nil nil)\n\n"))))
260 (defsubst tit-flush-translations
(key translations
)
261 (if (string-match "\\\\[0-9][0-9][0-9]" key
)
262 (let ((newkey (concat (substring key
0 (match-beginning 0))
263 (car (read-from-string
264 (concat "\"" (match-string 0 key
) "\"")))))
266 (while (string-match "\\\\[0-9][0-9][0-9]" key idx
)
269 (substring key idx
(match-beginning 0))
270 (car (read-from-string
271 (concat "\"" (match-string 0 key
) "\"")))))
272 (setq idx
(match-end 0)))
273 (setq key
(concat newkey
(substring key idx
)))))
274 (prin1 (list key
(if tit-dictionary translations
275 (vconcat (nreverse translations
)))))
278 ;; Convert body part of TIT dictionary into `quail-define-rules'
280 (defun tit-process-body ()
281 (message "Formatting translation rules...")
282 (let* ((template (list nil nil
))
283 (second (cdr template
))
285 ch key translations pos
)
286 (princ "(quail-define-rules\n")
288 (setq ch
(following-char))
289 (if (or (= ch ?
#) (= ch ?
\n))
292 (skip-chars-forward "^ \t\n")
293 (setq key
(buffer-substring pos
(point)))
294 (skip-chars-forward " \t")
295 (setq ch
(following-char))
296 (if (or (= ch ?
#) (= ch ?
\n))
297 ;; This entry contains no translations. Let's ignore it.
299 (or (string= key prev-key
)
302 (tit-flush-translations prev-key translations
))
303 (setq translations nil
308 (skip-chars-forward "^ \t#\n")
312 (buffer-substring pos
(point)))
313 (buffer-substring pos
(point)))))
316 (skip-chars-forward "^ \t\n")
317 (setq translations
(cons (buffer-substring pos
(point))
319 (skip-chars-forward " \t")
320 (setq ch
(following-char))
321 (if (= ch ?
#) (end-of-line))))
325 (tit-flush-translations prev-key translations
))
329 (defun titdic-convert (filename &optional dirname
)
330 "Convert a TIT dictionary of FILENAME into a Quail package.
331 Optional argument DIRNAME if specified is the directory name under which
332 the generated Quail package is saved."
333 (interactive "FTIT dictionary file: ")
334 (with-temp-file (tit-make-quail-package-file-name filename dirname
)
335 (set-buffer-file-coding-system 'iso-2022-7bit
)
336 (let ((standard-output (current-buffer)))
338 (let ((coding-system-for-read 'no-conversion
))
339 (insert-file-contents (expand-file-name filename
)))
340 (set-buffer-multibyte t
)
342 ;; Decode the buffer contents from the encoding specified by a
343 ;; value of the key "ENCODE:".
344 (if (not (search-forward "\nBEGIN" nil t
))
345 (error "TIT dictionary doesn't have body part"))
346 (let ((limit (point))
348 (goto-char (point-min))
349 (if (re-search-forward "^ENCODE:[ \t]*" limit t
)
351 (goto-char (match-end 0))
352 (setq tit-encode
(tit-read-key-value)))
353 (setq tit-encode tit-default-encode
))
354 (setq slot
(assoc tit-encode tit-encode-list
))
356 (error "Invalid ENCODE: value in TIT dictionary"))
357 (setq coding-system
(nth 1 slot
))
358 (message "Decoding with coding system %s..." coding-system
)
359 (goto-char (point-min))
360 (decode-coding-region (point-min) (point-max) coding-system
))
362 ;; Set point the starting position of the body part.
363 (goto-char (point-min))
364 (if (not (search-forward "\nBEGIN" nil t
))
365 (error "TIT dictionary can't be decoded correctly"))
367 ;; Process the header part.
369 (narrow-to-region (point-min) (point))
370 (tit-process-header filename
)
373 ;; Process the body part. For speed, we turn off multibyte facility.
374 (with-current-buffer standard-output
375 (set-buffer-multibyte nil
))
376 (set-buffer-multibyte nil
)
377 (tit-process-body)))))
380 (defun batch-titdic-convert (&optional force
)
381 "Run `titdic-convert' on the files remaining on the command line.
382 Use this from the command line, with `-batch';
383 it won't work in an interactive Emacs.
384 For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
385 generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
386 To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
387 (defvar command-line-args-left
) ; Avoid compiler warning.
388 (if (not noninteractive
)
389 (error "`batch-titdic-convert' should be used only with -batch"))
390 (if (string= (car command-line-args-left
) "-h")
392 (message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:")
393 (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit")
394 (message "To convert XXX.tit into DIR/xxx.el:")
395 (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit"))
396 (let (targetdir filename files file
)
397 (if (string= (car command-line-args-left
) "-dir")
399 (setq command-line-args-left
(cdr command-line-args-left
))
400 (setq targetdir
(car command-line-args-left
))
401 (setq command-line-args-left
(cdr command-line-args-left
))))
402 (while command-line-args-left
403 (setq filename
(expand-file-name (car command-line-args-left
)))
404 (if (file-directory-p filename
)
406 (message "Converting all tit files in the directory %s" filename
)
407 (setq files
(directory-files filename t
"\\.tit$")))
408 (setq files
(list filename
)))
410 (setq file
(expand-file-name (car files
)))
412 (file-newer-than-file-p
413 file
(tit-make-quail-package-file-name file targetdir
)))
414 (message "Converting %s to quail-package..." file
)
415 (titdic-convert file targetdir
))
416 (setq files
(cdr files
)))
417 (setq command-line-args-left
(cdr command-line-args-left
)))
418 (message "Byte-compile the created files by:")
419 (message " %% emacs -batch -f batch-byte-compile XXX.el")))
422 ;;; titdic-cnv.el ends here