;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: wm-case-deletion-popup.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: July 10, 2002 17:28:45
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Saturday, November 9, 2002 at 09:52:27 by nicholson
;;;; ---------------------------------------------------------------------------

(in-package :fire-case-viewer)


(defclass delete-wm-cases-popup-dialog (cg:dialog)
  ((calling-window :accessor calling-window :initform nil :initarg :calling-window)))


(defun wm-case-deletion-popup (&optional (owner (cg:screen cg:*system*)))
  (let ((delete-pop (cg:find-or-make-pop-up-window :delete-wm-cases-popup 'make-wm-case-deletion-popup owner)))
    (update-listed-cases-for-deletion delete-pop)
    (cg:pop-up-modal-dialog delete-pop)))


(defun make-wm-case-deletion-popup (&optional (owner (cg:screen cg:*system*)))
  (cg:make-window :delete-wm-cases-popup
    :owner owner
    :calling-window owner
    :background-color (cg:background-color owner)
    :class 'delete-wm-cases-popup-dialog
    :height 210
    :width 241
    :pop-up t
    :left (+ 25 (if (eq owner (cg:screen cg:*system*)) 0 (cg:left owner)))
    :top (+ 25 (if (eq owner (cg:screen cg:*system*)) 0 (cg:top owner)))
    :border :palette
    :title "Delete Working Cases"
    :dialog-items (make-delete-wm-cases-dialog-items)
    ))


(defun make-delete-wm-cases-dialog-items ()
  (list (make-instance 'cg:multi-item-list
          :name :wm-case-deletion-current-cases-list
          :font (cg:make-font-ex nil "Tahoma" 11 nil)
          :available t
          :left 7
          :top 7
          :height 150
          :width 220
          :right-attachment :right
          :bottom-attachment :bottom)
        
        
        (make-instance 'cg:button
          :name :wm-case-deletion-delete-button
          :font (cg:make-font-ex nil "Tahoma" 11 nil)
          :title "Delete"
          :left 82
          :top 165
          :height 18
          :width 70
          :on-change #'wm-case-deletion-delete
          :right-attachment :right
          :left-attachment :right
          :top-attachment :bottom
          :bottom-attachment :bottom)
        (make-instance 'cg:cancel-button
          :name :wm-case-deletion-cancel-button
          :font (cg:make-font-ex nil "Tahoma" 11 nil)
          :left 153
          :top 165
          :height 18
          :width 75
          :on-change #'wm-case-deletion-cancel
          :right-attachment :right
          :left-attachment :right
          :top-attachment :bottom
          :bottom-attachment :bottom)
        
        (make-instance 'cg:lisp-group-box
          :name :wm-case-deletion-group-box
          :font (cg:make-font-ex nil "Tahoma" 11 nil)
          :left 1
          :top 1
          :height 160
          :width 233
          :right-attachment :right
          :bottom-attachment :bottom)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; EVENT Handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun update-listed-cases-for-deletion (wm-case-deletion-dialog)
  (setf (cg:range (cg:find-component :wm-case-deletion-current-cases-list wm-case-deletion-dialog))
    (fire::list-currently-loaded-cases :reasoner (reasoner (calling-window wm-case-deletion-dialog)))))

(defun wm-case-deletion-cancel (cancel-button new old)
  (declare (ignore new old))
  (close (cg:parent cancel-button)))

(defmethod get-value-symbol ((value symbol))
  value)

(defmethod get-value-symbol ((value string))
  (cg:read-from-string-safely value))

(defun wm-case-deletion-delete (delete-button new old)
  (declare (ignore new old))
  (let* ((wm-case-deletion-dialog (cg:parent delete-button))
         (casenames (mapcar #'get-value-symbol 
                      (cg:value (cg:find-component :wm-case-deletion-current-cases-list wm-case-deletion-dialog)))))
    (cg:flag-modal-completion wm-case-deletion-dialog casenames)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End of Code