View of /lisp/new12.l

Parent Directory

Revision Log

change to CVS wadalab font project

(setq new12 '(
ォ
チ
ヂ
ノ
ヲ
握
一むのじ
渥
旭
飴
台
絢
粟
案
女
意
心
易
亥
亥の下
域
ほこ
育
郁
有
溢
皿
逸
しんにゅう
稲
允
員
因
引
弓
蔭
云
陰
隠
右
宇
うかんむり
迂
窺
碓
いしへん
渦
咼
嘘
くちへん
唄
欝
欝の下
蔚
尉
姥
老
厩
閏
噂
云
運
雲
荏
にんべん
叡
叡の左
営
呂
曳
瑛
央
穎
益
駅
尺
越
閲
奄
宴
延
怨
援
一友
沿
八口
炎
燕
薗
鉛
八口
鴛
夕ふしづくり
塩
塩の右
於
ひとかしらてんてん
凹
奥
旺
横
黄
欧
区
殴
鴬
鴎
黄
岡
荻
億
屋
憶
臆
桶
たて用
牡
うしへん
乙
俺
恩
温
穏
音
日
下
化
仮
反
何
伽
加
価
加
可
嘉
家
寡
科
歌
河
火
珂
箇
固
花
苛
茄
荷
菓
貨
迦
峨
我
画
芽
牙もどき
蛾
賀
雅
牙もどき
餓
駕
介
会
解
回
塊
廻
快
怪
灰
界
芥
蟹
咳
害
崖
圭
涯
碍
蓋
街
鎧
豈
垣
亘
柿
市
鈎
勾
劃
嚇
拡
広
撹
確
革
額
顎
掛
樫
土
梶
しかばねかんむり
潟
潟の右
喝
匂
渇
葛
褐
轄
鰹
叶
椛
花
鎌
兼
噛
鴨
鳥
栢
百
茅
萱
宣
))

(mapcar new12 #'(lambda (x) (putprop x 'black 'changed)))
(defun kanjisym (sym)
  (= (logand 128 (sref sym 0)) 128))
(defun checkblack (val)
  (cond ((symbolp val)
	 (cond ((get val 'changed))
	       ((not (and (kanjisym val)(boundp val))) 'white)
	       (t (putprop sym (checkblack (eval val)) 'chnaged))))
	(t
	 (cond ((stringp val) 'whilte)
	       ((not (consp val)) 'white)
	       ((or (stringp (car val))(consp (car val)))'white)
	       (t 
		(do ((l (cdr val)(cdr l)))
		  ((atom l)'white)
		  (and (eq 'black (checkblack (car l)))
		       (exit 'black))))))))

(defun checkgray (from to)
  (do ((j from (1+ j))(ret))
    ((> j to)(nreverse ret))
    (do ((i #x21 (1+ i))(str (make-string 2)(make-string 2))(sym))
      ((> i #x7e))
      (sset str 0 (logor #x80 j))
      (sset str 1 (logor #x80 i))
      (setq sym (intern (symbol str)))
      (and (equal (checkblack sym) 'black)(push sym ret)))))