[wadalabfont-kit] / lisp / test / sort-joint.l

Annotation of /lisp/test/sort-joint.l

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)))