1 ;;; titdic-cnv.el --- convert TIT dictionary to Quail package
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
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
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;; Convert TIT format dictionary (of cxterm) to quail-package.
28 ;; Usage (within Emacs):
29 ;; M-x titdic-convert<CR>TIT-FILE-NAME<CR>
30 ;; Usage (from shell):
31 ;; % emacs -batch -l titdic-convert -f batch-titdic-convert\
32 ;; [-dir DIR] [DIR | FILE] ...
34 ;; When you run titdic-convert within Emacs, you have a chance to
35 ;; modify arguments of `quail-define-package' before saving the
36 ;; converted file. For instance, you are likely to modify TITLE,
37 ;; DOCSTRING, and KEY-BINDINGS.
39 ;; TIT dictionary file (*.tit) is a line-oriented text (English,
40 ;; Chinese, Japanese, and Korean) file. The whole file contains of
41 ;; two parts, the definition part (`header' here after) followed by
42 ;; the dictionary part (`body' here after). All lines begin with
43 ;; leading '#' are ignored.
45 ;; Each line in the header part has two fields, KEY and VALUE. These
46 ;; fields are separated by one or more white characters.
48 ;; Each line in the body part has two fields, KEYSEQ and TRANSLATIONS.
49 ;; These fields are separated by one or more white characters.
51 ;; See the manual page of `tit2cit' of cxterm distribution for more
58 ;; List of values of key "ENCODE:" and the corresponding Emacs'
59 ;; coding-system and language environment name.
60 (defvar tit-encode-list
61 '(("GB" coding-system-euc-china
"Chinese-GB")
62 ("BIG5" coding-system-big5
"Chinese-BIG5")
63 ("JIS" coding-system-euc-japan
"Japanese")
64 ("KS" coding-system-euc-korea
"Korean")))
66 ;; Return a value of the key in the current line.
67 (defsubst tit-read-key-value
()
68 (if (looking-at "[^ \t\n]+")
69 (car (read-from-string (concat "\"" (match-string 0) "\"")))))
71 ;; Return an appropriate quail-package filename from FILENAME (TIT
72 ;; dictionary filename). For instance, ".../ZOZY.tit" -> "zozy.el".
73 (defun tit-make-quail-package-name (filename &optional dirname
)
75 (concat (downcase (file-name-nondirectory (substring filename
0 -
4))) ".el")
78 ;; This value is t if we are processing phrase dictionary.
79 (defvar tit-phrase nil
)
80 (defvar tit-encode nil
)
81 (defvar tit-default-encode
"GB")
83 ;; Generate elements of KEY-BINDINGS arg for `quail-define-package' so
84 ;; that each characters in KEYS invokes FUNCTION-SYMBOL.
85 (defun tit-generate-key-bindings (keys function-symbol
)
86 (let ((len (length keys
))
90 (setq key
(aref keys i
))
93 (if (eq (lookup-key quail-translation-keymap
(char-to-string key
))
94 'quail-execute-non-quail-command
)
95 (insert (format "(\"\\C-%c\" . %s)\n"
96 (+ key ?
@) function-symbol
)))
98 (insert (format "(\"%c\" . %s)\n" key function-symbol
))
99 (insert (format "(\"\\C-?\" . %s)\n" function-symbol
))))
102 ;; Analyze header part of TIT dictionary and generate an appropriate
103 ;; `quail-define-package' function call.
104 (defun tit-process-header (filename)
105 (message "Processing header part...")
106 (goto-char (point-min))
108 (let (;; TIT keywords and the corresponding default values.
112 (tit-backspace "\010\177")
113 (tit-deleteall "\015\025")
117 ;; At first, collect information from the header.
120 (let ((ch (following-char)))
121 (cond ((= ch ?C
) ; COMMENT
122 (cond ((looking-at "COMMENT")
123 (let ((pos (match-end 0)))
125 (while (re-search-backward "[\"\\]" pos t
)
129 (setq tit-comments
(cons (buffer-substring pos
(point))
131 ((= ch ?M
) ; MULTICHOICE, MOVERIGHT, MOVELEFT
132 (cond ((looking-at "MULTICHOICE:[ \t]*")
133 (goto-char (match-end 0))
134 (setq tit-multichoice
(looking-at "YES")))
135 ((looking-at "MOVERIGHT:[ \t]*")
136 (goto-char (match-end 0))
137 (setq tit-moveright
(tit-read-key-value)))
138 ((looking-at "MOVELEFT:[ \t]*")
139 (goto-char (match-end 0))
140 (setq tit-moveleft
(tit-read-key-value)))))
142 (cond ((looking-at "PROMPT:[ \t]*")
143 (goto-char (match-end 0))
144 (setq tit-prompt
(tit-read-key-value)))))
145 ((= ch ?B
) ; BACKSPACE, BEGINDICTIONARY,
147 (cond ((looking-at "BACKSPACE:[ \t]*")
148 (goto-char (match-end 0))
149 (setq tit-backspace
(tit-read-key-value)))
150 ((looking-at "BEGINDICTIONARY")
151 (setq tit-phrase nil
))
152 ((looking-at "BEGINPHRASE")
153 (setq tit-phrase t
))))
154 ((= ch ?K
) ; KEYPROMPT
155 (cond ((looking-at "KEYPROMPT(\\(.*\\)):[ \t]*")
156 (let ((key-char (match-string 1)))
157 (goto-char (match-end 0))
159 (cons (cons key-char
(tit-read-key-value))
160 tit-keyprompt
))))))))
163 ;; Then, generate header part of the Quail package.
164 (goto-char (point-min))
165 (insert ";; Quail package `"
166 (substring (file-name-nondirectory buffer-file-name
) 0 -
3)
167 "' generated by the command `titdic-convert'\n"
168 ";;\tDate: " (current-time-string) "\n"
169 ";;\tOriginal TIT dictionary file: "
170 (file-name-nondirectory filename
)
173 ";; Do byte-compile this file again after any modification.\n\n"
174 ";;; Start of the header of original TIT dictionary.\n\n")
176 (goto-char (point-max))
178 ";;; End of the header of original TIT dictionary.\n\n"
180 "(require 'quail)\n\n")
182 (insert "(quail-define-package ")
183 ;; Args NAME, LANGUAGE, TITLE
187 (substring (file-name-nondirectory buffer-file-name
) 0 -
3))
188 "\" \"" (nth 2 (assoc tit-encode tit-encode-list
))
190 (if (string-match "[:\e$A!K\e$(0!(!J\e(B]+\\([^:\e$A!K\e$(0!(!K\e(B]+\\)" tit-prompt
)
191 (substring tit-prompt
(match-beginning 1) (match-end 1))
201 (insert (format "(%d . \"%s\")\n"
202 (string-to-char (car (car tit-keyprompt
)))
203 (cdr (car tit-keyprompt
))))
204 (setq tit-keyprompt
(cdr tit-keyprompt
)))
211 (insert "\"" tit-prompt
"\n")
212 (let ((l (nreverse tit-comments
)))
214 (insert (format "%s\n" (car l
)))
220 (tit-generate-key-bindings tit-backspace
'quail-delete-last-char
)
221 (tit-generate-key-bindings tit-deleteall
'quail-abort-translation
)
222 (tit-generate-key-bindings tit-moveright
'quail-next-translation
)
223 (tit-generate-key-bindings tit-moveleft
'quail-prev-translation
)
228 ;; Args FORGET-TRANSLATION, DETERMINISTIC, KBD-TRANSLATE, SHOW-LAYOUT.
229 ;; The remaining args are all nil.
231 (if tit-multichoice
" nil" " t")
232 (if tit-keyprompt
" t t)\n\n" " nil nil)\n\n")))
234 ;; Return the position of end of the header.
237 ;; Convert body part of TIT dictionary into `quail-define-rules'
239 (defun tit-process-body ()
240 (message "Formatting translation rules...")
241 (let ((enable-multibyte-characters nil
)
244 (insert "(quail-define-rules\n")
246 (if (or (= (following-char) ?
#) (= (following-char) ?
\n))
250 (skip-chars-forward "^ \t")
252 (concat (regexp-quote (buffer-substring pos
(point))) "[ \t]+"))
254 (while (re-search-backward "[\\\"]" pos t
)
258 (skip-chars-forward " \t")
260 ;; Now point is at the start of translations. Remember it in
261 ;; POS and combine lines of the same key sequence while
262 ;; deleting trailing white spaces and comments (start with
263 ;; '#'). POS doesn't has to be a marker because we never
264 ;; modify region before POS.
266 (if (looking-at "[^ \t]*\\([ \t]*#.*\\)")
267 (delete-region (match-beginning 1) (match-end 1)))
268 (while (and (= (forward-line 1) 0)
270 (let ((p (match-end 0)))
271 (skip-chars-backward " \t\n")
272 (delete-region (point) p
)
273 (if tit-phrase
(insert " "))
274 (if (looking-at "[^ \t]*\\([ \t]*#.*\\)")
275 (delete-region (match-beginning 1) (match-end 1)))
278 ;; Modify the current line to meet the syntax of Quail package.
282 ;; PHRASE1 PHRASE2 ... => ["PHRASE1" "PHRASE2" ...]
284 (skip-chars-forward "^ \t\n")
289 (skip-chars-forward "^ \t\n"))
291 ;; TRANSLATIONS => "TRANSLATIONS"
299 (defun titdic-convert (filename &optional dirname
)
300 "Convert a TIT dictionary of FILENAME into a Quail package.
301 Optional argument DIRNAME if specified is the directory name under which
302 the generated Quail package is saved."
303 (interactive "FTIT dictionary file: ")
304 (let ((buf (get-buffer-create "*tit-work*")))
309 (let ((coding-system-for-read 'no-conversion
))
310 (insert-file-contents (expand-file-name filename
)))
311 (set-visited-file-name (tit-make-quail-package-name filename dirname
) t
)
312 (set-buffer-file-coding-system 'coding-system-iso-2022-7
)
314 ;; Decode the buffer contents from the encoding specified by a
315 ;; value of the key "ENCODE:".
318 (if (search-forward "\nBEGIN" nil t
)
319 (let ((limit (point))
322 (if (re-search-forward "^ENCODE:[ \t]*" limit t
)
324 (goto-char (match-end 0))
325 (setq tit-encode
(tit-read-key-value)))
326 (setq tit-encode tit-default-encode
))
327 (setq slot
(assoc tit-encode tit-encode-list
))
329 (setq coding-system
(nth 1 slot
))
330 (error "Invalid ENCODE: value in TIT dictionary")))
331 (error "TIT dictionary doesn't have body part")))
332 (message "Decoding %s..." coding-system
)
334 (decode-coding-region 1 (point-max) coding-system
))
336 ;; Set point the starting position of the body part.
338 (if (search-forward "\nBEGIN" nil t
)
340 (error "TIT dictionary can't be decoded correctly"))
342 ;; Now process the header and body parts.
346 (narrow-to-region 1 (point))
347 (tit-process-header filename
))))
351 ;; Save the Quail package file.
355 ;; Show the Quail package just generated.
356 (switch-to-buffer buf
)
358 (message "Save this buffer after you make any modification"))))
361 (defun batch-titdic-convert ()
362 "Run `titdic-convert' on the files remaining on the command line.
363 Use this from the command line, with `-batch';
364 it won't work in an interactive Emacs.
365 For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
366 generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
367 To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
368 (defvar command-line-args-left
) ; Avoid compiler warning.
369 (if (not noninteractive
)
370 (error "`batch-titdic-convert' should be used only with -batch"))
371 (if (string= (car command-line-args-left
) "-h")
373 (message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:")
374 (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit")
375 (message "To convert XXX.tit into DIR/xxx.el:")
376 (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit"))
377 (let (targetdir filename files file
)
378 (if (string= (car command-line-args-left
) "-dir")
380 (setq command-line-args-left
(cdr command-line-args-left
))
381 (setq targetdir
(car command-line-args-left
))
382 (setq command-line-args-left
(cdr command-line-args-left
))))
383 (while command-line-args-left
384 (setq filename
(expand-file-name (car command-line-args-left
)))
385 (if (file-directory-p filename
)
387 (message "Converting all tit files in the directory %s" filename
)
388 (setq files
(directory-files filename t
"\\.tit$")))
389 (setq files
(list filename
)))
391 (setq file
(expand-file-name (car files
)))
392 (if (file-newer-than-file-p
393 file
(tit-make-quail-package-name file targetdir
))
395 (message "Converting %s to quail-package..." file
)
396 (titdic-convert file targetdir
)))
397 (setq files
(cdr files
)))
398 (setq command-line-args-left
(cdr command-line-args-left
)))
399 (message "Do byte-compile the created files by:")
400 (message " %% emacs -batch -f batch-byte-compile XXX.el")))
403 ;;; titdic-cnv.el ends here