;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: text-case-display.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: June 25, 2002 07:24:22
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Wednesday, March 17, 2004 at 17:14:01 by usher
;;;; ---------------------------------------------------------------------------

(in-package :textual-case-display)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Window Class Definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;
;;;(defclass text-case-display (case-display-dialog)
;;;  ()
;;;  (:documentation "A case display dialog that operates on a textual representation
;;;     of the case"))
;;;
;;;
;;;
;;;(defclass text-display-ndl (numbered-datum-list)
;;;  ())
;;;
;;;(defclass text-display-individuals (text-display-ndl)
;;;  ())
;;;
;;;(defclass text-display-expressions (text-display-ndl)
;;;  ())


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Window Refresh Events
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod get-background-color ((ndl text-display-ndl) row)
  (let ((casename (fire-case-viewer::case-name (cg:parent ndl)))
        (reasoner (fire-case-viewer::reasoner (cg:parent ndl))))
    (cond ((fire::case-fact-deleted? (fact row) :case-name casename
                                     :reasoner reasoner)
           cg:dark-red)
          ((fire::case-fact-selected? (fact row) :case-name casename 
                                      :reasoner reasoner)
           cg:blue)
          (t
           cg:white))))




(defmethod get-foreground-color ((ndl text-display-ndl) row)
  (let ((casename (fire-case-viewer::case-name (cg:parent ndl)))
        (reasoner (fire-case-viewer::reasoner (cg:parent ndl))))
    (cond ((and (fire::case-fact-deleted? (fact row) :case-name casename 
                                          :reasoner reasoner)
                (fire::case-fact-selected? (fact row) :case-name casename 
                                      :reasoner reasoner))
           cg:cyan)
          ((fire::case-fact-selected? (fact row) :case-name casename 
                                      :reasoner reasoner)
           cg:white)
          (t
           cg:black))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Individual Button Trigger Events
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun entity-control-buttons (entity-control-buttons-group new-value old-value)
  (declare (ignore old-value))
  (let* ((text-display (cg:parent entity-control-buttons-group)))
    (if (fire-case-viewer::case-name text-display)
      (case (first new-value)
        (:add-edit-case-entity (add-edit-case-individual text-display))
        (:delete-case-entity (delete-case-individual text-display))
        (:undelete-case-entity (undelete-case-individual text-display))
        (:purge-deleted-case-entities (purge-deleted-case-individuals text-display)))
      (cg:pop-up-message-dialog text-display "No Case Name" "Please specify a case name" nil "Ok")))
  nil)




(defun apply-individual-modifications (text-display new-individuals modified-individuals edited-individuals
                                                    deleted-individuals)
  (delete-individuals deleted-individuals text-display)
  (edit-individuals-spelling edited-individuals text-display)
  (modify-individual-types modified-individuals text-display)
  (add-new-individuals new-individuals text-display)
  )


(defmethod add-edit-case-individual ((text-display text-case-display))
  (let ((indv-mods (create-individual-editor-popup text-display)))
    (apply-individual-modifications text-display
                                    (first indv-mods)
                                    (second indv-mods)
                                    (third indv-mods)
                                    (fourth indv-mods))))
    
    


(defmethod delete-case-individual ((text-display text-case-display))
  (let ((indv-list (cg:find-component :case-pane-individuals text-display))
        (casename (fire-case-viewer::case-name text-display))
        (reasoner (fire-case-viewer::reasoner text-display))
        (expr-list (cg:find-component :case-pane-expressions text-display)))
    (multiple-value-bind (selected-indvs selected-cells)
        (get-selected-elements indv-list casename reasoner)
      (cond (selected-indvs
             (delete-individuals selected-indvs text-display)
             (invalidate-grid-rows selected-cells indv-list)
             (invalidate-grid-rows (get-selected-cells expr-list casename reasoner)
                                   expr-list))
            (t
             (cg:pop-up-message-dialog text-display "Nothing selected"
                                       "Please select something to delete" nil "Ok"))))))


(defmethod undelete-case-individual ((text-display text-case-display))
  (let ((indv-list (cg:find-component :case-pane-individuals text-display))
        (casename (fire-case-viewer::case-name text-display))
        (reasoner (fire-case-viewer::reasoner text-display))
        (expr-list (cg:find-component :case-pane-expressions text-display)))
    (multiple-value-bind (selected-indvs selected-cells)
        (get-selected-elements indv-list casename reasoner)
      (cond (selected-indvs
             (undelete-individuals selected-indvs text-display)
             (invalidate-grid-rows selected-cells indv-list)
             (invalidate-grid-rows (get-selected-cells expr-list casename reasoner)
                                   expr-list))
            (t
             (cg:pop-up-message-dialog text-display "Nothing deleted"
                                       "Nothing currently deleted to undelete" nil "Ok"))))))
                          
    
    
(defmethod purge-deleted-case-individuals ((text-display text-case-display))
  (let* ((casename (fire-case-viewer::case-name text-display))
         (reasoner (fire-case-viewer::reasoner text-display))
         (deleted-indvs (fire::case-individuals casename :reasoner reasoner 
                                                :filter 'fire::case-fact-deleted?))
         (indv-list (cg:find-component :case-pane-individuals text-display))
         (expr-list (cg:find-component :case-pane-expressions text-display)))
    (cond (deleted-indvs
           (let ((deleted-exprs (purge-individuals deleted-indvs text-display)))
             (delete-list-datum indv-list deleted-indvs)
             (delete-list-datum expr-list deleted-exprs)))
          (t
           (cg:pop-up-message-dialog text-display "Nothing deleted"
                                     "Nothing currently deleted to purge" nil "Ok")))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Expression Button Trigger Events
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun expression-control-buttons (expression-control-buttons-group new-value old-value)
  (declare (ignore old-value))
  (let* ((text-display (cg:parent expression-control-buttons-group)))
    (if (fire-case-viewer::case-name text-display)
      (case (first new-value)
        (:add-case-expression (add-case-expression text-display))
        (:edit-case-expression (edit-case-expression text-display))
        (:delete-case-expression (delete-case-expression text-display))
        (:undelete-case-expression (undelete-case-expression text-display))
        (:purge-deleted-case-expressions (purge-deleted-case-expressions text-display))
        (:pidginize-case-expression (pidginize-case-expressions text-display))
        (:filter-case-expressions (filter-case-expressions text-display)))
      (cg:pop-up-message-dialog text-display "No Case Name" "Please specify a case name" nil "Ok")))
  nil)


(defmethod add-case-expression ((text-display text-case-display))
  (let ((new-expression (create-expression-editor-popup :owner text-display)))
    (when new-expression
      (add-new-expressions (list new-expression) text-display))))


(defmethod edit-case-expression ((text-display text-case-display))
  (let* ((selected-expr (first (fire::case-expressions (fire-case-viewer::case-name text-display)
                                                       :reasoner (fire-case-viewer::reasoner text-display)
                                                       :filter 'fire::case-fact-selected?)))
         (new-expression (create-expression-editor-popup :expr selected-expr
                                                         :owner text-display)))
    (when new-expression
      (purge-expressions (list selected-expr) text-display)
      (delete-list-datum (cg:find-component :case-pane-expressions text-display)
                         (list selected-expr))
      (add-new-expressions (list new-expression) text-display))))

      

(defmethod delete-case-expression ((text-display text-case-display))
  (let ((expr-list (cg:find-component :case-pane-expressions text-display))
        (casename (fire-case-viewer::case-name text-display))
        (reasoner (fire-case-viewer::reasoner text-display)))
    (multiple-value-bind (selected-exprs selected-cells)
        (get-selected-elements expr-list casename reasoner)
      (cond (selected-exprs
             (delete-expressions selected-exprs text-display)
             (invalidate-grid-rows selected-cells expr-list))
            (t
             (cg:pop-up-message-dialog text-display "Nothing selected"
                                       "Please select something to delete" nil "Ok"))))))


(defmethod undelete-case-expression ((text-display text-case-display))
  (let ((expr-list (cg:find-component :case-pane-expressions text-display))
        (casename (fire-case-viewer::case-name text-display))
        (reasoner (fire-case-viewer::reasoner text-display)))
    (multiple-value-bind (selected-exprs selected-cells)
        (get-selected-elements expr-list casename reasoner)
      (cond (selected-exprs
             (undelete-expressions selected-exprs text-display)
             (invalidate-grid-rows selected-cells expr-list))
            (t
             (cg:pop-up-message-dialog text-display "Nothing deleted"
                                       "Nothing currently deleted to undelete" nil "Ok"))))))


(defmethod purge-deleted-case-expressions ((text-display text-case-display))
  (let* ((casename (fire-case-viewer::case-name text-display))
         (reasoner (fire-case-viewer::reasoner text-display))
         (deleted-exprs (fire::case-expressions casename :reasoner reasoner 
                                                :filter 'fire::case-fact-deleted?))
         (expr-list (cg:find-component :case-pane-expressions text-display)))
    (cond (deleted-exprs
           (purge-expressions deleted-exprs text-display)
           (delete-list-datum expr-list deleted-exprs))
          (t
           (cg:pop-up-message-dialog text-display "Nothing deleted"
                                     "Nothing currently deleted to purge" nil "Ok")))))


(defmethod get-printed-fact ((ndl text-display-expressions) (row ndl-row))
  (if (pidginize? ndl)
    (pidginized-fact row)
    (pprint-fact row)))

(defmethod pidginize-case-expressions ((text-display text-case-display))
  (let ((expr-list (cg:find-component :case-pane-expressions text-display)))
    (setf (pidginize? expr-list) (not (pidginize? expr-list)))
    (refresh-list expr-list)))

(defmethod filter-case-expressions ((text-display text-case-display))
  (format t "Filtering case expressions~%"))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Case Display Methods
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod current-text-display-individuals ((case-dialog text-case-display))
  (let ((indvs (cg:find-component :case-pane-individuals case-dialog)))
    (datum-list-facts indvs)))

(defmethod current-text-display-expressions ((case-dialog text-case-display))
  (let ((exprs (cg:find-component :case-pane-expressions case-dialog)))
    (datum-list-facts exprs)))

(defmethod add-text-display-individuals ((case-dialog text-case-display) (new-individual-list list))
  (let ((indvs (cg:find-component :case-pane-individuals case-dialog)))
    (add-list-datum indvs (remove-if-not 'filter-individuals new-individual-list))))

(defmethod add-text-display-expressions ((case-dialog text-case-display) (new-expressions-list list))
  (let ((exprs (cg:find-component :case-pane-expressions case-dialog)))
    (add-list-datum exprs (remove-if-not 'filter-individuals new-expressions-list))))


(defmethod remove-text-display-individuals ((case-dialog text-case-display) (indvs-to-delete list))
  (let ((indvs (cg:find-component :case-pane-individuals case-dialog)))
    (delete-list-datum indvs indvs-to-delete)))


(defmethod remove-text-display-expressions ((case-dialog text-case-display) (exprs-to-delete list))
  (let ((exprs (cg:find-component :case-pane-expressions case-dialog)))
    (delete-list-datum exprs exprs-to-delete)))


(defmethod fire-case-viewer::display-case (case-name (case-dialog text-case-display))
  (fire:with-reasoner (fire-case-viewer:reasoner case-dialog)
    (let ((indvs (cg:find-component :case-pane-individuals case-dialog))
          (exprs (cg:find-component :case-pane-expressions case-dialog)))
      (cond (case-name
             (setf (fire-case-viewer::case-name case-dialog) case-name)
             (multiple-value-bind (case-indvs case-exprs)
                 (fire::gather-case-entities-and-expressions case-name 
                   :reasoner (fire-case-viewer::reasoner case-dialog))
               (let ((case-indivs (remove-if-not 'filter-individuals case-indvs))
                     (case-expers (remove-if-not 'filter-expressions case-exprs)))    
                 (set-list-datum indvs case-indivs)
                 (set-list-datum exprs case-expers))))
            (t          
             (set-list-datum indvs nil)
             (set-list-datum exprs nil))))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Element Selection Events
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod get-selected-elements ((ndl numbered-datum-list) casename reasoner)
  (let ((cells (get-selected-cells ndl casename reasoner)))
    (values (mapcar 'fact cells)
            cells)))

(defmethod get-selected-cells ((ndl numbered-datum-list) casename reasoner)
  (let* ((row-section (cg:row-section ndl :ndl-rows)))
    (get-selected-cells row-section casename reasoner)))


(defmethod get-selected-cells ((row-section cg:grid-row-section) casename reasoner)
  (remove-if-not #'(lambda (single-row)
                     (fire::case-fact-selected? (fact single-row) :case-name casename :reasoner reasoner))
                 (cg:subsections row-section)))



(defmethod select-related-expressions ((case-dialog text-case-display) datum &key (deselect-others? t)
                                       (deselect-related? nil))
  "If deselecte-related? is TRUE - it deselects the related expressions rather than selecting them"
  (let* ((expression-ndl (cg:find-component :case-pane-expressions case-dialog))
         (row-section (cg:row-section expression-ndl :ndl-rows))
         (expressions-lst (cg:subsections row-section))
         (related-rows (remove-if-not #'(lambda (row)
                                          (mentions (fact row) datum))
                                      expressions-lst))
         (column (cg:subsection (cg:column-section expression-ndl :ndl-fact-column) :ndl-case-fact))
         (casename (fire-case-viewer::case-name case-dialog))
         (reasoner (fire-case-viewer::reasoner case-dialog))
         (currently-selected (get-selected-cells row-section casename reasoner)))
    
    ;; I can't pass deselect-others to select-fact here since we are going to be selecting
    ;;  a whole bunch (of related rows)... and if for each one we selected we deselected all others,
    ;;  we would thus unly have the last one selected.  Instead we deselect all others first (if needed)
    ;;  then select the rest after... (also note we can't use toggle since if two individuals are in the
    ;;  same expression and we select both individuals... if you used toggle it would deselect that expression
    ;;  since it would select it for the first invidual and deselect it on the second)
    (when deselect-others?
      (deselect-selected-facts casename reasoner :selection-list currently-selected
                               :deselect-all? nil))
    
    (if deselect-related?
      (deselect-selected-facts casename reasoner :selection-list related-rows
                               :deselect-all? nil)
      (dolist (row related-rows)
        (select-fact case-dialog (fact row) :deselect-others? nil)))
    
    ;; Invalidate all the ones that need to be invalidated for redrawing.
    ;; This includes any which need to be deselected, and the newly selected
    (when deselect-others?
      (dolist (selected-row currently-selected)
        (cg:invalidate-cell selected-row column)))
    
    (dolist (selected-row (if deselect-related?
                            related-rows 
                            (set-difference (get-selected-cells row-section casename reasoner)
                                            currently-selected)))
      (cg:invalidate-cell selected-row column))))

    
  

(defmethod cg:cell-click ((ndl text-display-individuals) buttons
                          column-section column-section-border-p column column-num 
                          column-border-p x row-section row-section-border-p row 
                          row-num row-border-p y &optional trigger-key)
  (declare (ignore trigger-key y row-border-p row-num row-section-border-p x
                   column-border-p column-num column-section-border-p column-section))
  (when row
    (let* ((datum (fact row))
           (ctrl-clicked? (eq buttons (+ cg:control-key cg:left-mouse-button)))
           (casename (fire-case-viewer::case-name (cg:parent ndl)))
           (reasoner (fire-case-viewer::reasoner (cg:parent ndl)))
           (currently-selected (append (get-selected-cells row-section casename reasoner)
                                       (get-selected-cells (cg:find-component :case-pane-expressions (cg:parent ndl))
                                                           casename
                                                           reasoner))))
      
      (let ((selected? (toggle-select-fact (cg:parent ndl) datum :selection-list currently-selected
                                           :deselect-others? (not ctrl-clicked?))))
        (when (not ctrl-clicked?)
          (dolist (selected-row currently-selected)
            (cg:invalidate-cell selected-row column)))
        (cg:invalidate-cell row column)
        (select-related-expressions (cg:parent ndl) datum 
                                    :deselect-others? (not ctrl-clicked?)
                                    :deselect-related? (not selected?))))))
        


(defmethod cg:cell-click ((ndl text-display-expressions) buttons
                          column-section column-section-border-p column column-num 
                          column-border-p x row-section row-section-border-p row 
                          row-num row-border-p y &optional trigger-key)
  (declare (ignore trigger-key y row-border-p row-num row-section-border-p x
                   column-border-p column-num column-section-border-p column-section))
  (when row
    (let* ((datum (fact row))
           (ctrl-clicked? (eq buttons (+ cg:control-key cg:left-mouse-button)))
           (casename (fire-case-viewer::case-name (cg:parent ndl)))
           (reasoner (fire-case-viewer::reasoner (cg:parent ndl)))
           (currently-selected (append (get-selected-cells row-section casename reasoner)
                                       (get-selected-cells (cg:find-component :case-pane-individuals (cg:parent ndl))
                                                           casename
                                                           reasoner))))
      
      (toggle-select-fact (cg:parent ndl) datum :selection-list currently-selected
                          :deselect-others? (not ctrl-clicked?))
      (when (not ctrl-clicked?)
        (dolist (selected-row currently-selected)
          (cg:invalidate-cell selected-row column)))
      (cg:invalidate-cell row column))))
      
      
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Textual Case Display Window Creation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun make-expression-control-buttons ()
  ;; add, edit, delete, undelete, purge-deleted, pidgin, filter

  (list :gap
        (make-instance 'cg:button-info
          :name :add-case-expression
          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
                                               :filename "plus" :filetype "bmp")          
          :title nil
          :width 14
          :height 14
          :stretching t
          :tooltip "Add New Case Expression (Ctrl-N)"
          :help-string "Add New Case Expression (Ctrl-N)")
        (make-instance 'cg:button-info
          :name :edit-case-expression
          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
                                               :filename "edit-pen" :filetype "bmp")          
          :title nil
          :width 14
          :height 14
          :stretching t
          :tooltip "Edit Case Expression (Ctrl-E)"
          :help-string "Edit Case Expression (Ctrl-E)")
        
        :gap
               
        (make-instance 'cg:button-info
          :name :delete-case-expression
          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
                                               :filename "minus" :filetype "bmp")          
          :title nil
          :width 14
          :height 14
          :stretching t
          :tooltip "Delete Selected Expressions (Ctrl-D)"
          :help-string "Delete Selected Expressions (Ctrl-D)")
        (make-instance 'cg:button-info
          :name :undelete-case-expression
          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
                                               :filename "undelete-arrow2" :filetype "bmp")          
          :title nil
          :width 14
          :height 14
          :stretching t
          :tooltip "Undelete Case Expression"
          :help-string "Undelete Case Expression")
        (make-instance 'cg:button-info
          :name :purge-deleted-case-expressions
          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
                                               :filename "trashcan" :filetype "bmp")          
          :title nil
          :width 14
          :height 14
          :stretching t
          :tooltip "Purge Deleted Case Expressions"
          :help-string "Purge Deleted Case Expressions")
        
        :gap 
        
        (make-instance 'cg:button-info
          :name :pidginize-case-expression
          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
                                               :filename "speech-bubble2" :filetype "bmp")          
          :title nil
          :width 14
          :height 14
          :stretching t
          :tooltip "View expressions in pidgin-english"
          :help-string "View expressions in pidgin-english")
        
;;; *** NOT YET FUNCTIONAL ***
;;;        (make-instance 'cg:button-info
;;;          :name :filter-case-expressions
;;;          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
;;;                                               :filename "filter" :filetype "bmp")          
;;;          :title nil
;;;          :width 14
;;;          :height 14
;;;          :stretching t
;;;          :tooltip "Display only selected expressions (Not Yet Available)"
;;;          :help-string "Display only selected expressions (Not Yet Available)")
        ))



(defun make-entity-control-buttons ()
  ;; add, edit, delete, undelete, purge-deleted

  (list :gap
        (make-instance 'cg:button-info
          :name :add-edit-case-entity
          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
                                               :filename "edit-pen" :filetype "bmp")          
          :title nil
          :width 14
          :height 14
          :stretching t
          :tooltip "Add/Edit Case Individual"
          :help-string "Add/Edit Case Individual")
        
        :gap
               
        (make-instance 'cg:button-info
          :name :delete-case-entity
          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
                                               :filename "minus" :filetype "bmp")          
          :title nil
          :width 14
          :height 14
          :stretching t
          :tooltip "Delete Selected Individuals"
          :help-string "Delete Selected Individuals")
        (make-instance 'cg:button-info
          :name :undelete-case-entity
          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
                                               :filename "undelete-arrow2" :filetype "bmp")          
          :title nil
          :width 14
          :height 14
          :stretching t
          :tooltip "Undelete Case Individual"
          :help-string "Undelete Case Individual")
        (make-instance 'cg:button-info
          :name :purge-deleted-case-entities
          :pixmap-source (get-text-case-display-path :subdirs '("Graphics" "Icons") 
                                               :filename "trashcan" :filetype "bmp")          
          :title nil
          :width 14
          :height 14
          :stretching t
          :tooltip "Purge Deleted Case Individuals"
          :help-string "Purge Deleted Case Individuals")
        
        ))



(defun make-text-display-components (width height)
  (let ((individuals-height (round (- (/ height 2) 42)))
        (expressions-height (round (- (/ height 2) 10))))
    (list (make-instance 'cg:multi-picture-button 
            :name :case-pane-entities-control-buttons
            :left 85
            :top 2
            :height 19
            :width (- width 10)
            :top-attachment :top
            :bottom-attachment :top
            :left-attachment :left
            :right-attachment :left
            :on-change 'entity-control-buttons
            :range (make-entity-control-buttons))
          
          (make-instance 'text-display-individuals
            :name :case-pane-individuals
            :background-color cg:white
            :font (cg:make-font nil "Courier New" 15)
            :left 5
            :top 25
            :height individuals-height
            :width (- width 10)
            :right-attachment :right
            :top-attachment :top
            :bottom-attachment :scale)          
          (make-instance 'cg:static-text
            :name :case-pane-individual-label
            :left 5
            :top 5
            :height 18
            :width 80
            :font (cg:make-font nil "Arial" 15 '(:bold))
            :value "Individuals"
            :top-attachment :top
            :bottom-attachment :top
            :left-attachment :left
            :right-attachment :left)
          
        
        
        (make-instance 'cg:multi-picture-button 
          :name :case-pane-expressions-control-buttons
          :left 85
          :top (+ 26 individuals-height)
          :height 19
          :width (- width 10)
          :top-attachment :scale
          :bottom-attachment :scale
          :left-attachment :left
          :right-attachment :left
          :on-change 'expression-control-buttons
          :range (make-expression-control-buttons))
        
        (make-instance 'cg:static-text
          :name :case-pane-expressions-label
          :left 5
          :top (+ 29 individuals-height)
          :height 18
          :width 80
          :font (cg:make-font nil "Arial" 15 '(:bold))
          :value "Expressions"
          :top-attachment :scale
          :bottom-attachment :scale
          :left-attachment :left
          :right-attachment :left)
        
        (make-instance 'text-display-expressions
          :name :case-pane-expressions
          :background-color cg:white
          :font (cg:make-font nil "Courier New" 15)
          :left 5
          :top (+ 47 individuals-height)
          :height expressions-height
          :width (- width 10)
          :right-attachment :right
          :top-attachment :scale
          :bottom-attachment :bottom)  
        
        )))




(defmethod initialize-instance :after ((case-dialog text-case-display) &key)
  (setf (cg:dialog-items case-dialog)
    (make-text-display-components (cg:interior-width case-dialog)
                                  (cg:interior-height case-dialog))))




(defun make-text-case-display (name &rest initargs &key  
                                     (owner (cg:screen cg:*system*))
                                     (class 'text-case-display)
                                     &allow-other-keys)
  (let* ((other-initargs (qrg:remove-keywords '(:dialog-items :owner :name :class) initargs))
         (new-win (apply #'cg:make-window (append (list name                              
                                                        :class class
                                                        :owner owner)
                                                  other-initargs))))
    new-win))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Testing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;





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