Annotation of /lisp/tools/nocompile.lAnnotation of /lisp/tools/nocompile.l
Parent Directory
| 
Revision Log
Revision: 1.3 - (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 : | ktanaka | 1.2 | (defun show-temporary-nikuduked-skeletons (win) |
| 10 : | ktanaka | 1.1 | (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 : | ktanaka | 1.2 | (draw-temporary-nikuduked-skeleton-win |
| 31 : | ktanaka | 1.1 | 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 |