Revision: 1.1.1.1 - (view) (download)
1 : | ktanaka | 1.1 | (defun kanjisym ((oblist (oblist))) |
2 : | (do ((l oblist (cdr l))(ret)) | ||
3 : | ((atom l)ret) | ||
4 : | (and (plusp (logand 128 (sref (car l) 0))) | ||
5 : | (push (car l) ret)))) | ||
6 : | (defun sortkanji (l) | ||
7 : | (sort l 'string-lessp)) | ||
8 : | (defun print-joint () | ||
9 : | (do ((l (sortkanji (kanjisym (oblist))) (cdr l))(sym)(val)) | ||
10 : | ((atom l)) | ||
11 : | (setq sym (car l) val nil) | ||
12 : | (cond ((and (boundp sym) | ||
13 : | (consp (setq val (eval sym))) | ||
14 : | (symbolp (car val))) | ||
15 : | (cond ((memq (car val) '(yoko tate kamae kamae2 nyou tare)) | ||
16 : | (prind `(setq ,sym ',val))) | ||
17 : | (t | ||
18 : | (or (memq (car val) '(kana-joint smallkana)) | ||
19 : | (format ";error/n")) | ||
20 : | (format ";/c/n" sym)))) | ||
21 : | ((and val (symbolp val)) | ||
22 : | (format "(setq /c '/c)/n" sym val)) | ||
23 : | (t (format ";/c/n" sym))))) | ||
24 : | (defun out-to-file (filename func) | ||
25 : | (lets ((standard-output (outopen (stream filename)))) | ||
26 : | (eval func))) |
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |