(defun move-win (win x y) (setf (drawable-x win) x) (setf (drawable-y win) y)) (defun create-menu-test (parent x y black white fnt cursor item-list (colnum 1)) (lets ((mw (create-win parent x y 10 10 black white fnt)) (wins (mapcar item-list #'(lambda (x) (create-menu-item-win mw (second x) 0 0 black white fnt cursor)))) (item-num (length item-list)) (item-height (apply #'max (mapcar wins #'drawable-height))) (item-width (apply #'max (mapcar wins #'drawable-width))) (linnum (// (1- (+ item-num colnum)) colnum)) (mw-height (+ (* linnum item-height) *menu-margin*)) (mw-width (* colnum (+ *menu-margin* item-width)))) (do ((item-wins wins) (y 0 (+ y item-height))) ((endp item-wins)) (do ((x 0 (+ x (+ item-width *menu-margin*))) (c 0 (1+ c))) ((or (>= c colnum) (endp item-wins))) (move-win (car item-wins) x y) (setq item-wins (cdr item-wins)))) (do ((items item-list (cdr items)) (windefs wins (cdr windefs))) ((or (endp items) (endp windefs))) (princ (caar items)) (princ " ") (set (caar items) (car windefs))) (terpri) (mapcar wins #'(lambda (x) (resize-win x item-width item-height))) (resize-win mw mw-width mw-height) mw)) (defun test () (setq test-win (create-menu-test skeleditor 0 0 black white kanji-font roupe-cursor '((test-1 "テト1") (test-2 "テスト2") (test-3 "テスト3") (test-4 "テスト4") (test-5 "テスト5")))) (map-subwindows test-win) (map-window test-win) (display-force-output (window-display test-win)))