(in-package "COMMON-LISP-USER")

(defvar *sequence-selected* nil)
(defvar *selected* nil)

(defun KPML::GET-A-SUBSET-FROM (sequence defaults prompt)
  (setf *sequence-selected* nil)
  (make-subset-sequence-dialog 
   (if (consp sequence)
       sequence
     (list sequence))
   (if (consp defaults)
       defaults
     (list defaults))
   prompt)
  (loop until *sequence-selected* do (sleep 2))
  (setf *sequence-selected* nil)
  ;;; (cg:user-close-top-level-window *subset-sequence-dialog*)
  ;;; asks if we want to exist Lisp: why?? Doesn't in
  ;;; kpml-configure!
  *selected*)

;; Define the dialog :Subset-Sequence-Dialog

(defvar *subset-sequence-dialog* nil)
 
;; Create an instance of the window.
;; Use this if you need more than one instance.
(defun MAKE-SUBSET-SEQUENCE-DIALOG 
  (sequence defaults prompt
	    &key (parent *lisp-main-window*) 
	    (window-interior (make-box 74 81 664 358)) 
	    (name :subset-sequence-dialog) (title "Seeking subsequence"))
   (setq *loaded-but-uncreated-windows* 
      (delete 'subset-sequence-dialog *loaded-but-uncreated-windows*))
   (let (window-0 window-1 window-2 window-3 window-4
		  (not-selected (set-difference sequence defaults)))
     (setf *selected* defaults)
     (setq window-0 
	   (open-dialog 
            (list 
	     (make-dialog-item 
	      :widget 'single-item-list 
	      :name :single-item-list-1 
	      :title (delete #\Newline "Multi Item List 1") 
	      :value nil
	      :box (make-box 206 34 342 214) 
	      :tabstop t 
	      :groupstart t 
	      :set-value-fn #'(lambda (widg new old)
				(setf *selected* (remove new *selected*))
				(push new not-selected))
	      :key 'capitalize-object 
	      :range *selected*
	      :font (make-font-ex nil :arial 13 nil))
	     (make-dialog-item 
                  :widget 'static-text 
                  :name :static-text-6 
                  :title (delete #\Newline "Static Text 5") 
                  :value (delete #\Newline "Click to select") 
                  :box (make-box 364 14 500 32) 
                  :tabstop nil 
                  :groupstart t 
                  :font (make-font-ex nil :arial 13 '(:bold)) 
                  :tab-control nil)
               (make-dialog-item 
                  :widget 'single-item-list 
                  :name :single-item-list-2 
                  :title (delete #\Newline "Multi Item List 1") 
                  :value nil
                  :box (make-box 364 34 500 214) 
                  :tabstop t 
                  :groupstart t 
                  :key 'capitalize-object 
                  :range not-selected
		  :set-value-fn 
		  #'(lambda (widg new old)
		      (setf not-selected (remove new not-selected))
		      (push new *selected*))
                  :font (make-font-ex nil :arial 13 nil) 
                  :tab-control nil)
               (make-dialog-item 
                  :widget 'static-text 
                  :name :static-text-5 
                  :title (delete #\Newline "Static Text 5") 
                  :value (delete #\Newline "Click to remove") 
                  :box (make-box 206 14 342 32) 
                  :tabstop nil 
                  :groupstart t 
                  :font (make-font-ex nil :arial 13 '(:bold)))
               (make-dialog-item 
                  :widget 'static-text 
                  :name :static-text-4 
                  :title (delete #\Newline "Prompt") 
                  :value (delete #\Newline (string prompt))
                  :box (make-box 15 34 203 98) 
                  :tabstop nil 
                  :groupstart t 
                  :font (make-font-ex nil :arial 13 '(:bold)))
	       (make-dialog-item 
                  :widget 'button 
                  :name :button-1 
                  :title (delete #\Newline "Done") 
                  :box (make-box 312 218 388 240) 
                  :tabstop nil 
                  :groupstart nil 
                  :background-color 
                  (make-rgb :red 0 :green 255 :blue 64) 
                  :set-value-fn 'sequence-selected-fn 
                  :font (make-font-ex nil :arial 13 '(:bold))))
            '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 nil
            :user-closable t 
            :user-shrinkable t 
            :user-scrollable nil 
            :overlapped nil 
            :background-color light-gray 
            :pop-up-p nil 
            :window-interior window-interior))
     (setf (window-editable-p window-0) t)
     (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) t)
     (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)
     (setf *subset-sequence-dialog* window-0)))


(unless (windowp *subset-sequence-dialog*) 
   (pushnew 'subset-sequence-dialog *loaded-but-uncreated-windows*))


(defun sequence-selected-fn (widget new-value old-value)
  (setf *sequence-selected* T)
  (values t ;; Accept the new value
	  nil))  ;; Don't exit the dialog (if a pop-up)
