;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: individual-editor-popup.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: July 18, 2002 16:16:56
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Thursday, August 29, 2002 at 13:59:25 by nicholson
;;;; ---------------------------------------------------------------------------

(in-package :textual-case-display)

;;; Todo
;;;  Make individuals in the current individual list show up in RED if they don't have
;;;   any type assignments
;;;
;;;  Ask the user if they really want to add a new individual (with the same name as one
;;;   they deleted) Right now it assumes that you really meant to delete the individual
;;;   thus all facts conserning that individual will be deleted
;;;
;;;  Make the new individual marker very complicated and have it's display value be 
;;;   simple - this is to allow people to actually make an individual with the same
;;;   label as what I term the marker
;;;


(defvar *new-individual-marker* (cg:read-from-string-safely "[New-Individual]" 'data))


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

(defclass individual-editor-popup (cg:dialog)
  ((calling-window :accessor calling-window :initform nil :initarg :calling-window)
   
   (owner-name :accessor owner-name :initform nil :initarg :owner-name
               :documentation "Since the text display window is a child, the owner of this popup
                 will be the viewer window (ACL constraint)... I need the text-display-dialog
                 and the only way to get it is from the name (in order to do the APPLY button effects)
                 But since the name isn't guaranteed to be what I think it is, I store it here
                 so I can grab it when needed... Note - this is depricated already... I use
                 the calling-window slot to get the same effect without having to do any search
                 for the window by the name")
   (new-indvs :accessor new-indvs :initform nil
              :documentation "An a-list of (indv type1 type2...) where typeN are the types 
                associated with indv.  These indvs are new - not having already been in the 
                current individuals.")
   (modified-indvs :accessor modified-indvs :initform nil 
                   :documentation "An A-list of (indv type1 type2 type3), where typeN are the
                        types associated with indv. These indvs are modified from the list of 
                        current individuals.")
   (edited-indvs :accessor edited-indvs :initform nil
                 :documentation "A list of those individuals who's spelling has been edited.
                   These are recorded seperately so that when we apply the changes we can go 
                   through all expressions using individual and change it appropriately")
   (deleted-indvs :accessor deleted-indvs :initform nil
                  :documentation "A list of individuals to be deleted")
   ))



(defclass current-individual-single-item-list (cg:single-item-list)
  ((user-click-selected :accessor user-click-selected :initform nil
                        :documentation "An indicator that the change was made via a user click rather
                          than a system call to the on-change handler")
   ))


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


(defun get-individual-current-types (indv indv-editor-popup)
  "Returns the current type assignments for indv either from the popup dialog (if indv is new or has
    been changed) or from the working memory"
  (if indv
    (cond ((assoc indv (new-indvs indv-editor-popup) :test 'equal)
           (second (assoc indv (new-indvs indv-editor-popup) :test 'equal)))
          ((assoc indv (modified-indvs indv-editor-popup) :test 'equal)
           (second (assoc indv (modified-indvs indv-editor-popup) :test 'equal)))
          (t
           (let ((text-dialog (calling-window indv-editor-popup))) 
             (get-type-assignments indv text-dialog))))
    nil))


(defun display-indv-assigned-types (indv indv-editor-popup)
  "Displays the currently assigned types for the indv in the :current-assigned-types-list in the popup"
  (let ((current-assigned-types-list (cg:find-component :current-assigned-types-list indv-editor-popup))
        (current-types (get-individual-current-types indv indv-editor-popup)))
    (setf (cg:range current-assigned-types-list) current-types)))


(defun get-current-individual (indv-editor-popup)
  (let ((val (cg:value (cg:find-component :new-individual-name indv-editor-popup))))
    (if (stringp val)
      (cg:read-from-string-safely val)
      val)))


(defun mark-change-made (indv-editor-popup)
  (setf (cg:available (cg:find-component :apply-changes-button indv-editor-popup)) t))

(defun mark-changes-finished (indv-editor-popup)
  (setf (cg:available (cg:find-component :apply-changes-button indv-editor-popup)) nil))
  


(defun select-current-indv (indv indv-editor-popup)
  (let ((cur-indv (if (eq indv *new-individual-marker*) nil indv)))
    (setf (cg:value (cg:find-component :new-individual-name indv-editor-popup)) (or cur-indv ""))
    (display-indv-assigned-types cur-indv indv-editor-popup)))


(defmethod add-new-individual (indv type-list (indv-editor-popup individual-editor-popup))
  (let ((current-indvs-list (cg:find-component :current-indvs-list indv-editor-popup)))
    (push (list indv type-list) (new-indvs indv-editor-popup))
    (setf (cg:range current-indvs-list)
      (cons (first (cg:range current-indvs-list))
            (cons indv
                  (rest (cg:range current-indvs-list)))))
    (setf (cg:value current-indvs-list) indv)
    (mark-change-made indv-editor-popup)))


(defmethod delete-individual (indv (indv-editor-popup individual-editor-popup))
  (unless (eq indv *new-individual-marker*)
    (let ((current-indvs-list (cg:find-component :current-indvs-list indv-editor-popup)))
      (unless (member indv (new-indvs indv-editor-popup) :key 'first)
        ;; don't need to record this indv as deleted if it was just created in this editing session
        (pushnew indv (deleted-indvs indv-editor-popup)))
      (setf (new-indvs indv-editor-popup) (remove indv (new-indvs indv-editor-popup) :key 'first))
      (setf (modified-indvs indv-editor-popup) (remove indv (modified-indvs indv-editor-popup) :key 'first))
      (setf (edited-indvs indv-editor-popup) (remove indv (edited-indvs indv-editor-popup) :key 'first))
      (setf (cg:range current-indvs-list) (remove indv (cg:range current-indvs-list)))
      (setf (cg:value current-indvs-list) (first (cg:range current-indvs-list)))
      (mark-change-made indv-editor-popup))))


(defun add-type-completions (indv type-list indv-editor-popup)
  (cond ((member indv (new-indvs indv-editor-popup) :test 'equal :key 'car)
         (setf (second (assoc indv (new-indvs indv-editor-popup) :test 'equal))
           (union type-list (second (assoc indv (new-indvs indv-editor-popup) :test 'equal))
                  :test 'equal)))
        ((member indv (modified-indvs indv-editor-popup) :test 'equal :key 'car)
         (setf (second (assoc indv (modified-indvs indv-editor-popup) :test 'equal))
           (union type-list (second (assoc indv (modified-indvs indv-editor-popup) :test 'equal))
                  :test 'equal)))
        ((member indv (cg:range (cg:find-component :current-indvs-list indv-editor-popup))
                 :test 'equal)
         (push (list indv (union type-list
                                 (get-type-assignments indv (calling-window indv-editor-popup))
                                 :test 'equal))
               (modified-indvs indv-editor-popup)))
        (t
         ;; There was no individual already added, add it now as if they had clicked Add (assuming
         ;;  there's some name in the individual box
         (when indv
           (add-new-individual indv type-list indv-editor-popup))))
  (mark-change-made indv-editor-popup))


(defun remove-type-completions (indv type-list indv-editor-popup)
  (cond ((member indv (new-indvs indv-editor-popup) :test 'equal :key 'car)
         (setf (second (assoc indv (new-indvs indv-editor-popup) :test 'equal))
           (set-difference (second (assoc indv (new-indvs indv-editor-popup) :test 'equal))
                           type-list
                           :test 'equal)))
        ((member indv (modified-indvs indv-editor-popup) :test 'equal :key 'car)
         (setf (second (assoc indv (modified-indvs indv-editor-popup) :test 'equal))
           (set-difference (second (assoc indv (modified-indvs indv-editor-popup) :test 'equal))
                           type-list
                           :test 'equal)))
        ((member indv (cg:range (cg:find-component :current-indvs-list indv-editor-popup))
                 :test 'equal)
         (push (list indv (set-difference (get-type-assignments indv (calling-window indv-editor-popup))
                                          type-list
                                          :test 'equal))
               (modified-indvs indv-editor-popup)))
        (t
         ;; if here then no individual must exist.. don't do anything
         ))
  (mark-change-made indv-editor-popup))



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


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Current Individuals List 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun select-current-indv-on-click (indv-editor-popup current-indv-list)
  "Event handler for the current individuals single-item-list - if you click anywhere in the list
    switch the displayed types to those for the currently selected indv in the list (as opposed to 
    the new individual currently in the new-individual-editbox"
  (setf (user-click-selected current-indv-list) t)
  (let ((indv (cg:value current-indv-list)))
    (when (and indv (not (eq indv *new-individual-marker*)))
      (select-current-indv indv indv-editor-popup))))


(defun select-current-indv-on-change (current-indv-list new-value old-value)
  (declare (ignore old-value))
  "Event handler for the current individuals single-item-list - if you change the selected indv,
    change the display of assigned types to the newly selected indv"
  (let ((indv-editor-popup (cg:parent current-indv-list)))
    (cond ((and (eq new-value *new-individual-marker*)
                (user-click-selected current-indv-list))
           (setf (user-click-selected current-indv-list) nil)
           nil)
          ((eq new-value *new-individual-marker*)
           t)
          (t
           (select-current-indv new-value indv-editor-popup)
           t))))


(defun select-curent-indv-on-kill-focus (current-indv-list)
  (setf (user-click-selected current-indv-list) nil))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; New Individuals Editbox
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun new-indv-name-on-click (indv-editor-popup new-indv-name-editbox)
  "Event handler for when you click on the new-indv-editbox, change the assigned types to be 
    for the indv in the box"
  (display-indv-assigned-types (cg:value new-indv-name-editbox) indv-editor-popup))


(defun highlight-extant-individual (indv-name indv-editor-popup)
  ;; Highlight indv in the current-indv-list of the indv-editor-popup if it already 
  ;;  exists. Otherwise highlights the New Indiviual marker.
  ;; A side effect of this highlighting will be that this individuals currently assigned
  ;;  types will be displayed
  ;; Returns T if the individual already existed, false otherwise
  (let* ((current-indv-list (cg:find-component :current-indvs-list indv-editor-popup))
         (already-exists? (member indv-name (cg:range current-indv-list))))
    (setf (cg:value current-indv-list)
      (if (and indv-name already-exists?) indv-name *new-individual-marker*))
    already-exists?))
   

(defun invalidate-collection-type-assignment (indv-name indv-editor-popup)
  ;; If the current individual name is a Collection, then we don't want to allow the
  ;;  modification of it's Type. 
  (declare (ignore indv-name))
  (let ((type-editbox (cg:find-component :new-individual-type indv-editor-popup)))
    (setf (cg:value type-editbox) "Cannot assign Collection Types")
    (setf (cg:available type-editbox) nil)))

(defun make-type-assignment-available (indv-editor-popup)
  ;; This exists so that we can turn back on the editability of the type assignment box
  ;;  after it was turned off for collections.
  (let ((type-editbox (cg:find-component :new-individual-type indv-editor-popup)))
    (setf (cg:value type-editbox) "")
    (setf (cg:available type-editbox) t)))


(defun new-indv-name-on-change (indv-name-editbox new-value old-value)
  (declare (ignore old-value))
  (let ((current-indv-name (if (stringp new-value) (cg:read-from-string-safely new-value) new-value))
        (indv-editor-popup (cg:parent indv-name-editbox)))
    (when current-indv-name
      (let ((extant? (highlight-extant-individual current-indv-name indv-editor-popup)))
        (cond ((indv-collection? current-indv-name)
               (when (not extant?) (display-indv-assigned-types current-indv-name indv-editor-popup))
               (invalidate-collection-type-assignment current-indv-name indv-editor-popup))
              (t
               (make-type-assignment-available indv-editor-popup))))))
  ;; Must return T so that the change the user made gets reflected in the editbox
  t)

      

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Individual Edit Buttons 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun add-individual-on-change (add-indv-button new-value old-value)
  (declare (ignore new-value old-value))
  (let* ((indv-editor-popup (cg:parent add-indv-button))
         (new-indv-name (get-current-individual indv-editor-popup)))
    (when new-indv-name
      (let ((current-indvs-list (cg:find-component :current-indvs-list indv-editor-popup)))
        (unless (member new-indv-name (cg:range current-indvs-list))
          (add-new-individual new-indv-name (cg:range (cg:find-component :current-assigned-types-list indv-editor-popup))
                              indv-editor-popup)))))
  nil)


(defun delete-individual-on-change (del-indv-button new-value old-value)
  (declare (ignore new-value old-value))
  (let* ((indv-editor-popup (cg:parent del-indv-button))
         (current-indv (cg:value (cg:find-component :current-indvs-list indv-editor-popup))))
    (delete-individual current-indv indv-editor-popup))
  nil)

(defun edit-individual-on-change (edit-indv-button new-value old-value)
  (declare (ignore new-value old-value))
  (let* ((indv-editor-popup (cg:parent edit-indv-button))
         (current-indv (cg:value (cg:find-component :current-indvs-list indv-editor-popup))))
    (when (and current-indv (not (eq current-indv *new-individual-marker*)))
      (cg:pop-up-string-dialog (cg:parent edit-indv-button)
                               "Edit Individual Name"
                               "Please enter the new name"
                               nil current-indv "Ok" "Cancel")))
  nil)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Type Assignment  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun complete-collection (sub-collection indv-editor-popup)
  ;; sub-casename has to be at least 1 letter long...
  (when (>= (length sub-collection) 1)
    (let ((completions (fire::complete-from-KB sub-collection :filter 'fire:collection?))
          (completion-list-widget (cg:find-component :new-indiv-type-completions-list indv-editor-popup)))
      (setf (cg:range completion-list-widget) completions))))


(defun new-individual-type-on-change (new-indv-type-editbox new-value old-value)
  (declare (ignore old-value))
  (when (> (length new-value) 3)
    (complete-collection new-value (cg:parent new-indv-type-editbox)))
  t)
  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Type Assignment Buttons 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun add-type-on-change (add-type-button new-value old-value)
  (declare (ignore new-value old-value))
  (let* ((indv-editor-popup (cg:parent add-type-button))
         (type-completions (cg:value (cg:find-component :new-indiv-type-completions-list indv-editor-popup)))
         (current-assigned-types-list (cg:find-component :current-assigned-types-list indv-editor-popup))
         (current-indv (get-current-individual indv-editor-popup)))
    (when current-indv 
      (add-type-completions current-indv type-completions indv-editor-popup)
      (setf (cg:range current-assigned-types-list)
        (union type-completions (cg:range current-assigned-types-list)
               :test 'equal))))
  nil)




(defun remove-type-on-change (remove-type-button new-value old-value)
  (declare (ignore new-value old-value))
  (let* ((indv-editor-popup (cg:parent remove-type-button))
         (current-assigned-types-list (cg:find-component :current-assigned-types-list indv-editor-popup))
         (types-tobe-removed (cg:value current-assigned-types-list))
         (current-indv (get-current-individual indv-editor-popup)))
    (when types-tobe-removed
      (remove-type-completions current-indv types-tobe-removed indv-editor-popup)
      (setf (cg:range current-assigned-types-list)
        (set-difference (cg:range current-assigned-types-list)
                        types-tobe-removed))
      (setf (cg:value current-assigned-types-list) nil)))
  nil)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Indv Editor General Buttons 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun verify-types (indv-editor-popup)
  (let ((new (new-indvs indv-editor-popup)))
    (every #'(lambda (info)
               (or (indv-collection? (first info)) (not (null (second info)))))
           new)))

(defun apply-indv-edits-on-change (apply-button new-value old-value)
  (declare (ignore new-value old-value))
  (let ((indv-editor-popup (cg:parent apply-button)))
    (with-slots (new-indvs modified-indvs edited-indvs deleted-indvs) 
        indv-editor-popup
      (apply-individual-modifications (calling-window indv-editor-popup)
                                      new-indvs
                                      modified-indvs
                                      edited-indvs
                                      deleted-indvs)
      (mark-changes-finished indv-editor-popup)))
  nil)


(defun apply-and-quit-on-change (ok-button new-value old-value)
  (declare (ignore new-value old-value))
  (let ((indv-editor-popup (cg:parent ok-button)))
    (with-slots (new-indvs modified-indvs edited-indvs deleted-indvs) 
        indv-editor-popup
      (if (verify-types indv-editor-popup)
        (cg:flag-modal-completion indv-editor-popup
                                  (list new-indvs
                                        modified-indvs
                                        edited-indvs
                                        deleted-indvs))
        (cg:pop-up-message-dialog (cg:parent ok-button) "Type Assignment Error" 
                                  "You must assign a type for all new individuals"
                                  nil "Ok")))))






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Individual Editor Window Creation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun make-individual-editor-popup-dialog-items ()
  (list (make-instance 'cg:editable-text 
          :name :new-individual-name
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :delayed nil
          :on-change 'new-indv-name-on-change
          :value " " 
          :left 13 
          :top 60 
          :height 28 
          :width 165)
        (make-instance 'cg:static-text 
          :name :new-individual-label
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :value "Individual"
          :left 16 
          :top 40 
          :height 11)
        
        (make-instance 'cg:button 
          :name :add-indv-button
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Add"
          :on-change 'add-individual-on-change 
          :left 190 
          :top 60
          :height 25 
          :width 35
          :tooltip "Add new individual")
        
        (make-instance 'current-individual-single-item-list 
          :name :current-indvs-list
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :on-click 'select-current-indv-on-click
          :on-change 'select-current-indv-on-change 
          :on-kill-focus 'select-curent-indv-on-kill-focus
          :left 240 
          :top 24 
          :height 100 
          :width 174)
        (make-instance 'cg:static-text 
          :name :current-indvs-label
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :value "Current Individuals" 
          :left 240 
          :top 8 
          :height 16 
          :width 118)
        
        (make-instance 'cg:button 
          :name :remove-indv-button 
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Delete"
          :on-change 'delete-individual-on-change
          :left 245 
          :top 130
          :height 22
          :width 74
          :tooltip "Delete the currently selected individual")
        (make-instance 'cg:button 
          :name :edit-indv-button 
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Edit"
          :on-change 'edit-individual-on-change
          :left 336 
          :top 130
          :height 22 
          :width 74
          :tooltip "Edit the spelling of a currently selected individual")
        
        (make-instance 'cg:editable-text 
          :name :new-individual-type
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :value " " 
          :delayed nil
          :on-change 'new-individual-type-on-change
          :left 8 
          :top 182 
          :height 29 
          :width 168)
        (make-instance 'cg:static-text 
          :name :new-individual-type-label 
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :value "Assign New Type" 
          :left 8 
          :top 168 
          :height 14 
          :width 101)
        
        (make-instance 'cg:multi-item-list 
          :name :new-indiv-type-completions-list
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :height 99
          :left 8
          :top 240 
          :width 168)
        (make-instance 'cg:static-text 
          :name :possible-type-completions-label 
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :value "Possible Type Completions" 
          :left 8 
          :top 218 
          :height 12 
          :width 146)
        
        (make-instance 'cg:picture-button 
          :name :remove-individual-type-button
          :pixmap-source (get-text-case-display-path :subdirs '("icons") 
                                               :filename "arrow-left" :filetype "bmp")
          :on-change 'remove-type-on-change 
          :left 190 
          :top 286
          :height 25 
          :width 35)
        (make-instance 'cg:picture-button 
          :name :add-individual-type-button 
          :pixmap-source (get-text-case-display-path :subdirs '("icons") 
                                               :filename "arrow-right" :filetype "bmp")
          :on-change 'add-type-on-change
          :left 190 
          :top 254
          :height 25 
          :width 35)
        
        (make-instance 'cg:multi-item-list
          :name :current-assigned-types-list 
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :left 240 
          :top 240
          :height 99 
          :width 174)
        (make-instance 'cg:static-text 
          :name :current-assigned-types-label
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :value "Current Assigned Types" 
          :left 240
          :top 218 
          :width 146)
        
        (make-instance 'cg:lisp-group-box
          :name :indv-editor-group
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :left 2 
          :top 2 
          :height 158 
          :width 417)
        (make-instance 'cg:lisp-group-box
          :name :type-editor-group
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :left 2 
          :top 160 
          :height 188 
          :width 417)
        
        (make-instance 'cg:button 
          :name :apply-changes-button
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Apply" 
          :available nil
          :on-change 'apply-indv-edits-on-change
          :left 160 
          :top 352 
          :height 24 
          :width 80)
        (make-instance 'cg:button
          :name :done-button
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Ok"
          :on-change 'apply-and-quit-on-change
          :left 245 
          :top 352 
          :height 24 
          :width 80)
        (make-instance 'cg:cancel-button
          :name :cancel-button
          :font (cg:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Cancel"
          :left 330 
          :top 352 
          :height 24 
          :width 80)))



(defun initialize-individual-editor (text-dialog indv-editor-window)
  (let ((current-indv-list (cg:find-component :current-indvs-list indv-editor-window))
        (current-indvs (cons *new-individual-marker*
                             (get-case-individuals text-dialog)))
        (owner (cg:owner indv-editor-window)))
    (setf (cg:left indv-editor-window) (+ 25 (if (eq owner (cg:screen cg:*system*)) 0 (cg:left owner))))
    (setf (cg:top indv-editor-window) (+ 100 (if (eq owner (cg:screen cg:*system*)) 0 (cg:top owner))))
    (setf (new-indvs indv-editor-window) nil)
    (setf (modified-indvs indv-editor-window) nil)
    (setf (cg:range current-indv-list) current-indvs)
    (select-current-indv (first current-indvs) indv-editor-window)
    (setf (cg:available (cg:find-component :apply-changes-button indv-editor-window)) nil)))



(defun make-individual-editor-popup (&optional (owner (cg:screen cg:*system*)) (form-p nil))
  (let ((pop-up? (not form-p)))
    (cg:make-window :individual-editor-popup
      :owner owner
      :calling-window owner
      :owner-name (cg:name owner)
      :class 'individual-editor-popup
      :background-color (cg:background-color owner)
      :title "Create or Edit an Individual"
      :border :palette
      :cursor-name :arrow-cursor
      :pop-up pop-up?
      :resizable form-p   ;; resizeable only if form-p is true
      
      :close-button t
      :title-bar t
      :dialog-items (make-individual-editor-popup-dialog-items)
      
      :width 429
      :height 405
      
      :path #p"D:\\QRG\\FIRE\\V1\\case-manager\\case-viewer\\text-display-and-edit\\individual-editor-popup.lsp"
      :form-p form-p
      :package-name :textual-case-display
      )))


(defun create-individual-editor-popup (&optional (owner (cg:screen cg:*system*)))
  (let ((popup (cg:find-or-make-pop-up-window :individual-editor-popup 'make-individual-editor-popup owner)))
    (initialize-individual-editor owner popup)
    (cg:pop-up-modal-dialog popup)))




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