17052
|
1 ;;; titdic-cnv.el --- convert TIT dictionary to Quail package
|
|
2
|
|
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
|
|
4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
|
|
5
|
|
6 ;; Keywords: Quail, TIT, cxterm
|
|
7
|
|
8 ;; This file is part of GNU Emacs.
|
|
9
|
|
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)
|
|
13 ;; any later version.
|
|
14
|
|
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.
|
|
19
|
|
20 ;; You should have received a copy of the GNU General Public License
|
17071
|
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.
|
17052
|
24
|
|
25 ;;; Comments:
|
|
26
|
|
27 ;; Convert TIT format dictionary (of cxterm) to quail-package.
|
|
28 ;;
|
|
29 ;; Usage (within Emacs):
|
|
30 ;; M-x titdic-convert<CR>TIT-FILE-NAME<CR>
|
|
31 ;; Usage (from shell):
|
|
32 ;; % emacs -batch -l titdic-convert -f batch-titdic-convert\
|
|
33 ;; [-dir DIR] [DIR | FILE] ...
|
|
34 ;;
|
|
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.
|
|
39
|
|
40 ;; TIT 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.
|
|
45 ;;
|
|
46 ;; Each line in the header part has two fields, KEY and VALUE. These
|
|
47 ;; fields are separated by one or more white characters.
|
|
48 ;;
|
|
49 ;; Each line in the body part has two fields, KEYSEQ and TRANSLATIONS.
|
|
50 ;; These fields are separated by one or more white characters.
|
|
51 ;;
|
|
52 ;; See the manual page of `tit2cit' of cxterm distribution for more
|
|
53 ;; detail.
|
|
54
|
|
55 ;;; Code:
|
|
56
|
|
57 (require 'quail)
|
|
58
|
|
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" coding-system-euc-china "Chinese-GB")
|
|
63 ("BIG5" coding-system-big5 "Chinese-BIG5")
|
|
64 ("JIS" coding-system-euc-japan "Japanese")
|
|
65 ("KS" coding-system-euc-korea "Korean")))
|
|
66
|
|
67 ;; Return a value of the key in the current line.
|
|
68 (defsubst tit-read-key-value ()
|
|
69 (if (looking-at "[^ \t\n]+")
|
|
70 (car (read-from-string (concat "\"" (match-string 0) "\"")))))
|
|
71
|
|
72 ;; Return an appropriate quail-package filename from FILENAME (TIT
|
|
73 ;; dictionary filename). For instance, ".../ZOZY.tit" -> "zozy.el".
|
|
74 (defun tit-make-quail-package-name (filename &optional dirname)
|
|
75 (expand-file-name
|
|
76 (concat (downcase (file-name-nondirectory (substring filename 0 -4))) ".el")
|
|
77 dirname))
|
|
78
|
|
79 ;; This value is t if we are processing phrase dictionary.
|
|
80 (defvar tit-phrase nil)
|
|
81 (defvar tit-encode nil)
|
|
82 (defvar tit-default-encode "GB")
|
|
83
|
|
84 ;; Generate elements of KEY-BINDINGS arg for `quail-define-package' so
|
|
85 ;; that each characters in KEYS invokes FUNCTION-SYMBOL.
|
|
86 (defun tit-generate-key-bindings (keys function-symbol)
|
|
87 (let ((len (length keys))
|
|
88 (i 0)
|
|
89 key)
|
|
90 (while (< i len)
|
|
91 (setq key (aref keys i))
|
|
92 (indent-to 3)
|
|
93 (if (< key ?\ )
|
|
94 (if (eq (lookup-key quail-translation-keymap (char-to-string key))
|
|
95 'quail-execute-non-quail-command)
|
|
96 (insert (format "(\"\\C-%c\" . %s)\n"
|
|
97 (+ key ?@) function-symbol)))
|
|
98 (if (< key 127)
|
|
99 (insert (format "(\"%c\" . %s)\n" key function-symbol))
|
|
100 (insert (format "(\"\\C-?\" . %s)\n" function-symbol))))
|
|
101 (setq i (1+ i)))))
|
|
102
|
|
103 ;; Analyze header part of TIT dictionary and generate an appropriate
|
|
104 ;; `quail-define-package' function call.
|
|
105 (defun tit-process-header (filename)
|
|
106 (message "Processing header part...")
|
|
107 (goto-char (point-min))
|
|
108
|
|
109 (let (;; TIT keywords and the corresponding default values.
|
|
110 (tit-multichoice t)
|
|
111 (tit-prompt "")
|
|
112 (tit-comments nil)
|
|
113 (tit-backspace "\010\177")
|
|
114 (tit-deleteall "\015\025")
|
|
115 (tit-moveright ".>")
|
|
116 (tit-moveleft ",<")
|
|
117 (tit-keyprompt nil))
|
|
118 ;; At first, collect information from the header.
|
|
119 (while (not (eobp))
|
|
120 (insert ";; ")
|
|
121 (let ((ch (following-char)))
|
|
122 (cond ((= ch ?C) ; COMMENT
|
|
123 (cond ((looking-at "COMMENT")
|
|
124 (let ((pos (match-end 0)))
|
|
125 (end-of-line)
|
|
126 (while (re-search-backward "[\"\\]" pos t)
|
|
127 (insert "\\")
|
|
128 (forward-char -1))
|
|
129 (end-of-line)
|
|
130 (setq tit-comments (cons (buffer-substring pos (point))
|
|
131 tit-comments))))))
|
|
132 ((= ch ?M) ; MULTICHOICE, MOVERIGHT, MOVELEFT
|
|
133 (cond ((looking-at "MULTICHOICE:[ \t]*")
|
|
134 (goto-char (match-end 0))
|
|
135 (setq tit-multichoice (looking-at "YES")))
|
|
136 ((looking-at "MOVERIGHT:[ \t]*")
|
|
137 (goto-char (match-end 0))
|
|
138 (setq tit-moveright (tit-read-key-value)))
|
|
139 ((looking-at "MOVELEFT:[ \t]*")
|
|
140 (goto-char (match-end 0))
|
|
141 (setq tit-moveleft (tit-read-key-value)))))
|
|
142 ((= ch ?P) ; PROMPT
|
|
143 (cond ((looking-at "PROMPT:[ \t]*")
|
|
144 (goto-char (match-end 0))
|
|
145 (setq tit-prompt (tit-read-key-value)))))
|
|
146 ((= ch ?B) ; BACKSPACE, BEGINDICTIONARY,
|
|
147 ; BEGINPHRASE
|
|
148 (cond ((looking-at "BACKSPACE:[ \t]*")
|
|
149 (goto-char (match-end 0))
|
|
150 (setq tit-backspace (tit-read-key-value)))
|
|
151 ((looking-at "BEGINDICTIONARY")
|
|
152 (setq tit-phrase nil))
|
|
153 ((looking-at "BEGINPHRASE")
|
|
154 (setq tit-phrase t))))
|
|
155 ((= ch ?K) ; KEYPROMPT
|
|
156 (cond ((looking-at "KEYPROMPT(\\(.*\\)):[ \t]*")
|
|
157 (let ((key-char (match-string 1)))
|
|
158 (goto-char (match-end 0))
|
|
159 (setq tit-keyprompt
|
|
160 (cons (cons key-char (tit-read-key-value))
|
|
161 tit-keyprompt))))))))
|
|
162 (forward-line 1))
|
|
163
|
|
164 ;; Then, generate header part of the Quail package.
|
|
165 (goto-char (point-min))
|
|
166 (insert ";; Quail package `"
|
|
167 (substring (file-name-nondirectory buffer-file-name) 0 -3)
|
|
168 "' generated by the command `titdic-convert'\n"
|
|
169 ";;\tDate: " (current-time-string) "\n"
|
|
170 ";;\tOriginal TIT dictionary file: "
|
|
171 (file-name-nondirectory filename)
|
|
172 "\n\n"
|
|
173 ";;; Comment:\n\n"
|
|
174 ";; Do byte-compile this file again after any modification.\n\n"
|
|
175 ";;; Start of the header of original TIT dictionary.\n\n")
|
|
176
|
|
177 (goto-char (point-max))
|
|
178 (insert "\n"
|
|
179 ";;; End of the header of original TIT dictionary.\n\n"
|
|
180 ";;; Code:\n\n"
|
|
181 "(require 'quail)\n\n")
|
|
182
|
|
183 (insert "(quail-define-package ")
|
|
184 ;; Args NAME, LANGUAGE, TITLE
|
|
185 (insert
|
|
186 "\""
|
|
187 (concat "quail-"
|
|
188 (substring (file-name-nondirectory buffer-file-name) 0 -3))
|
|
189 "\" \"" (nth 2 (assoc tit-encode tit-encode-list))
|
|
190 "\" \""
|
|
191 (if (string-match "[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(B]+\\)" tit-prompt)
|
|
192 (substring tit-prompt (match-beginning 1) (match-end 1))
|
|
193 tit-prompt)
|
|
194 "\"\n")
|
|
195
|
|
196 ;; Arg GUIDANCE
|
|
197 (if tit-keyprompt
|
|
198 (progn
|
|
199 (insert " '(")
|
|
200 (while tit-keyprompt
|
|
201 (indent-to 3)
|
|
202 (insert (format "(%d . \"%s\")\n"
|
|
203 (string-to-char (car (car tit-keyprompt)))
|
|
204 (cdr (car tit-keyprompt))))
|
|
205 (setq tit-keyprompt (cdr tit-keyprompt)))
|
|
206 (forward-char -1)
|
|
207 (insert ")")
|
|
208 (forward-char 1))
|
|
209 (insert " t\n"))
|
|
210
|
|
211 ;; Arg DOCSTRING
|
|
212 (insert "\"" tit-prompt "\n")
|
|
213 (let ((l (nreverse tit-comments)))
|
|
214 (while l
|
|
215 (insert (format "%s\n" (car l)))
|
|
216 (setq l (cdr l))))
|
|
217 (insert "\"\n")
|
|
218
|
|
219 ;; Arg KEY-BINDINGS
|
|
220 (insert " '(")
|
|
221 (tit-generate-key-bindings tit-backspace 'quail-delete-last-char)
|
|
222 (tit-generate-key-bindings tit-deleteall 'quail-abort-translation)
|
|
223 (tit-generate-key-bindings tit-moveright 'quail-next-translation)
|
|
224 (tit-generate-key-bindings tit-moveleft 'quail-prev-translation)
|
|
225 (forward-char -1)
|
|
226 (insert ")")
|
|
227 (forward-char 1)
|
|
228
|
|
229 ;; Args FORGET-TRANSLATION, DETERMINISTIC, KBD-TRANSLATE, SHOW-LAYOUT.
|
|
230 ;; The remaining args are all nil.
|
|
231 (insert " nil"
|
|
232 (if tit-multichoice " nil" " t")
|
|
233 (if tit-keyprompt " t t)\n\n" " nil nil)\n\n")))
|
|
234
|
|
235 ;; Return the position of end of the header.
|
|
236 (point-max))
|
|
237
|
|
238 ;; Convert body part of TIT dictionary into `quail-define-rules'
|
|
239 ;; function call.
|
|
240 (defun tit-process-body ()
|
|
241 (message "Formatting translation rules...")
|
|
242 (let ((enable-multibyte-characters nil)
|
|
243 (keyseq "\000")
|
|
244 pos)
|
|
245 (insert "(quail-define-rules\n")
|
|
246 (while (null (eobp))
|
|
247 (if (or (= (following-char) ?#) (= (following-char) ?\n))
|
|
248 (insert ";; ")
|
|
249 (insert "(\"")
|
|
250 (setq pos (point))
|
|
251 (skip-chars-forward "^ \t")
|
|
252 (setq keyseq
|
|
253 (concat (regexp-quote (buffer-substring pos (point))) "[ \t]+"))
|
|
254 (save-excursion
|
|
255 (while (re-search-backward "[\\\"]" pos t)
|
|
256 (insert "\\")
|
|
257 (forward-char -1)))
|
|
258 (insert "\"")
|
|
259 (skip-chars-forward " \t")
|
|
260
|
|
261 ;; Now point is at the start of translations. Remember it in
|
|
262 ;; POS and combine lines of the same key sequence while
|
|
263 ;; deleting trailing white spaces and comments (start with
|
|
264 ;; '#'). POS doesn't has to be a marker because we never
|
|
265 ;; modify region before POS.
|
|
266 (setq pos (point))
|
|
267 (if (looking-at "[^ \t]*\\([ \t]*#.*\\)")
|
|
268 (delete-region (match-beginning 1) (match-end 1)))
|
|
269 (while (and (= (forward-line 1) 0)
|
|
270 (looking-at keyseq))
|
|
271 (let ((p (match-end 0)))
|
|
272 (skip-chars-backward " \t\n")
|
|
273 (delete-region (point) p)
|
|
274 (if tit-phrase (insert " "))
|
|
275 (if (looking-at "[^ \t]*\\([ \t]*#.*\\)")
|
|
276 (delete-region (match-beginning 1) (match-end 1)))
|
|
277 ))
|
|
278
|
|
279 ;; Modify the current line to meet the syntax of Quail package.
|
|
280 (goto-char pos)
|
|
281 (if tit-phrase
|
|
282 (progn
|
|
283 ;; PHRASE1 PHRASE2 ... => ["PHRASE1" "PHRASE2" ...]
|
|
284 (insert "[\"")
|
|
285 (skip-chars-forward "^ \t\n")
|
|
286 (while (not (eolp))
|
|
287 (insert "\"")
|
|
288 (forward-char 1)
|
|
289 (insert "\"")
|
|
290 (skip-chars-forward "^ \t\n"))
|
|
291 (insert "\"])"))
|
|
292 ;; TRANSLATIONS => "TRANSLATIONS"
|
|
293 (insert "\"")
|
|
294 (end-of-line)
|
|
295 (insert "\")")))
|
|
296 (forward-line 1))
|
|
297 (insert ")\n")))
|
|
298
|
|
299 ;;;###autoload
|
|
300 (defun titdic-convert (filename &optional dirname)
|
|
301 "Convert a TIT dictionary of FILENAME into a Quail package.
|
|
302 Optional argument DIRNAME if specified is the directory name under which
|
|
303 the generated Quail package is saved."
|
|
304 (interactive "FTIT dictionary file: ")
|
|
305 (let ((buf (get-buffer-create "*tit-work*")))
|
|
306 (save-excursion
|
|
307 ;; Setup the buffer.
|
|
308 (set-buffer buf)
|
|
309 (erase-buffer)
|
|
310 (let ((coding-system-for-read 'no-conversion))
|
|
311 (insert-file-contents (expand-file-name filename)))
|
|
312 (set-visited-file-name (tit-make-quail-package-name filename dirname) t)
|
|
313 (set-buffer-file-coding-system 'coding-system-iso-2022-7)
|
|
314
|
|
315 ;; Decode the buffer contents from the encoding specified by a
|
|
316 ;; value of the key "ENCODE:".
|
|
317 (let (coding-system)
|
|
318 (save-excursion
|
|
319 (if (search-forward "\nBEGIN" nil t)
|
|
320 (let ((limit (point))
|
|
321 slot)
|
|
322 (goto-char 1)
|
|
323 (if (re-search-forward "^ENCODE:[ \t]*" limit t)
|
|
324 (progn
|
|
325 (goto-char (match-end 0))
|
|
326 (setq tit-encode (tit-read-key-value)))
|
|
327 (setq tit-encode tit-default-encode))
|
|
328 (setq slot (assoc tit-encode tit-encode-list))
|
|
329 (if slot
|
|
330 (setq coding-system (nth 1 slot))
|
|
331 (error "Invalid ENCODE: value in TIT dictionary")))
|
|
332 (error "TIT dictionary doesn't have body part")))
|
|
333 (message "Decoding %s..." coding-system)
|
|
334 (goto-char 1)
|
|
335 (decode-coding-region 1 (point-max) coding-system))
|
|
336
|
|
337 ;; Set point the starting position of the body part.
|
|
338 (goto-char 1)
|
|
339 (if (search-forward "\nBEGIN" nil t)
|
|
340 (forward-line 1)
|
|
341 (error "TIT dictionary can't be decoded correctly"))
|
|
342
|
|
343 ;; Now process the header and body parts.
|
|
344 (goto-char
|
|
345 (save-excursion
|
|
346 (save-restriction
|
|
347 (narrow-to-region 1 (point))
|
|
348 (tit-process-header filename))))
|
|
349 (tit-process-body))
|
|
350
|
|
351 (if noninteractive
|
|
352 ;; Save the Quail package file.
|
|
353 (save-excursion
|
|
354 (set-buffer buf)
|
|
355 (save-buffer 0))
|
|
356 ;; Show the Quail package just generated.
|
|
357 (switch-to-buffer buf)
|
|
358 (goto-char 1)
|
|
359 (message "Save this buffer after you make any modification"))))
|
|
360
|
|
361 ;;;###autoload
|
|
362 (defun batch-titdic-convert ()
|
|
363 "Run `titdic-convert' on the files remaining on the command line.
|
|
364 Use this from the command line, with `-batch';
|
|
365 it won't work in an interactive Emacs.
|
|
366 For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
|
|
367 generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
|
|
368 To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
|
|
369 (defvar command-line-args-left) ; Avoid compiler warning.
|
|
370 (if (not noninteractive)
|
|
371 (error "`batch-titdic-convert' should be used only with -batch"))
|
|
372 (if (string= (car command-line-args-left) "-h")
|
|
373 (progn
|
|
374 (message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:")
|
|
375 (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit")
|
|
376 (message "To convert XXX.tit into DIR/xxx.el:")
|
|
377 (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit"))
|
|
378 (let (targetdir filename files file)
|
|
379 (if (string= (car command-line-args-left) "-dir")
|
|
380 (progn
|
|
381 (setq command-line-args-left (cdr command-line-args-left))
|
|
382 (setq targetdir (car command-line-args-left))
|
|
383 (setq command-line-args-left (cdr command-line-args-left))))
|
|
384 (while command-line-args-left
|
|
385 (setq filename (expand-file-name (car command-line-args-left)))
|
|
386 (if (file-directory-p filename)
|
|
387 (progn
|
|
388 (message "Converting all tit files in the directory %s" filename)
|
|
389 (setq files (directory-files filename t "\\.tit$")))
|
|
390 (setq files (list filename)))
|
|
391 (while files
|
|
392 (setq file (expand-file-name (car files)))
|
|
393 (if (file-newer-than-file-p
|
|
394 file (tit-make-quail-package-name file targetdir))
|
|
395 (progn
|
|
396 (message "Converting %s to quail-package..." file)
|
|
397 (titdic-convert file targetdir)))
|
|
398 (setq files (cdr files)))
|
|
399 (setq command-line-args-left (cdr command-line-args-left)))
|
|
400 (message "Do byte-compile the created files by:")
|
|
401 (message " %% emacs -batch -f batch-byte-compile XXX.el")))
|
|
402 (kill-emacs 0))
|
|
403
|
|
404 ;;; titdic-cnv.el ends here
|