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

Parent Directory

Revision Log

Initial revision

(defun kanjisym ((oblist (oblist)))
  (do ((l oblist (cdr l))(ret))
    ((atom l)ret)
    (and (plusp (logand 128 (sref (car l) 0)))
	 (push (car l) ret))))
(defun sortkanji (l)
  (sort l 'string-lessp))
(defun print-joint ()
  (do ((l (sortkanji (kanjisym (oblist))) (cdr l))(sym)(val))
    ((atom l))
    (setq sym (car l) val nil)
    (cond ((and (boundp sym)
		(consp (setq val (eval sym)))
		(symbolp (car val)))
	   (cond ((memq (car val) '(yoko tate kamae kamae2 nyou tare))
		  (prind `(setq ,sym ',val)))
		 (t 		  
		  (or (memq (car val) '(kana-joint smallkana))
		      (format ";error/n"))
		  (format ";/c/n" sym))))
	  ((and val (symbolp val))
	   (format "(setq /c '/c)/n" sym val))
	  (t (format ";/c/n" sym)))))
(defun out-to-file (filename func)
  (lets ((standard-output (outopen (stream filename))))
    (eval func)))