(in-package :common-lisp-user)

;;; File: menu.lsp
;;; Define the dialog :kpml-menu-dialog
 
(defvar *kpml-menu-dialog* nil)
(defvar kpml::*menu-result* nil)
 
(defun kpml::choose-from-menu (message-string items)
  (make-kpml-menu-dialog message-string items)
  (loop until kpml::*menu-result* 
	for i from 0 to 10 
	do (sleep 1))
  kpml::*menu-result*)

;; Return the window, creating it the first time or when it's closed.
;; Use only this function if you need only one instance.
(defun kpml-menu-dialog (message-string items)
   (if (windowp *kpml-menu-dialog*) *kpml-menu-dialog* 
      (setq *kpml-menu-dialog* (make-kpml-menu-dialog message-string items))))
 
;; Create an instance of the window. (Which is normally the case for
;; a menu...
;; Use this if you need more than one instance.
(defun make-kpml-menu-dialog (message-string
			      items &key (parent *lisp-main-window*) 
                      (window-interior (make-box 326 114 583 313)) 
                      (name :kpml-menu-dialog) 
		      (title "KPML menu (click once and wait)"))
  (setq kpml::*menu-result* nil)
  (setq *loaded-but-uncreated-windows* 
	(delete 'kpml-menu-dialog *loaded-but-uncreated-windows*))
  (let (window-0 window-1 window-2 window-3 window-4)
      (setq window-0 
         (open-dialog 
            (list 
               (make-dialog-item 
                  :widget 'single-item-list 
                  :name :single-item-list-4 
                  :title (delete #\Newline "Single Item List 4") 
                  :value nil
                  :box (make-box 4 33 229 179) 
                  :tabstop t 
                  :groupstart t 
                  :key 'capitalize-object 
		  :set-value-fn 
		  #'(lambda (widg new old)
		      (setf kpml::*menu-result* new)
		      (values t nil))
                  :range items
                  :font (make-font-ex nil :arial 13 nil))
               (make-dialog-item 
                  :widget 'static-text 
                  :name :static-text-16 
                  :title (delete #\Newline "Static Text 16") 
                  :value message-string
                  :box (make-box 4 4 229 27) 
                  :tabstop nil 
                  :groupstart t 
                  :foreground-color red 
                  :font (make-font-ex :swiss :arial 11 '(:italic))))
            'dialog parent 
            :name name 
            :title title 
            :font (make-font :swiss :system 16 '(:bold)) 
            :window-state :shrunk 
            :window-border :frame 
            :left-attachment nil 
            :top-attachment nil 
            :right-attachment nil 
            :bottom-attachment nil 
            :user-movable t 
            :user-resizable t 
            :user-closable t 
            :user-shrinkable t 
            :user-scrollable nil 
            :overlapped nil 
            :background-color light-gray 
            :pop-up-p T
            :window-interior window-interior))
      (setf (window-editable-p window-0) nil)
      (setf (getf (stream-plist window-0) :path) "")
      (setf (getf (stream-plist window-0) :startup-state) nil)
      (setf (getf (stream-plist window-0) :top-level-p) nil)
      (setf (help-string window-0) (delete #\Newline nil))
      (setf (getf (stream-plist window-0) :package) nil)
      nil
      (let* ((box (getf *window-exteriors* (object-name window-0))))
         (when box (reshape-window-exterior window-0 box)))
      (show-window window-0 nil)
      window-0))
(unless (windowp *kpml-menu-dialog*) 
   (pushnew 'kpml-menu-dialog *loaded-but-uncreated-windows*))
