Revision: 1.1 - (view) (download)
1 : | ktanaka | 1.1 | ;;-------------;; |
2 : | ;; nocompile.l ;; | ||
3 : | ;;-------------;; | ||
4 : | |||
5 : | (defmacro push-name-def (name-loc def . body) | ||
6 : | (append `(let ((,(eval name-loc) ,def))) | ||
7 : | body)) | ||
8 : | |||
9 : | (defun show-temporary-nikuduked-skeletons (win) | ||
10 : | (clear-win win) | ||
11 : | (when (boundp edittee-name) | ||
12 : | (lets ((assq-list (assq edittee-name primitive-reference-table)) | ||
13 : | (shown (if (null assq-list) | ||
14 : | nil | ||
15 : | (cdr assq-list))) | ||
16 : | (count 0)) | ||
17 : | (push-name-def edittee-name niti | ||
18 : | (clear-win! win) | ||
19 : | (catch 'continue | ||
20 : | (do ((x 0 (+ x 50))) | ||
21 : | ((>= x 400)) | ||
22 : | (do ((y 0 (+ y 50))) | ||
23 : | ((>= y 400)) | ||
24 : | (if (endp shown) (throw 'continue)) | ||
25 : | (when (> count 2) | ||
26 : | (if (not (ask-y-n skeleditor "³¤±¤Þ¤¹")) | ||
27 : | (throw 'continue)) | ||
28 : | (setq count 0)) | ||
29 : | (when (not (endp shown)) | ||
30 : | (draw-temporary-nikuduked-skeleton-win | ||
31 : | win | ||
32 : | (applykanji (car shown)) | ||
33 : | 50 50 | ||
34 : | x y) | ||
35 : | (redisplay-win win) | ||
36 : | (setq shown (cdr shown))) | ||
37 : | (setq count (1+ count))))))))) | ||
38 : |
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |