;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: case-library-management.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: May 10, 2003 17:06:47
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Wednesday, May 14, 2003 at 13:37:48 by nicholson
;;;; ---------------------------------------------------------------------------

(in-package :fire-case-viewer)

(defclass case-library-management-window (cg:dialog)
  ((library-cache :accessor library-cache :initform nil :initarg :library-cache)
   ))

(defclass manager-outline-case (cg:outline-item)
  ((parent :accessor parent :initform nil :initarg :parent
           :documentation "The parent of the outline item")
   (case-library :accessor case-library :initform nil :initarg :case-library
                 :documentation "The full NAT representing the case library used
                   in the reminding for this entry")
   (full-casename :accessor full-casename :initform nil :initarg :full-casename
                  :documentation "This is the wrapped casename (eg: (explicit-case-fn foo))")
   ))


(defclass manager-outline-library (cg:outline-item)
  ())


(defmethod outline-case? ((entry manager-outline-case)) t)
(defmethod outline-case? ((entry t)) nil)

(defmethod outline-case-library? ((entry manager-outline-library)) t)
(defmethod outline-case-library? ((entry t)) nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Casease Library Management Element Accessors 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun library-manager-current-cases (library-manager)
  (cg:find-component :case-library-management-casename-combo library-manager))

(defun library-manager-current-case (library-manager)
  (cg:value (library-manager-current-cases library-manager)))

(defun library-manager-library-outline (library-manager)
  (cg:find-component :case-library-management-library-outline library-manager))

(defun get-selected-outline-element (library-manager)
  (let ((outline (library-manager-library-outline library-manager)))
    (dolist (library (cg:range outline))
      (when (cg:selected library)
        (return-from get-selected-outline-element library)))))

(defun library-manager-current-library (library-manager)
  (let ((selected-elem (get-selected-outline-element library-manager)))
    (if (outline-case-library? selected-elem)
      selected-elem
      nil)))

(defun library-manager-new-library-name (library-manager)
  (cg:read-from-string-safely 
   (cg:value (cg:find-component :case-library-management-newcase-name-box library-manager))))


(defun get-selected-outline-case-element (library-manager)
  (let ((outline (library-manager-library-outline library-manager)))
    (dolist (library (cg:range outline))
      (dolist (casename (cg:range library))
        (when (cg:selected casename)
          (return-from get-selected-outline-case-element casename))))))

(defun library-manager-currently-selected-case (library-manager)
  (let ((selected-elem (get-selected-outline-case-element library-manager)))
    (if (outline-case? selected-elem)
      selected-elem
      nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Casease Library Management Events 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun ensure-library-tagged (library)
  (cond ((null library) nil)
        ((listp library) library)
        (t (fire::encase-explicit-caselibrary
            library))))

;; Create a new Case Library
(defun case-library-management-create-new-case-library (create-button new old)
  (declare (ignore new old))
  (let* ((library-manager (cg:parent create-button))
         (new-library-name (ensure-library-tagged 
                            (library-manager-new-library-name library-manager))))
    (when new-library-name
      ;; I instantly want to add this to the KB as well 
      (fire::store-case-library-in-KB new-library-name
                                      :reasoner (reasoner (cg:owner library-manager)))
      
      (unless (fire::case-library-in-WM? new-library-name :reasoner (reasoner (cg:owner library-manager)))
        (fire::create-case-library new-library-name :reasoner (reasoner (cg:owner library-manager))))
      
      (add-library-to-manager-cache library-manager new-library-name (cg:owner library-manager))
      (setf (cg:value (cg:find-component :case-library-management-newcase-name-box library-manager))
        ""))))
         

;; Add a case to an existing Library
(defun case-library-management-add-case-to-library (add-button new old)
  (declare (ignore new old))
  (let* ((library-manager (cg:parent add-button))
         (case-name (library-manager-current-case library-manager))
         (library-entry (library-manager-current-library library-manager)))
    (when (and library-entry case-name)
      (let ((library  (cg:value library-entry)))
        (unless (fire::case-library-member? case-name library)
          ;; Note- there might be an issue with storing a case element-of statement to the KB
          ;;  instantly - what happens if the case itself is never stored in the KB?
          ;;  Should I only store this fact if the case is added to the KB?
          ;;  If the case is ever deleted this fact should also go away - and if the case is
          ;;  saved it should get added at the same time. (so something to look for this type 
          ;;  of fact when I save and when I delete cases from the KB)
          (fire::store-case-library-case-in-KB case-name library
                                               :reasoner (reasoner (cg:owner library-manager)))
          
          (unless (fire::case-library-case-in-WM?  library case-name :reasoner (reasoner (cg:owner library-manager)))
            (fire::add-case-library-case  case-name library 
                                         :reasoner (reasoner (cg:owner library-manager))))

          (add-case-to-manager-cache case-name library library-manager (cg:owner library-manager))
          (setf (cg:state library-entry) :open))))))

;; Remove a particular case library 
(defun case-library-management-remove-library (delete-library-button new old)
  (declare (ignore new old))
  (let* ((library-manager (cg:parent delete-library-button))
         (library-entry (library-manager-current-library library-manager)))
    (when library-entry
      (let ((library (cg:value library-entry))
            (reasoner (reasoner (cg:owner library-manager))))
        ;; Remove it from the KB
        (fire::delete-case-library-from-KB library :reasoner reasoner)
        ;; Remove it from the WM
        (fire::delete-case-library-from-WM library :reasoner reasoner)
        
        (remove-library-from-manager-cache library library-manager (cg:owner library-manager))
        (setf (cg:value (library-manager-library-outline library-manager)) nil)))))

        
        

;; Remove a case from a particular case library
(defun case-library-management-remove-case (remove-button new old)
  (declare (ignore new old))
  (let* ((library-manager (cg:parent remove-button))
         (case-name-element (library-manager-currently-selected-case library-manager)))
    (when case-name-element
      (let ((library (case-library case-name-element))
            (case-name (cg:value case-name-element))
            (reasoner (reasoner (cg:owner library-manager))))
        ;; Remove it from the KB
        (fire::delete-case-library-case-from-KB case-name library :reasoner reasoner)   
        ;; Remove it from the WM
        (fire::delete-case-library-case-from-WM case-name library :reasoner reasoner)
        
        (remove-case-from-manager-cache case-name library library-manager (cg:owner library-manager))
        (setf (cg:value (library-manager-library-outline library-manager)) nil)))))
    

(defun case-library-management-view-case (view-button new old)
  (declare (ignore new old))
  (let* ((library-manager (cg:parent view-button))
         (case-name-element (library-manager-currently-selected-case library-manager)))
    (when case-name-element
      (view-case (cg:value case-name-element) (cg:owner library-manager)))))


(defun case-library-management-close (close-button new old)
  (declare (ignore new old))
  (setf (cg:state (cg:parent close-button)) :shrunk))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Casease Library Management Ouline Creation Methods
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun set-entry-parents (manager-outline-entry)
  (dolist (entry (cg:range manager-outline-entry))
    (setf (parent entry) manager-outline-entry)
    (setf (case-library entry) (cg:value manager-outline-entry))))


(defun make-case-library-management-outline-case-entry (case-name)
  "case-info-list is a list of case names"
  (make-instance 'manager-outline-case
    :value case-name
    :kind nil
    :state :closed
    :range nil
    :available t))


(defun make-case-library-manager-caselibrary-outline-entry (case-library entry-list)
  "case-library is the name of the library. entry list is a list of case names in that library"
  (let ((entry (make-instance 'manager-outline-library
                 :value case-library
                 :kind nil
                 :state :closed 
                 :available t 
                 :selected t
                 :range (mapcar 'make-case-library-management-outline-case-entry entry-list))))
    (set-entry-parents entry)
    entry))


(defun set-case-library-management-library-outline (library-manager case-alist)
  "case-alist is an assoc list where the key is the case library and the value
    is a list of cases in that case library"
  (let ((outline (cg:find-component :case-library-management-library-outline library-manager)))
    (setf (cg:range outline)
      (mapcar #'(lambda (case-info)
                  (make-case-library-manager-caselibrary-outline-entry (first case-info)
                    (second case-info)))
        case-alist))
    outline))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Casease Library Management Initialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun initialize-current-cases (library-manager viewer)
  (let ((case-name-list (library-manager-current-cases library-manager))
        (loaded-cases (fire::list-currently-loaded-cases :reasoner (reasoner viewer))))
    (setf (cg:range case-name-list) loaded-cases)))



(defun initialize-case-library-outline (library-manager viewer)
  (cg:with-hourglass
    (let* ((libraries (fire::list-current-case-libraries :reasoner (reasoner viewer)))
           (cached-library (library-cache library-manager)))
      (if cached-library
        (set-case-library-management-library-outline library-manager cached-library)
        (let ((library-with-cases (fire::get-all-library-cases libraries :reasoner (reasoner viewer))))
          (set-case-library-management-library-outline library-manager library-with-cases)
          (setf (library-cache library-manager) library-with-cases))))))
    


(defun initialize-case-library-manager (library-manager)
  (let ((viewer (cg:owner library-manager)))
    (initialize-current-cases library-manager viewer)
    (initialize-case-library-outline library-manager viewer)))


(defun add-library-to-manager-cache (library-manager library-name viewer)
  (setf (library-cache library-manager)
    (append (library-cache library-manager)
            (list (list library-name
                        (cg:with-hourglass
                          (fire::get-library-cases library-name :reasoner (reasoner viewer)))))))
  (initialize-case-library-outline library-manager viewer))

(defun remove-library-from-manager-cache (library library-manager viewer)
  (setf (library-cache library-manager)
    (delete library (library-cache library-manager)
            :key 'first))
  (initialize-case-library-outline library-manager viewer))


(defun add-case-to-manager-cache (case-name library-name library-manager viewer)
  (let ((library-entry (assoc library-name (library-cache library-manager))))
    (setf (second (assoc library-name (library-cache library-manager)))
      (cons case-name (second library-entry))))
  (initialize-case-library-outline library-manager viewer))


(defun remove-case-from-manager-cache (case-name library-name library-manager viewer)
  (let ((library-entry (assoc library-name (library-cache library-manager))))
    (setf (second (assoc library-name (library-cache library-manager)))
      (delete case-name (second library-entry) :test 'equal)))
  (initialize-case-library-outline library-manager viewer))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Case Library Management Window 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; The finder-function, which returns the window if it already
;; exists, and otherwise creates and returns it.
;; Call this function if you need only one copy of this window,
;; and that window is a non-owned top-level window.
(defun case-library-manager (&key (owner (cg:screen cg:*system*)))
  (let ((manager (cg:find-or-make-application-window :case-library-manager
                                                     'make-case-library-manager
                                                     :owner owner)))
    (setf (cg:state manager) :normal)
    (initialize-case-library-manager manager)
    
    manager))
 
;; The maker-function, which always creates a new window.
;; Call this function if you need more than one copy,
;; or the single copy should have a parent or owner window.
;; (Pass :owner to this function; :parent is for compatibility.)
(defun make-case-library-manager
    (&key parent (owner (or parent (cg:screen cg:*system*)))
     (exterior (cg:make-box 100 100 770 506)) ;; 781 123 1451 529))
     (name :case-library-manager) (title "Case Library Management")
     (border :frame) (child-p nil) form-p)
  (let ((owner
         (cg:make-window name :owner owner
           :class 'case-library-management-window
           :exterior exterior
           :border border
           :child-p child-p
           :close-button t
           :cursor-name :arrow-cursor
           :font (cg:make-font-ex :swiss "MS Sans Serif / ANSI" 11 nil)
           :form-state :normal
           :maximize-button t
           :minimize-button t
           :name :case-library-management
           :pop-up nil
           :resizable t
           :scrollbars nil
           :state :normal
           :status-bar nil
           :system-menu t
           :title title
           :title-bar t
           :toolbar nil
           :dialog-items (make-case-library-management-widgets)
           :path #p"D:\\QRG\\FIRE\\V1\\case-manager\\case-viewer\\window-objects\\case-library-management.lsp"
           :help-string nil
           :form-p form-p
           :form-package-name nil)))
    owner))

(defun make-case-library-management-widgets ()
  (list ;;; Case Library New Case 
        (make-instance 'cg:multi-line-editable-text 
          :name :case-library-management-newcase-name-box
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil) 
          :template-string nil 
          :up-down-control nil 
          :value "" 
          :top 130
          :left 13 
          :width 311
          :height 60)
        (make-instance 'cg:button 
          :name :case-library-management-newcase-create-button
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Create"
          :on-change 'case-library-management-create-new-case-library
          :top 105 
          :left 252
          :height 22
          :width 73)
        (make-instance 'cg:static-text 
          :name :static-case-library-management-newcase-label
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil) 
          :value "Case Library Name"
          :top 106
          :left 12)
        (make-instance 'cg:group-box 
          :name :case-library-management-newcase-group 
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Create New Case Library" 
          :contained-widgets '(:case-library-management-newcase-name-box
                               :case-library-management-newcase-create-button
                               :static-case-library-management-newcase-label)
          :top 88
          :left 5 
          :height 110 
          :width 330)
        
        
        ;;; Case Library Add Case to Library
        (make-instance 'cg:combo-box
          :name :case-library-management-casename-combo
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil) 
          :range nil
          :value nil
          :top 44
          :left 17 
          :width 227)
        (make-instance 'cg:button 
          :name :case-library-management-add-case-button 
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Add" 
          :on-change 'case-library-management-add-case-to-library
          :top 44
          :left 252
          :height 22 
          :width 73)
        (make-instance 'cg:static-text
          :name :static-case-library-management-currentcase-label
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil) 
          :value "Current Case Name"
          :top 28 
          :left 14)
        (make-instance 'cg:group-box 
          :name :case-library-management-addcase-group 
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Add Case to Library" 
          :contained-widgets '(:case-library-management-casename-combo
                               :case-library-management-add-case-button
                               :static-case-library-management-currentcase-label)
          :top 7 
          :left 5 
          :height 69 
          :width 330)
        
        
        ;;; Case Library Outline
        (make-instance 'cg:outline 
          :name :case-library-management-library-outline
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :bottom-attachment :bottom
          :left 350 
          :top 23 
          :height 264
          :width 298
          
          :right-attachment :right 
          :tabs '(200 250 300 350 400) 

          :leaf-pixmap-name nil
          :leaf-pixmap-source nil 
          :closed-pixmap-name nil 
          :closed-pixmap-source nil 
          :opened-pixmap-name nil 
          :opened-pixmap-source nil
          
          :range nil
          :value nil)
;;;        (make-instance 'cg:radio-button
;;;          :name :case-library-management-view-by-library-button
;;;          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
;;;          :title "View by Library" 
;;;          :value t 
;;;          :bottom-attachment :bottom
;;;          :top-attachment :bottom 
;;;          :top 287
;;;          :left 358 
;;;          :width 93)
;;;        (make-instance 'cg:radio-button 
;;;          :name :case-library-management-view-by-case-button
;;;          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil) 
;;;          :title "View by Case" 
;;;          :bottom-attachment :bottom 
;;;          :top-attachment :bottom 
;;;          :top 287 
;;;          :left 471 
;;;          :width 86)
        (make-instance 'cg:button 
          :name :case-library-management-delete-library-button
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Delete Case Library" 
          :on-change 'case-library-management-remove-library
          :bottom-attachment :bottom
          :top-attachment :bottom 
          :top 311
          :left 350 
          :height 21
          :width 123)
        (make-instance 'cg:button
          :name :case-library-management-removecase-button 
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Remove Case" 
          :tooltip "Remove Case from the Case Library"
          :on-change 'case-library-management-remove-case
          :bottom-attachment :bottom
          :top-attachment :bottom
          :top 311 
          :left 483 
          :height 21)
        (make-instance 'cg:button
          :name :case-library-management-viewcase-button 
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "View Case" 
          :tooltip "View the Case"
          :on-change 'case-library-management-view-case
          :bottom-attachment :bottom
          :top-attachment :bottom
          :top 311 
          :left 569 
          :height 21)
        (make-instance 'cg:group-box 
          :name :case-library-management-library-group
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Current Case Libraries"
          :contained-widgets '(:case-library-management-library-outline 
                               :case-library-management-delete-library-button 
                               :case-library-management-view-by-library-button
                               :case-library-management-view-by-case-button 
                               :case-library-management-removecase-button)
          :bottom-attachment :bottom
          :right-attachment :right 
          :top 7 
          :left 341 
          :height 333 
          :width 315)
        
        
        ;;; Case Library Description
        (make-instance 'cg:multi-line-editable-text
          :name :case-library-management-library-description-box
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :template-string nil 
          :value "" 
          :up-down-control nil
          :read-only t 
          :top 222
          :left 13
          :height 110 
          :width 311)
        (make-instance 'cg:group-box 
          :name :case-library-management-library-description-group
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :contained-widgets '(:case-library-management-library-description-box)
          :title "Case Library Description" 
          :top 205
          :left 5 
          :height 135 
          :width 329)
        
        
        ;;; Control Buttons
        (make-instance 'cg:cancel-button
          :name :case-library-management-close-button
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Close"
          :on-change 'case-library-management-close
          :bottom-attachment :bottom 
          :left-attachment :right
          :right-attachment :right 
          :top-attachment :bottom 
          :top 350
          :left 574 
          :height 23 
          :width 72)))



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