Ltk:メニューを表示する - lisp-cookbook-ja/common-lisp GitHub Wiki

  • メニュー
;;; LTKのメニュー

(ql:quickload :ltk)


;; パッケージの作成
(defpackage :ex4-18
  (:use :common-lisp
        :ltk)
  (:export :main))

(in-package :ex4-18)

(defun main ()
  (with-ltk ()
    (wm-title *tk* "メニュー")
    (minsize *tk* 600 500)

    (let* (
           ;; メニューバー作成
           (mb (make-menubar))
           
           ;;メニュー"種類"
           (mshurui (make-menu mb "種類" ))

           (mf-command (make-menubutton mshurui "コマンド"
                                        (lambda () ;(error "asdf")
                                          (format t "コマンド pressed~&")
                                          (finish-output))
                                        :underline 1))


           (mf-checkbtn (make-instance 'menucheckbutton 
                                       :master mshurui
                                       :text"チェックボタン"))


           (sep1 (add-separator mshurui))

           (mf-radiobtn1 (make-instance 'menuradiobutton
                                        :master mshurui 
                                        :text "ラジオボタン①"
                                        :group "group1"))
                                        

           (mf-radiobtn2 (make-instance 'menuradiobutton
                                        :master mshurui
                                        :text "ラジオボタン②"
                                        :group "group1"))

           (mf-radiobtn3 (make-instance 'menuradiobutton
                                        :master mshurui
                                        :text "ラジオボタン③"
                                        :group "group1"))

           (sep2 (add-separator mshurui))

           (mf-export (make-menu mshurui "カスケード"))

           (mfe-jpg (make-menubutton mf-export "コマンド①" (lambda ()
                                                              (format t "cmd1 pressed~&")
                                                              (finish-output))))
           (mfe-gif (make-menubutton mf-export "コマンド②" (lambda ()
                                                              (format t "cmd2 pressed~&")
                                                              (finish-output))))

           (sep3 (add-separator mshurui))


           (mf-close (make-menubutton mshurui "終了"
                                        (lambda () ;(error "asdf")
                                          (format t "終了 pressed~&")
                                          (setf *exit-mainloop* t)
                                          (finish-output))
                                        :underline 1))

           (msg (make-instance 'message
                               :text "これはメニューのテストウィンドウです。"
                 :width 1000
                 :background "#FFFFFF"))

           (b1 (make-instance
                'button
                :text "Close"
                :command (lambda ()
                           (format t "終了")
                           (setf *exit-mainloop* t)))))

      (pack msg
            :side :top
            :fill :x) ; fillを指定すると、Wiindowのハシをドラッグして伸ばしてもボタンが大きくなる。
      (pack b1
            :side :bottom
            :fill :x) ; fillを指定すると、Wiindowのハシをドラッグして伸ばしてもボタンが大きくなる。

      ;; (configure msg
      ;;            :anchor :w
      ;;            )

      )))

(main)