Mercurial > emacs
annotate lisp/international/titdic-cnv.el @ 17562:512c5e112d10
Delete setting of byte-compile-dynamic,
byte-compile-dynamic-docstrings and byte-optimize.
(with-current-buffer): Duplicate definition deleted.
(save-buffer-state, do-while): Move defmacros to top level.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 25 Apr 1997 18:14:10 +0000 |
parents | 8917133b7e82 |
children | 1fe28ee1b0cd |
rev | line source |
---|---|
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 | |
17098
8917133b7e82
Remove prefix "coding-system-" from coding system symbol names.
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
62 '(("GB" euc-china "Chinese-GB") |
8917133b7e82
Remove prefix "coding-system-" from coding system symbol names.
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
63 ("BIG5" cn-big5 "Chinese-BIG5") |
8917133b7e82
Remove prefix "coding-system-" from coding system symbol names.
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
64 ("JIS" euc-japan "Japanese") |
8917133b7e82
Remove prefix "coding-system-" from coding system symbol names.
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
65 ("KS" euc-kk "Korean"))) |
17052 | 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) | |
17098
8917133b7e82
Remove prefix "coding-system-" from coding system symbol names.
Kenichi Handa <handa@m17n.org>
parents:
17071
diff
changeset
|
313 (set-buffer-file-coding-system 'iso-2022-7) |
17052 | 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 |