(defun kanjisym ((oblist (oblist))) (do ((l oblist (cdr l))(ret)) ((atom l)ret) (cond ((or (plusp (logand 128 (sref (car l) 0))) (and (= (string-length (car l)) 7) (string-equal "1-" (substring (car l) 0 2)))) (push (car l) ret))))) (defun sortkanji (l) (sort l 'string-lessp)) (setq primvec (vector 100)) (defun make-primlist () (do ((l (sortkanji (kanjisym (oblist))) (cdr l))(sym)(val)(ret)) ((atom l)(setq kanjiprim ret)) (setq sym (car l)) (cond ((and (boundp sym) (or (stringp (setq val (eval sym))) (and (consp val) (or (stringp (car val)) (consp (car val)))))) (setq aprim (applykanji sym)) (setq ellen (length (cadr aprim))) (vset primvec ellen `(,sym .,(vref primvec ellen))))))) (make-primlist) (setq ellist '(tate yoko hidari tasuki migi tatehidari tatehane tsukurihane kokoro sanzui migiue ten kozato magaritate kagi shin-nyuu)) (defun elgt (x y) (> (length (member x ellist))(length (member y ellist)))) (defun searchprim (elements) (lets ((ellen (length elements)) (el1 (sort elements #'elgt))) (do ((l (vref primvec ellen) (cdr l))(ret)(aprim)) ((atom l)(nreverse ret)) (setq aprim (applykanji (car l))) (setq el2 (sort (mapcar (cadr aprim) #'(lambda (x)(car x))) #'elgt)) (and (equal el1 el2) (push (car l) ret))))) (defun jointkanji () (do ((l (kanjisym (oblist)) (cdr l))(ret)) ((atom l)ret) (and (get (car l) 'mincho-patch)(push (car l) ret))))