|
70
|
1 ;; Convert tit format dictionary (of cxterm) to quail-package.
|
|
|
2 ;; Usage (within mule):
|
|
|
3 ;; M-x tit-to-quail<CR>tit-file-name<CR>
|
|
|
4 ;; Usage (from shell):
|
|
|
5 ;; % mule -batch -l quail/tit -f batch-tit-to-quail [dirname|filename] ...
|
|
|
6 ;; When you run tit-to-quail within Mule, you are shown lines for setting
|
|
|
7 ;; key bindings. You can modify them as you wish. After that, save the
|
|
|
8 ;; buffer into somewhere under your `load-path'.
|
|
|
9 ;; You may also modify the second arg PROMPT of quail-define-pacakge
|
|
|
10 ;; to shorter string.
|
|
|
11 ;; As for Big5 file, Big5-HKU is not supported, you must
|
|
|
12 ;; at first convert Big5-HKU to Big5-ETen before you run `tit-to-quail'.
|
|
|
13
|
|
|
14 (defun tit-value-head ()
|
|
|
15 (skip-chars-forward "^:")
|
|
|
16 (forward-char 1)
|
|
|
17 (skip-chars-forward " \t"))
|
|
|
18
|
|
|
19 (defun tit-set-keys ()
|
|
|
20 (let (limit str)
|
|
|
21 (save-excursion
|
|
|
22 (end-of-line)
|
|
|
23 (setq limit (point)))
|
|
|
24 (if (re-search-forward "[^ \t\n]+" limit t)
|
|
|
25 (progn
|
|
|
26 (setq str
|
|
|
27 (concat "\""
|
|
|
28 (buffer-substring (match-beginning 0) (match-end 0))
|
|
|
29 "\""))
|
|
|
30 (car (read-from-string str))))))
|
|
|
31
|
|
|
32 (defun tit-insert (arg)
|
|
|
33 (let ((pos (point)))
|
|
|
34 (insert arg)
|
|
|
35 (if (or (string-match "\"" arg) (string-match "\\\\" arg))
|
|
|
36 (save-excursion
|
|
|
37 (while (re-search-backward "\"\\|\\\\" pos t)
|
|
|
38 (insert "\\")
|
|
|
39 (forward-char -1))))))
|
|
|
40
|
|
|
41 (defun tit-buffer-substring (key)
|
|
|
42 (let ((i 0) ch)
|
|
|
43 (while (and (/= (setq ch (following-char)) ? )
|
|
|
44 (/= ch ?\t)
|
|
|
45 (/= ch ?\n))
|
|
|
46 (aset key i ch)
|
|
|
47 (setq i (1+ i))
|
|
|
48 (forward-char 1))
|
|
|
49 (aset key i 0)))
|
|
|
50
|
|
|
51 (defun tit-looking-at (key)
|
|
|
52 (let ((pos (point)) (i 0) ch)
|
|
|
53 (while (eq (char-after (+ pos i)) (aref key i))
|
|
|
54 (setq i (1+ i)))
|
|
|
55 (and (integerp (setq ch (char-after (+ pos i))))
|
|
|
56 (or (= ch ? ) (= ch ?\t))
|
|
|
57 (= (aref key i) 0))))
|
|
|
58
|
|
|
59 (defun tit-message (&rest args)
|
|
|
60 (if (null noninteractive)
|
|
|
61 (apply 'message args)))
|
|
|
62
|
|
|
63 ;; make quail-package name (e.g. ZOZY.tit -> .../quail/zozy.el)
|
|
|
64 (defun tit-dest-file (file &optional dir)
|
|
|
65 (expand-file-name
|
|
|
66 (concat (if dir "" "quail/")
|
|
|
67 (downcase (file-name-nondirectory (substring file 0 -4)))
|
|
|
68 ".el")
|
|
|
69 (or dir (car load-path))))
|
|
|
70
|
|
|
71 (defun tit-to-quail (tit-file &optional dest-dir)
|
|
|
72 (interactive "Ftit file: ")
|
|
|
73 (let ((buf (get-buffer-create "*tit-work*"))
|
|
|
74 pos
|
|
|
75 ;; tit keywords and default values
|
|
|
76 (encode '*euc-china*)
|
|
|
77 (multichoice t)
|
|
|
78 prompt
|
|
|
79 comment
|
|
|
80 validinputkey
|
|
|
81 (selectkey '["1 " "2" "3" "4" "5" "6" "7" "8" "9" "0"
|
|
|
82 nil nil nil nil nil nil])
|
|
|
83 (selectkey-idx 0)
|
|
|
84 (backspace "\177")
|
|
|
85 (deleteall "\C-u")
|
|
|
86 (moveright ".>")
|
|
|
87 (moveleft ",<")
|
|
|
88 keyprompt
|
|
|
89 phrase)
|
|
|
90 (save-excursion
|
|
|
91 (set-buffer buf)
|
|
|
92 (erase-buffer)
|
|
|
93 (if (null (string-match "\\.tit$" tit-file))
|
|
|
94 (setq tit-file (concat tit-file ".tit")))
|
|
|
95 (let ((file-coding-system-for-read '*noconv*))
|
|
|
96 (insert-file-contents tit-file))
|
|
|
97
|
|
|
98 (set-visited-file-name (tit-dest-file tit-file dest-dir))
|
|
|
99 (set-file-coding-system '*junet*unix)
|
|
|
100
|
|
|
101 ;; convert GB or BIG5 to Mule's internal code
|
|
|
102 (save-excursion
|
|
|
103 (if (re-search-forward "^ENCODE:" nil t)
|
|
|
104 (progn
|
|
|
105 (skip-chars-forward " \t")
|
|
|
106 (if (looking-at "GB")
|
|
|
107 (setq encode '*euc-china*)
|
|
|
108 (setq encode '*big5*)))))
|
|
|
109 (tit-message "Converting %s to Mule's internal code..." encode)
|
|
|
110 (code-convert 1 (point-max) encode '*internal*)
|
|
|
111
|
|
|
112 (goto-char 1)
|
|
|
113 ;; setting headers
|
|
|
114 (insert "(require 'quail)\n")
|
|
|
115
|
|
|
116 (tit-message "Extracting header information...")
|
|
|
117 (while (null (looking-at "BEGINDICTIONARY\\|BEGINPHRASE"))
|
|
|
118 (insert ";; ")
|
|
|
119 (let ((ch (following-char)))
|
|
|
120 (cond ((= ch ?C) ; COMMENT
|
|
|
121 (forward-word 1)
|
|
|
122 (setq pos (point))
|
|
|
123 (end-of-line)
|
|
|
124 (setq comment (cons (buffer-substring pos (point)) comment)))
|
|
|
125 ((= ch ?M) ; MULTICHOICE, MOVERIGHT, MOVELEFT
|
|
|
126 (cond ((looking-at "MULTI")
|
|
|
127 (tit-value-head)
|
|
|
128 (setq multichoice (looking-at "YES")))
|
|
|
129 ((looking-at "MOVERIGHT")
|
|
|
130 (tit-value-head)
|
|
|
131 (setq moveright (tit-set-keys)))
|
|
|
132 ((looking-at "MOVELEFT")
|
|
|
133 (tit-value-head)
|
|
|
134 (setq moveleft (tit-set-keys)))))
|
|
|
135 ((= ch ?P) ; PROMPT
|
|
|
136 (tit-value-head)
|
|
|
137 (setq pos (point))
|
|
|
138 (end-of-line)
|
|
|
139 (setq comment (cons (buffer-substring pos (point)) comment))
|
|
|
140 (setq pos (point))
|
|
|
141 (skip-chars-backward "^ \t")
|
|
|
142 (setq prompt (buffer-substring (point) pos)))
|
|
|
143 ((= ch ?S) ; SELECTKEY
|
|
|
144 (tit-value-head)
|
|
|
145 (let (key)
|
|
|
146 (while (and (< selectkey-idx 16) (setq key (tit-set-keys)))
|
|
|
147 (aset selectkey selectkey-idx key)
|
|
|
148 (setq selectkey-idx (1+ selectkey-idx)))))
|
|
|
149 ((= ch ?B) ; BACKSPACE
|
|
|
150 (tit-value-head)
|
|
|
151 (setq backspace (tit-set-keys)))
|
|
|
152 ((= ch ?K) ; KEYPROMPT
|
|
|
153 (forward-word 1)
|
|
|
154 (forward-char 1)
|
|
|
155 (setq pos (point))
|
|
|
156 (let (key str)
|
|
|
157 (search-forward ")" nil t)
|
|
|
158 (setq key (buffer-substring pos (1- (point))))
|
|
|
159 (skip-chars-forward ": \t")
|
|
|
160 (setq pos (point))
|
|
|
161 (forward-char 1)
|
|
|
162 (setq str (buffer-substring pos (point)))
|
|
|
163 (setq keyprompt (cons (cons key str) keyprompt))))
|
|
|
164 ))
|
|
|
165 (forward-line 1))
|
|
|
166
|
|
|
167 (setq phrase (looking-at "BEGINPHRASE"))
|
|
|
168 ;; comment out the line BEGINDICTIONARY/BEGINPHRASE
|
|
|
169 (insert ";; ")
|
|
|
170 (forward-line 1)
|
|
|
171
|
|
|
172 (tit-message "Defining quail-package...")
|
|
|
173 (insert "(quail-define-package \""
|
|
|
174 (substring (file-name-nondirectory buffer-file-name) 0 -3)
|
|
|
175 "\" \"")
|
|
|
176 (if (string-match "[:$A!K$(0!(!J(B]\\(.*\\)[:$A!K$(0!(!K(B]" prompt)
|
|
|
177 (tit-insert (substring prompt (match-beginning 1) (match-end 1)))
|
|
|
178 (tit-insert prompt))
|
|
|
179 (insert "\"\n")
|
|
|
180 (if multichoice
|
|
|
181 (insert " t\n")
|
|
|
182 (if keyprompt
|
|
|
183 (let (key)
|
|
|
184 (insert " '(")
|
|
|
185 (while keyprompt
|
|
|
186 (setq key (car keyprompt))
|
|
|
187 (insert "(?")
|
|
|
188 (tit-insert (car key))
|
|
|
189 (insert " . \"")
|
|
|
190 (tit-insert (cdr key))
|
|
|
191 (insert "\")\n ")
|
|
|
192 (setq keyprompt (cdr keyprompt)))
|
|
|
193 (setq pos (point))
|
|
|
194 (forward-char -4)
|
|
|
195 (delete-region (point) pos)
|
|
|
196 (insert ")\n"))
|
|
|
197 (insert " nil\n")))
|
|
|
198 (if comment
|
|
|
199 (progn
|
|
|
200 (insert " \"")
|
|
|
201 (setq comment (nreverse comment))
|
|
|
202 (while comment
|
|
|
203 (tit-insert (car comment))
|
|
|
204 (insert "\n")
|
|
|
205 (setq comment (cdr comment)))
|
|
|
206 (forward-char -1)
|
|
|
207 (insert "\"")
|
|
|
208 (forward-char 1))
|
|
|
209 (insert " \"\"\n"))
|
|
|
210 (let (i len key)
|
|
|
211 (insert " '(\n")
|
|
|
212 (setq i 0 len (length moveright))
|
|
|
213 (while (< i len)
|
|
|
214 (setq key (aref moveright i))
|
|
|
215 (if (and (>= key ? ) (< key 127))
|
|
|
216 (progn
|
|
|
217 (insert " (\"")
|
|
|
218 (tit-insert (char-to-string (aref moveright i)))
|
|
|
219 (insert "\" . quail-next-candidate-block)\n")))
|
|
|
220 (setq i (1+ i)))
|
|
|
221 (setq i 0 len (length moveleft))
|
|
|
222 (while (< i len)
|
|
|
223 (setq key (aref moveleft i))
|
|
|
224 (if (and (>= key ? ) (< key 127))
|
|
|
225 (progn
|
|
|
226 (insert " (\"")
|
|
|
227 (tit-insert (char-to-string (aref moveleft i)))
|
|
|
228 (insert "\" . quail-prev-candidate-block)\n")))
|
|
|
229 (setq i (1+ i)))
|
|
|
230 (if (string-match " " (aref selectkey 0))
|
|
|
231 (insert " (\" \" . quail-select-current)\n"))
|
|
|
232 (insert " )\n"))
|
|
|
233 (insert " nil" (if multichoice " nil" " t") ")\n\n")
|
|
|
234
|
|
|
235 (tit-message "Formatting translation rules...")
|
|
|
236 (let ((mc-flag nil)
|
|
|
237 (key (make-string 30 0)))
|
|
|
238 (while (null (eobp))
|
|
|
239 (if (or (= (following-char) ?#) (= (following-char) ?\n))
|
|
|
240 (progn
|
|
|
241 (insert ";; ")
|
|
|
242 (forward-line 1))
|
|
|
243 (insert (if phrase "(qd \"" "(qdv \""))
|
|
|
244 (setq pos (point))
|
|
|
245 (tit-buffer-substring key)
|
|
|
246 (save-excursion
|
|
|
247 (while (re-search-backward "\"\\|\\\\[^0-9]" pos t)
|
|
|
248 (insert "\\")
|
|
|
249 (forward-char -1)))
|
|
|
250 (insert "\"")
|
|
|
251 (skip-chars-forward " \t")
|
|
|
252 (if (eolp)
|
|
|
253 (progn
|
|
|
254 (beginning-of-line)
|
|
|
255 (setq pos (point))
|
|
|
256 (forward-line 1)
|
|
|
257 (delete-region pos (point)))
|
|
|
258 (insert (if phrase "'(" "\""))
|
|
|
259 (setq pos (point))
|
|
|
260 (forward-line 1)
|
|
|
261 (while (tit-looking-at key)
|
|
|
262 (let (p)
|
|
|
263 (skip-chars-backward " \t\n")
|
|
|
264 (if phrase (insert " "))
|
|
|
265 (setq p (point))
|
|
|
266 (skip-chars-forward " \t\n")
|
|
|
267 (skip-chars-forward "^ \t")
|
|
|
268 (skip-chars-forward " \t")
|
|
|
269 (delete-region p (point)))
|
|
|
270 (forward-line 1))
|
|
|
271 (goto-char pos)
|
|
|
272 (if phrase
|
|
|
273 (while (null (eolp))
|
|
|
274 (insert "\"")
|
|
|
275 (skip-chars-forward "^ \t\n")
|
|
|
276 (insert "\"")
|
|
|
277 (skip-chars-forward " \t"))
|
|
|
278 (let ((mc-flag t)) (forward-char 1))
|
|
|
279 (if (= (following-char) ?\n)
|
|
|
280 (progn
|
|
|
281 (beginning-of-line)
|
|
|
282 (forward-char 3)
|
|
|
283 (delete-char 1))))
|
|
|
284 (end-of-line)
|
|
|
285 (insert (if phrase "))" "\")"))
|
|
|
286 (forward-line 1)))))
|
|
|
287 (insert "\n(quail-setup-current-package)\n")
|
|
|
288 )
|
|
|
289
|
|
|
290 (if noninteractive
|
|
|
291 (save-excursion
|
|
|
292 (set-buffer buf)
|
|
|
293 (write-file buffer-file-name))
|
|
|
294 ;; show user the line for keymap definition.
|
|
|
295 (switch-to-buffer buf)
|
|
|
296 (goto-char 1)
|
|
|
297 (search-forward "defconst" nil t)
|
|
|
298 (beginning-of-line)
|
|
|
299 (recenter 1)
|
|
|
300 (tit-message
|
|
|
301 "Modify key bindings or prompt as you wish and save this file.")
|
|
|
302 )
|
|
|
303 ))
|
|
|
304
|
|
|
305 (defun batch-tit-to-quail ()
|
|
|
306 "Run `tit-to-quail' on the files remaining on the command line.
|
|
|
307 Use this from the command line, with `-batch';
|
|
|
308 it won't work in an interactive Emacs.
|
|
|
309 For example, invoke \"emacs -batch -f batch-tit-to-quail $emacs/ ~/*.el\""
|
|
|
310 (defvar command-line-args-left) ;Avoid 'free variable' warning
|
|
|
311 (if (not noninteractive)
|
|
|
312 (error "`batch-tit-to-quail' is to be used only with -batch"))
|
|
|
313 (let ((error nil))
|
|
|
314 (while command-line-args-left
|
|
|
315 (if (file-directory-p (expand-file-name (car command-line-args-left)))
|
|
|
316 (let ((files (directory-files (car command-line-args-left)))
|
|
|
317 file)
|
|
|
318 (while files
|
|
|
319 (setq file (expand-file-name (car files)
|
|
|
320 (car command-line-args-left)))
|
|
|
321 (if (and (string-match "\\.tit$" file)
|
|
|
322 (file-newer-than-file-p
|
|
|
323 file
|
|
|
324 (tit-dest-file file default-directory)))
|
|
|
325 (progn
|
|
|
326 (message "Converting %s to quail-package..." file)
|
|
|
327 (tit-to-quail file default-directory)))
|
|
|
328 (setq files (cdr files))))
|
|
|
329 (tit-to-quail (car command-line-args-left) default-directory))
|
|
|
330 (setq command-line-args-left (cdr command-line-args-left)))
|
|
|
331 (kill-emacs 0)))
|
