|
70
|
1 ;;; mule-diag.el --- debugging functions for Mule.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1995 Sun Microsystems.
|
|
|
5
|
|
|
6 ;; This file is part of XEmacs.
|
|
|
7
|
|
|
8 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
9 ;; under the terms of the GNU General Public License as published by
|
|
|
10 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
11 ;; any later version.
|
|
|
12
|
|
|
13 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
16 ;; General Public License for more details.
|
|
|
17
|
|
|
18 ;; You should have received a copy of the GNU General Public License
|
|
|
19 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
21 ;; Boston, MA 02111-1307, USA.
|
|
|
22
|
|
|
23 ;;; 93.7.28 created for Mule Ver.0.9.8 by K.Handa <handa@etl.go.jp>
|
|
|
24
|
|
|
25 ;;; General utility function
|
|
|
26
|
|
|
27 (defun mule-debug-princ-list (&rest args)
|
|
|
28 (while (cdr args)
|
|
|
29 (if (car args)
|
|
|
30 (progn (princ (car args)) (princ " ")))
|
|
|
31 (setq args (cdr args)))
|
|
|
32 (princ (car args))
|
|
|
33 (princ "\n"))
|
|
|
34
|
|
|
35 ;;; character sets
|
|
|
36
|
|
|
37 ;;;###autoload
|
|
|
38 (defun list-charsets ()
|
|
|
39 "Display a list of existing character sets."
|
|
|
40 (interactive)
|
|
|
41 (with-output-to-temp-buffer "*Charset List*"
|
|
|
42 (princ "## LIST OF CHARACTER SETS\n")
|
|
|
43 (princ
|
|
|
44 "NAME REGISTRY BYTES CHARS FINAL GRAPHIC DIR\n")
|
|
|
45 (princ
|
|
|
46 "--------------------------------------------------------------------")
|
|
|
47 (mapcar
|
|
|
48 (lambda (name)
|
|
|
49 (let ((charset (get-charset name)))
|
|
|
50 (princ (format
|
|
|
51 "%20s %15s %5d %5d %5d %7d %s\n"
|
|
|
52 name
|
|
|
53 (charset-registry charset)
|
|
|
54 (charset-dimension charset)
|
|
|
55 (charset-chars charset)
|
|
|
56 (charset-final charset)
|
|
|
57 (charset-graphic charset)
|
|
|
58 (charset-direction charset)))
|
|
|
59 (princ " ")
|
|
|
60 (princ "%s\n" (charset-doc-string charset))))
|
|
|
61 (charset-list))
|
|
|
62
|
|
|
63 (princ "## CCL PROGRAM TO CONVERT INTERNAL TO EXTERNAL CODE\n")
|
|
|
64 (princ "NAME CCL-PROGRAMS\n")
|
|
|
65 (mapcar
|
|
|
66 (lambda (name)
|
|
|
67 (let ((ccl (charset-ccl-program name)))
|
|
|
68 (if ccl
|
|
|
69 (let ((i 0) (len (length ccl)))
|
|
|
70 (princ (format "%20s " name))
|
|
|
71 (while (< i len)
|
|
|
72 (princ (format " %x" (aref ccl i)))
|
|
|
73 (setq i (1+ i)))
|
|
|
74 (princ "\n")))))
|
|
|
75 (charset-list))
|
|
|
76 ))
|
|
|
77
|
|
|
78 (defun describe-designation (flags graphic)
|
|
|
79 (let ((lc (aref flags graphic))
|
|
|
80 lc1)
|
|
|
81 (if (integerp lc) (setq lc1 (if (> lc 0) lc (- lc))))
|
|
|
82 (princ (format " G%d -- %s"
|
|
|
83 graphic
|
|
|
84 (or (and lc1 (char-description lc1))
|
|
|
85 (and (eq lc t) "never used")
|
|
|
86 "none")))
|
|
|
87 (princ (if (and lc1 (< lc 0))
|
|
|
88 " (explicit designation required)\n"
|
|
|
89 "\n"))))
|
|
|
90 ;; end of patch
|
|
|
91
|
|
|
92 ;;;###autoload
|
|
|
93 (defun describe-coding-system (cs)
|
|
|
94 "Display documentation of the coding-system CS."
|
|
|
95 (interactive "zCoding-system: ")
|
|
|
96 (get-coding-system cs);; correctness check
|
|
|
97 (with-output-to-temp-buffer "*Help*"
|
|
|
98 (princ "Coding-system ")
|
|
|
99 (princ cs)
|
|
|
100 (princ " [")
|
|
|
101 (princ (coding-system-mnemonic cs))
|
|
|
102 (princ "]: \n")
|
|
|
103 (if (not cs) nil
|
|
|
104 (princ " ")
|
|
|
105 (princ (coding-system-doc-string cs))
|
|
|
106 (princ "\nType: ")
|
|
|
107 (let ((type (coding-system-type cs)))
|
|
|
108 (princ type)
|
|
|
109 (cond ((eq type 'iso2022)
|
|
|
110 (princ "ISO-2022]\n")
|
|
|
111 (princ "Initial designations:\n")
|
|
|
112 (describe-designation coding-system 0)
|
|
|
113 (describe-designation coding-system 1)
|
|
|
114 (describe-designation coding-system 2)
|
|
|
115 (describe-designation coding-system 3)
|
|
|
116 (princ "Other Form: \n")
|
|
|
117 (princ (if (aref flags 4) "ShortForm" "LongForm"))
|
|
|
118 (if (aref flags 5) (princ ", ASCII@EOL"))
|
|
|
119 (if (aref flags 6) (princ ", ASCII@CNTL"))
|
|
|
120 (princ (if (aref flags 7) ", 7bit" ", 8bit"))
|
|
|
121 (if (aref flags 8) (princ ", UseLockingShift"))
|
|
|
122 (if (aref flags 9) (princ ", UseRoman"))
|
|
|
123 (if (aref flags 10) (princ ", UseOldJIS"))
|
|
|
124 (if (aref flags 11) (princ ", No ISO6429"))
|
|
|
125 (princ ".\n"))
|
|
|
126 ((eq type 'big5)
|
|
|
127 (princ (if flags "Big-ETen\n" "Big-HKU\n")))
|
|
|
128 ))
|
|
|
129 (princ "\nEOL-Type: ")
|
|
|
130 (let ((eol-type (coding-system-eol-type cs)))
|
|
|
131 (cond ((null eol-type)
|
|
|
132 (princ "null (= LF)\n"))
|
|
|
133 ((vectorp eol-type)
|
|
|
134 (princ "Automatic selection from ")
|
|
|
135 (princ eol-type)
|
|
|
136 (princ "\n"))
|
|
|
137 ((eq eol-type 1) (princ "LF\n"))
|
|
|
138 ((eq eol-type 2) (princ "CRLF\n"))
|
|
|
139 ((eq eol-type 3) (princ "CR\n"))
|
|
|
140 (t (princ "invalid\n"))))
|
|
|
141 )))
|
|
|
142
|
|
|
143 ;;;###autoload
|
|
|
144 (defun list-coding-system-briefly ()
|
|
|
145 "Display coding-systems currently used with a brief format in mini-buffer."
|
|
|
146 (interactive)
|
|
|
147 (let ((cs (and (fboundp 'process-coding-system) (process-coding-system)))
|
|
|
148 eol-type)
|
|
|
149 (message
|
|
|
150 "current: [FKDPp=%c%c%c%c%c%c%c%c] default: [FPp=%c%c%c%c%c%c]"
|
|
|
151 (coding-system-mnemonic file-coding-system)
|
|
|
152 (coding-system-eol-mnemonic file-coding-system)
|
|
|
153 (coding-system-mnemonic keyboard-coding-system)
|
|
|
154 (coding-system-mnemonic terminal-coding-system)
|
|
|
155 (coding-system-mnemonic (car cs))
|
|
|
156 (coding-system-eol-mnemonic (car cs))
|
|
|
157 (coding-system-mnemonic (cdr cs))
|
|
|
158 (coding-system-eol-mnemonic (cdr cs))
|
|
|
159 (coding-system-mnemonic (default-value 'file-coding-system))
|
|
|
160 (coding-system-eol-mnemonic (default-value 'file-coding-system))
|
|
|
161 (coding-system-mnemonic (car default-process-coding-system))
|
|
|
162 (coding-system-eol-mnemonic (car default-process-coding-system))
|
|
|
163 (coding-system-mnemonic (cdr default-process-coding-system))
|
|
|
164 (coding-system-eol-mnemonic (cdr default-process-coding-system))
|
|
|
165 )))
|
|
|
166
|
|
|
167 (defun princ-coding-system (code)
|
|
|
168 (princ ": ")
|
|
|
169 (princ code)
|
|
|
170 (princ " [")
|
|
|
171 (princ (char-to-string (coding-system-mnemonic code)))
|
|
|
172 (princ (char-to-string (coding-system-eol-mnemonic code)))
|
|
|
173 (princ "]\n"))
|
|
|
174
|
|
|
175 (defun todigit (flags idx &optional default-value)
|
|
|
176 (if (aref flags idx)
|
|
|
177 (if (numberp (aref flags idx)) (aref flags idx) 1)
|
|
|
178 (or default-value 0)))
|
|
|
179
|
|
|
180 (defun print-coding-system-description (code)
|
|
|
181 (let ((type (get-code-type code))
|
|
|
182 (eol (or (get-code-eol code) 1))
|
|
|
183 (flags (get-code-flags code))
|
|
|
184 line)
|
|
|
185 (setq type
|
|
|
186 (cond ((null type) 0)
|
|
|
187 ((eq type t) 2)
|
|
|
188 ((eq type 0) 1)
|
|
|
189 ((eq type 1) 3)
|
|
|
190 ((eq type 2) 4)
|
|
|
191 ((eq type 3) 5)
|
|
|
192 ((eq type 4) 6)
|
|
|
193 (t nil)))
|
|
|
194 (if (or (null type)
|
|
|
195 (get code 'post-read-conversion)
|
|
|
196 (get (get-base-code code) 'post-read-conversion)
|
|
|
197 (get code 'pre-write-conversion)
|
|
|
198 (get (get-base-code code) 'pre-write-conversion)
|
|
|
199 (eq code '*noconv*))
|
|
|
200 nil
|
|
|
201 (princ
|
|
|
202 (format "%s:%d:%c:"
|
|
|
203 code type (coding-system-mnemonic code)))
|
|
|
204 (princ (format "%d" (if (numberp eol) eol 0)))
|
|
|
205 (cond ((= type 4)
|
|
|
206 (princ
|
|
|
207 (format
|
|
|
208 ":%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d"
|
|
|
209 (todigit flags 0 -1)
|
|
|
210 (todigit flags 1 -1)
|
|
|
211 (todigit flags 2 -1)
|
|
|
212 (todigit flags 3 -1)
|
|
|
213 (todigit flags 4)
|
|
|
214 (todigit flags 5)
|
|
|
215 (todigit flags 6)
|
|
|
216 (todigit flags 7)
|
|
|
217 (todigit flags 8)
|
|
|
218 (todigit flags 9)
|
|
|
219 (todigit flags 10)
|
|
|
220 (todigit flags 11))))
|
|
|
221 ((= type 5)
|
|
|
222 (princ ":0"))
|
|
|
223 ((= type 6)
|
|
|
224 (if (and (vectorp (car flags)) (vectorp (cdr flags)))
|
|
|
225 (let (i len)
|
|
|
226 (princ ":")
|
|
|
227 (setq i 0 len (length (car flags)))
|
|
|
228 (while (< i len)
|
|
|
229 (princ (format " %x" (aref (car flags) i)))
|
|
|
230 (setq i (1+ i)))
|
|
|
231 (princ ",")
|
|
|
232 (setq i 0 len (length (cdr flags)))
|
|
|
233 (while (< i len)
|
|
|
234 (princ (format " %x" (aref (cdr flags) i)))
|
|
|
235 (setq i (1+ i))))))
|
|
|
236 (t (princ ":0")))
|
|
|
237 (princ ":")
|
|
|
238 (princ (get-code-document code))
|
|
|
239 (princ "\n"))
|
|
|
240 ))
|
|
|
241
|
|
|
242 ;;;###autoload
|
|
|
243 (defun list-coding-system (&optional all)
|
|
|
244 "Describe coding-systems currently used with a detailed format.
|
|
|
245 If optional arg ALL is non-nil, all coding-systems are listed in
|
|
|
246 machine readable simple format."
|
|
|
247 (interactive "P")
|
|
|
248 (with-output-to-temp-buffer "*Help*"
|
|
|
249 (if (null all)
|
|
|
250 (let ((cs (and (fboundp 'process-coding-system)
|
|
|
251 (process-coding-system))))
|
|
|
252 (princ "Current:\n file-coding-system")
|
|
|
253 (princ-coding-system file-coding-system)
|
|
|
254 (princ " keyboard-coding-system")
|
|
|
255 (princ-coding-system keyboard-coding-system)
|
|
|
256 (princ " terminal-coding-system")
|
|
|
257 (princ-coding-system terminal-coding-system)
|
|
|
258 (when cs
|
|
|
259 (princ " process-coding-system (input)")
|
|
|
260 (princ-coding-system (car cs))
|
|
|
261 (princ " process-coding-system (output)")
|
|
|
262 (princ-coding-system (cdr cs)))
|
|
|
263 (princ "Default:\n file-coding-system")
|
|
|
264 (princ-coding-system (default-value 'file-coding-system))
|
|
|
265 (princ " process-coding-system (input)")
|
|
|
266 (princ-coding-system (car default-process-coding-system))
|
|
|
267 (princ " process-coding-system (output)")
|
|
|
268 (princ-coding-system (cdr default-process-coding-system))
|
|
|
269 (princ "Others:\n file-coding-system-for-read")
|
|
|
270 (princ-coding-system file-coding-system-for-read)
|
|
|
271 (princ "Coding categories by priority:\n")
|
|
|
272 (princ (coding-priority-list)))
|
|
|
273 (princ "########################\n")
|
|
|
274 (princ "## LIST OF CODING SYSTEM\n")
|
|
|
275 (princ "## NAME(str):TYPE(int):MNEMONIC(char):EOL(int):FLAGS:DOC(str)\n")
|
|
|
276 (princ "## TYPE = 0(no conversion),1(auto conversion),\n")
|
|
|
277 (princ "## 2(Mule internal),3(SJIS),4(ISO2022),5(BIG5),6(CCL)\n")
|
|
|
278 (princ "## EOL = 0(AUTO), 1(LF), 2(CRLF), 3(CR)\n")
|
|
|
279 (princ "## FLAGS =\n")
|
|
|
280 (princ "## if TYPE = 4 then\n")
|
|
|
281 (princ "## G0,G1,G2,G3,SHORT,ASCII-EOL,ASCII-CNTL,SEVEN,\n")
|
|
|
282 (princ "## LOCK-SHIFT,USE-ROMAN,USE-OLDJIS\n")
|
|
|
283 (princ "## else if TYPE = 6 then\n")
|
|
|
284 (princ "## CCL_PROGRAM_FOR_READ,CCL_PROGRAM_FOR_WRITE\n")
|
|
|
285 (princ "## else\n")
|
|
|
286 (princ "## 0\n")
|
|
|
287 (princ "##\n")
|
|
|
288 (let ((codings nil))
|
|
|
289 (mapatoms
|
|
|
290 (function
|
|
|
291 (lambda (arg)
|
|
|
292 (if (eq arg '*noconv*)
|
|
|
293 nil
|
|
|
294 (if (and (or (vectorp (get arg 'coding-system))
|
|
|
295 (vectorp (get arg 'eol-type)))
|
|
|
296 (null (get arg 'pre-write-conversion))
|
|
|
297 (null (get arg 'post-read-conversion)))
|
|
|
298 (setq codings (cons arg codings)))))))
|
|
|
299 (while codings
|
|
|
300 (print-coding-system-description (car codings))
|
|
|
301 (setq codings (cdr codings))))
|
|
|
302 (princ "############################\n")
|
|
|
303 (princ "## LIST OF CODING CATEGORIES (ordered by priority)\n")
|
|
|
304 (princ "## CATEGORY(str):CODING-SYSTEM(str)\n")
|
|
|
305 (princ "##\n")
|
|
|
306 (princ (coding-priority-list))
|
|
|
307 )))
|
|
|
308
|
|
|
309 ;;; FONT
|
|
|
310 (defun describe-font-internal (fontinfo &optional verbose)
|
|
|
311 (let ((cs (character-set (aref fontinfo 3))))
|
|
|
312 (mule-debug-princ-list (format "Font #%02d for" (aref fontinfo 0))
|
|
|
313 (nth 6 cs) (nth 7 cs) "--"
|
|
|
314 (cond ((= (aref fontinfo 4) 0) "NOT YET OPENED")
|
|
|
315 ((= (aref fontinfo 4) 1) "OPENED")
|
|
|
316 (t "NOT FOUND")))
|
|
|
317 (mule-debug-princ-list " request:" (aref fontinfo 1))
|
|
|
318 (if (= (aref fontinfo 4) 1)
|
|
|
319 (mule-debug-princ-list " opened:" (aref fontinfo 2)))
|
|
|
320 (if (and verbose (= (aref fontinfo 4) 1))
|
|
|
321 (progn
|
|
|
322 (mule-debug-princ-list " size:" (format "%d" (aref fontinfo 5)))
|
|
|
323 (mule-debug-princ-list " encoding:" (if (= (aref fontinfo 6) 0) "low" "high"))
|
|
|
324 (mule-debug-princ-list " yoffset:" (format "%d" (aref fontinfo 7)))
|
|
|
325 (mule-debug-princ-list " rel-cmp:" (format "%d" (aref fontinfo 8)))))
|
|
|
326 ))
|
|
|
327
|
|
|
328 ;;;###autoload
|
|
|
329 (defun describe-font (fontname)
|
|
|
330 "Display information about fonts which partially match FONTNAME."
|
|
|
331 (interactive "sFontname: ")
|
|
|
332 (setq fontname (regexp-quote fontname))
|
|
|
333 (with-output-to-temp-buffer "*Help*"
|
|
|
334 (let ((fontlist (font-list)) fontinfo)
|
|
|
335 (while fontlist
|
|
|
336 (setq fontinfo (car fontlist))
|
|
|
337 (if (or (string-match fontname (aref fontinfo 1))
|
|
|
338 (and (aref fontinfo 2)
|
|
|
339 (string-match fontname (aref fontinfo 2))))
|
|
|
340 (describe-font-internal fontinfo 'verbose))
|
|
|
341 (setq fontlist (cdr fontlist))))))
|
|
|
342
|
|
|
343 ;;;###autoload
|
|
|
344 (defun list-font ()
|
|
|
345 "Display a list of fonts."
|
|
|
346 (interactive)
|
|
|
347 (with-output-to-temp-buffer "*Help*"
|
|
|
348 (let ((fontlist (font-list)))
|
|
|
349 (while fontlist
|
|
|
350 (describe-font-internal (car fontlist))
|
|
|
351 (setq fontlist (cdr fontlist))))))
|
|
|
352
|
|
|
353 ;;; FONTSET
|
|
|
354 (defun describe-fontset-internal (fontset-info)
|
|
|
355 (mule-debug-princ-list "### Fontset-name:" (car fontset-info) "###")
|
|
|
356 (let ((i 0) font)
|
|
|
357 (while (< i 128)
|
|
|
358 (if (>= (setq font (aref (cdr fontset-info) i)) 0)
|
|
|
359 (describe-font-internal (get-font-info font)))
|
|
|
360 (setq i (1+ i)))))
|
|
|
361
|
|
|
362 ;;;###autoload
|
|
|
363 (defun describe-fontset (fontset)
|
|
|
364 "Display information about FONTSET."
|
|
|
365 (interactive
|
|
|
366 (let ((fontset-list (mapcar '(lambda (x) (list x)) (fontset-list))))
|
|
|
367 (list (completing-read "Fontset: " fontset-list nil 'match))))
|
|
|
368 (let ((fontset-info (get-fontset-info fontset)))
|
|
|
369 (if fontset-info
|
|
|
370 (with-output-to-temp-buffer "*Help*"
|
|
|
371 (describe-fontset-internal fontset-info))
|
|
|
372 (error "No such fontset: %s" fontset))))
|
|
|
373
|
|
|
374 ;;;###autoload
|
|
|
375 (defun list-fontset ()
|
|
|
376 "Display a list of fontsets."
|
|
|
377 (interactive)
|
|
|
378 (with-output-to-temp-buffer "*Help*"
|
|
|
379 (let ((fontsetlist (fontset-list 'all)))
|
|
|
380 (while fontsetlist
|
|
|
381 (describe-fontset-internal (car fontsetlist))
|
|
|
382 (setq fontsetlist (cdr fontsetlist))))))
|
|
|
383
|
|
|
384 ;;; DIAGNOSIS
|
|
|
385
|
|
|
386 (defun insert-list (args)
|
|
|
387 (while (cdr args)
|
|
|
388 (insert (or (car args) "nil") " ")
|
|
|
389 (setq args (cdr args)))
|
|
|
390 (if args (insert (or (car args) "nil")))
|
|
|
391 (insert "\n"))
|
|
|
392
|
|
|
393 (defun insert-section (sec title)
|
|
|
394 (insert "########################################\n"
|
|
|
395 "# Section " (format "%d" sec) ". " title "\n"
|
|
|
396 "########################################\n\n"))
|
|
|
397
|
|
|
398 ;;;###autoload
|
|
|
399 (defun mule-diag ()
|
|
|
400 "Show diagnosis of the current running Mule."
|
|
|
401 (interactive)
|
|
|
402 (let ((buf (get-buffer-create "*Diagnosis*")))
|
|
|
403 (save-excursion
|
|
|
404 (set-buffer buf)
|
|
|
405 (erase-buffer)
|
|
|
406 (insert "\t##############################\n"
|
|
|
407 "\t### DIAGNOSIS OF YOUR MULE ###\n"
|
|
|
408 "\t##############################\n\n"
|
|
|
409 "CONTENTS: Section 0. General information\n"
|
|
|
410 " Section 1. Display\n"
|
|
|
411 " Section 2. Input methods\n"
|
|
|
412 " Section 3. Coding-systems\n"
|
|
|
413 " Section 4. Character sets\n")
|
|
|
414 (if window-system
|
|
|
415 (insert " Section 5. Fontset list\n"))
|
|
|
416 (insert "\n")
|
|
|
417
|
|
|
418 (insert-section 0 "General information")
|
|
|
419 (insert "Mule's version: " mule-version " of " mule-version-date "\n")
|
|
|
420 (if window-system
|
|
|
421 (insert "Window-system: "
|
|
|
422 (symbol-name window-system)
|
|
|
423 (format "%s" window-system-version))
|
|
|
424 (insert "Terminal: " (getenv "TERM")))
|
|
|
425 (insert "\n\n")
|
|
|
426
|
|
|
427 (insert-section 1 "Display")
|
|
|
428 (if (eq window-system 'x)
|
|
|
429 (let* ((alist (nth 1 (assq (selected-frame)
|
|
|
430 (current-frame-configuration))))
|
|
|
431 (fontset (cdr (assq 'font alist))))
|
|
|
432 (insert-list (cons "Defined fontsets:" (fontset-list)))
|
|
|
433 (insert "Current frame's fontset: " fontset "\n"
|
|
|
434 "See Section 5 for more detail.\n\n"))
|
|
|
435 (insert "Coding system for output to terminal: "
|
|
|
436 (symbol-name terminal-coding-system)
|
|
|
437 "\n\n"))
|
|
|
438 (insert-section 2 "Input methods")
|
|
|
439 (if (featurep 'egg)
|
|
|
440 (let (temp)
|
|
|
441 (insert "EGG (Version " egg-version ")\n")
|
|
|
442 (insert " jserver host list: ")
|
|
|
443 (insert-list (if (boundp 'jserver-list) jserver-list
|
|
|
444 (if (setq temp (getenv "JSERVER"))
|
|
|
445 (list temp))))
|
|
|
446 (insert " cserver host list: ")
|
|
|
447 (insert-list (if (boundp 'cserver-list) cserver-list
|
|
|
448 (if (setq temp (getenv "CSERVER"))
|
|
|
449 (list temp))))
|
|
|
450 (insert " loaded ITS mode:\n\t")
|
|
|
451 (insert-list (mapcar 'car its:*mode-alist*))
|
|
|
452 (insert " current server:" (symbol-name wnn-server-type) "\n"
|
|
|
453 " current ITS mode:"
|
|
|
454 (let ((mode its:*mode-alist*))
|
|
|
455 (while (not (eq (cdr (car mode)) its:*current-map*))
|
|
|
456 (setq mode (cdr mode)))
|
|
|
457 (car (car mode))))
|
|
|
458 (insert "\n")))
|
|
|
459 (insert "QUAIL (Version " quail-version ")\n")
|
|
|
460 (insert " Quail packages: (not-yet-loaded) [current]\n\t")
|
|
|
461 (let ((l quail-package-alist)
|
|
|
462 (current (or (car quail-current-package) "")))
|
|
|
463 (while l
|
|
|
464 (cond ((string= current (car (car l)))
|
|
|
465 (insert "[" (car (car l)) "]"))
|
|
|
466 ((nth 2 (car l))
|
|
|
467 (insert (car (car l))))
|
|
|
468 (t
|
|
|
469 (insert "(" (car (car l)) ")")))
|
|
|
470 (if (setq l (cdr l)) (insert " ") (insert "\n"))))
|
|
|
471 (if (featurep 'canna)
|
|
|
472 (insert "CANNA (Version " canna-rcs-version ")\n"
|
|
|
473 " server:" (or canna-server "Not specified") "\n"))
|
|
|
474 (if (featurep 'sj3-egg)
|
|
|
475 (insert "SJ3 (Version" sj3-egg-version ")\n"
|
|
|
476 " server:" (get-sj3-host-name) "\n"))
|
|
|
477 (insert "\n")
|
|
|
478
|
|
|
479 (insert-section 3 "Coding systems")
|
|
|
480 (save-excursion (list-coding-systems))
|
|
|
481 (insert-buffer "*Help*")
|
|
|
482 (goto-char (point-max))
|
|
|
483 (insert "\n")
|
|
|
484
|
|
|
485 (insert-section 4 "Character sets")
|
|
|
486 (save-excursion (list-charsets))
|
|
|
487 (insert-buffer "*Help*")
|
|
|
488 (goto-char (point-max))
|
|
|
489 (insert "\n")
|
|
|
490
|
|
|
491 (if window-system
|
|
|
492 (progn
|
|
|
493 (insert-section 5 "Fontset list")
|
|
|
494 (save-excursion (list-fontset))
|
|
|
495 (insert-buffer "*Help*")))
|
|
|
496
|
|
|
497 (set-buffer-modified-p nil)
|
|
|
498 )
|
|
|
499 (let ((win (display-buffer buf)))
|
|
|
500 (set-window-point win 1)
|
|
|
501 (set-window-start win 1))
|
|
|
502 ))
|
|
|
503
|
|
|
504 ;;; DUMP DATA FILE
|
|
|
505
|
|
|
506 ;;;###autoload
|
|
|
507 (defun dump-charsets ()
|
|
|
508 (list-charsets)
|
|
|
509 (set-buffer (get-buffer "*Help*"))
|
|
|
510 (let (make-backup-files)
|
|
|
511 (write-region (point-min) (point-max) "charsets.lst"))
|
|
|
512 (kill-emacs))
|
|
|
513
|
|
|
514 ;;;###autoload
|
|
|
515 (defun dump-coding-systems ()
|
|
|
516 (list-coding-systems 'all)
|
|
|
517 (set-buffer (get-buffer "*Help*"))
|
|
|
518 (let (make-backup-files)
|
|
|
519 (write-region (point-min) (point-max) "coding-systems.lst"))
|
|
|
520 (kill-emacs))
|
|
|
521
|
