;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: expression-editor-popup.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: July 18, 2002 16:18:06
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Wednesday, January 14, 2004 at 18:38:47 by usher
;;;; ---------------------------------------------------------------------------

(in-package :textual-case-display)


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


(defclass expression-editor-popup (cg:dialog)
  ((calling-window :accessor calling-window :initform nil :initarg :calling-window)
   (expression :type editor-main-expression :accessor expression :initform nil 
              :documentation "an editor-expression object")
   ))


(defclass expression-display-pane (cg:text-edit-pane)
  ())

(defclass expression-display (cg:multi-line-editable-text)
  ())

(defmethod cg:widget-device ((expr-display expression-display) (editor-popup expression-editor-popup))
  'expression-display-pane)



(defmethod show-help-string ((item cg:dialog-item) (parent t))
  ;; do nothing
  )

(defmethod show-help-string ((item cg:dialog-item) (editor-popup expression-editor-popup))
  (let ((stat-bar (cg:status-bar editor-popup))
        (help-string (cg:help-string item)))
    (when (and stat-bar help-string)
      (cg:status-bar-message stat-bar help-string :no-border-p nil))))



(defmethod hide-help-string ((item cg:dialog-item) (parent t))
  )

(defmethod hide-help-string ((item cg:dialog-item) (editor-popup expression-editor-popup))
  (let ((stat-bar (cg:status-bar editor-popup)))
    (when stat-bar
      (cg:status-bar-message stat-bar "" :no-border-p nil))))


(excl:without-package-locks
 (defmethod cg:show-tooltip :after ((item cg:dialog-item))
   (let ((parent (cg:parent item)))
     (show-help-string item parent)))
 
 (defmethod cg:hide-tooltip :after ((item cg:dialog-item))
   (let ((parent (cg:parent item)))
     (hide-help-string item parent)))
 )



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Component Accessors
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun expression-editor-expression-box (editor-popup)
  (cg:find-component :expression-editor-expression editor-popup))

(defun expression-editor-expression (editor-popup)
  (cg:read-from-string-safely (cg:value (expression-editor-expression-box editor-popup))))

;;;;;;;;;;;;;;;;;;;;;;;;

;;; The combo box which selects which element of the expression you are
;;;  modfiying
(defun expression-editor-expr-element-combo (editor-popup)
  (cg:find-component :expression-editor-element-combo editor-popup))

;;; The expr-slot currently selected in the combo box
(defun expression-editor-expr-element (editor-popup)
  (cg:value (expression-editor-expr-element-combo editor-popup)))

;;; The actual expression element associated with the expr-slot
(defun expression-editor-expr-element-value (expr-slot editor-popup)
  (cdr (assoc expr-slot (expr-slots (expression editor-popup)))))

(defun expr-slot-value (expr-slot editor-popup)
  (cdr (assoc expr-slot (expr-slots (expression editor-popup)))))

;;;;;;;;;;;;;;;;;;;;;;;

;;; The type of the element currently being considered to add to the 
;;;  statement
(defun expression-editor-element-type (editor-popup)
  (cond ((cg:value (cg:find-component :predicate-elem editor-popup))
         :predicate)
        ((cg:value (cg:find-component :individual-elem editor-popup))
         :individual)
        ((cg:value (cg:find-component :collection-elem editor-popup))
         :collection)
        (t
         :variable)))


(defun expression-editor-element-box (editor-popup)
  (cg:find-component :expression-editor-element editor-popup))

(defun expression-editor-element (editor-popup)
  (cg:read-from-string-safely (cg:value (expression-editor-element-box editor-popup))))


(defun expression-editor-element-completions-list (editor-popup)
  (cg:find-component :expression-editor-completions editor-popup))

(defun expression-editor-element-completion (editor-popup)
  (cg:value (expression-editor-element-completions-list editor-popup)))


(defun advanced-mode? (editor-popup)
  ;; returns true if we are currently in advanced editing mode
  (not (cg:read-only (expression-editor-expression-box editor-popup))))


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

(defun expression-editor-expression-on-click (editor-popup expression-box)
  (declare (ignore editor-popup expression-box))
  ;; do nothing
  )

(defun expression-editor-expression-on-set-focus (expression-box)
  (declare (ignore expression-box))
  nil)

(defun find-elem-around-pos (pos editor-popup)
  (first (find pos (expr-slots (expression editor-popup))
               :key 'cdr
               :test #'(lambda (pos expr-elem)
                         (check-element (value expr-elem) pos expr-elem)))))

(defmethod check-element ((elem-value t) pos expr-elem)
  (let ((elem-start-pos (element-position expr-elem))
        (elem-end-pos (+ (element-position expr-elem)
                         (length (element-display-form elem-value)))))
    (and (>= pos elem-start-pos)
         (< pos elem-end-pos))))

(defmethod check-element ((elem-value editor-expression) pos expr-elem)
  (let ((elem-start-pos (element-position expr-elem))
        (elem-end-pos (+ (element-position expr-elem)
                         (- (length (element-display-form elem-value)) 1))))
    (or (= pos elem-start-pos)
        (= pos elem-end-pos))))
                  

(defmethod cg:mouse-left-down ((expr-box expression-display-pane) buttons cursor-pos)
  (declare (ignore buttons cursor-pos))
  (call-next-method)  ;; let the system update the cursor position
  ;; Now mess with the updated info :)
  (let* ((pos (cg:current-text-column expr-box))
         (editor-popup (cg:parent expr-box))
         (expr-slot-elem (find-elem-around-pos pos editor-popup)))
    (when (not (advanced-mode? editor-popup))
      (if expr-slot-elem
        (select-associated-element expr-slot-elem editor-popup)
        (select-associated-element :main-expression editor-popup)))))


(defmethod cg:mouse-right-down ((expr-box expression-display-pane) buttons cursor-pos)
  (declare (ignore buttons cursor-pos)))

(defmethod cg:mouse-right-up ((expr-box expression-display-pane) buttons cursor-pos)
  (declare (ignore buttons cursor-pos)))
  

(defmethod cg:mouse-double-click ((expr-box expression-display-pane) buttons cursor-pos)
  (declare (ignore buttons cursor-pos)))


(defun highlight-associated-element (expr-slot editor-popup)
  (let ((expr-box (expression-editor-expression-box editor-popup)))
    (if (eq expr-slot :main-expression)
      (cg:set-selection expr-box 0 0)
      (let* ((associated-elem (expr-slot-value expr-slot editor-popup))
             (starting-pos (element-position associated-elem))
             (ending-pos (+ starting-pos (length (element-display-form associated-elem)))))
        (cg:set-selection expr-box starting-pos ending-pos)
        ))))


(defun select-associated-element (expr-slot editor-popup)
  (setf (cg:value (expression-editor-expr-element-combo editor-popup)) expr-slot))



(defun clear-expression (editor-popup)
  (setf (expression editor-popup) (make-initial-editor-expression))
  (setf (cg:value (expression-editor-expression-box editor-popup)) 
    (element-display-form (expression editor-popup)))
  (setf (cg:range (expression-editor-expr-element-combo editor-popup))
    (cons :main-expression
          (mapcar 'first (expr-slots (expression editor-popup)))))
  (setf (cg:value (expression-editor-expr-element-combo editor-popup))
    :main-expression)
  (invalidate-almost-everything editor-popup))
  
(defun replace-main-expression (new-expr editor-popup)
  (replace-expression new-expr (expression editor-popup))
  (setf (cg:value (expression-editor-expression-box editor-popup))
    (element-display-form (expression editor-popup)))
  (setf (cg:range (expression-editor-expr-element-combo editor-popup))
    (cons :main-expression
          (mapcar 'first (expr-slots (expression editor-popup))))))



(defun replace-slot-value (expr-slot replacement editor-popup)
  (replace-element expr-slot replacement (expression editor-popup))
  (setf (cg:value (expression-editor-expression-box editor-popup))
    (element-display-form (expression editor-popup)))
  (setf (cg:range (expression-editor-expr-element-combo editor-popup))
    (cons :main-expression
          (mapcar 'first (expr-slots (expression editor-popup))))))



(defun erase-slot-value (editor-popup)
  (let ((expr-slot (expression-editor-expr-element editor-popup)))
    (if (eq expr-slot :main-expression)
      (clear-expression editor-popup)
      (let ((slot-filler (cg:read-from-string-safely (format nil "<~A>" expr-slot))))
        (replace-slot-value expr-slot slot-filler editor-popup)
        (highlight-associated-element expr-slot editor-popup)))))


(defun add-new-slots (expr editor-popup)
  (let ((slots (mapcar 'name (expression expr))))
    (setf (cg:range (expression-editor-expr-element-combo editor-popup))
      (cons :main-expression
            (union (rest (cg:range (expression-editor-expr-element-combo editor-popup)))
              slots)))))

(defun assign-expression (editor-popup)
  (let* ((expr-slot (expression-editor-expr-element editor-popup))
         (expr (make-default-editor-expression expr-slot (expression editor-popup))))
    (replace-slot-value expr-slot expr editor-popup)
    (add-new-slots expr editor-popup)
    (highlight-associated-element expr-slot editor-popup)))

(defun validate-predicate (pred)
  ;; returns true if pred is a valid predicate
  (let ((arity (fire::arity pred)))
    (not (eq arity :unknown))))

(defun validate-collection (coll)
  (fire:collection? coll))

(defun assign-predicate (pred expr-slot editor-popup)
  ;; When I assign a predicate - resize the expression appropriately for the
  ;;  arity of the provided predicate
  (let ((arity (fire::arity pred))
        (containing-expr-slot (containing-expr (expr-slot-value expr-slot editor-popup))))
    (if (eq arity :unknown)
      (cg:pop-up-message-dialog editor-popup "Unknown Predicate"
                                (format nil "Unknown predicate: ~A" pred)
                                nil "Ok")
      (let ((new-expr (make-specific-predicate-expression pred arity containing-expr-slot (expression editor-popup))))
        (if (eq :main-expression containing-expr-slot)
          (replace-main-expression new-expr editor-popup)
          (replace-slot-value containing-expr-slot new-expr editor-popup))
        (highlight-associated-element containing-expr-slot editor-popup)))))

(defun assign-element (elem editor-popup)
  (let ((expr-slot (expression-editor-expr-element editor-popup))
        (element-type (expression-editor-element-type editor-popup)))
    (cond ((and (eq :predicate element-type)
                (eq :predicate (expr-slot-type expr-slot)))
           (assign-predicate elem expr-slot editor-popup))
          ((and (eq :predicate element-type)
                (not (validate-predicate elem)))
           (cg:pop-up-message-dialog editor-popup "Error: Invalid Element"
                                     (format nil "Unknown predicate: ~A" elem)
                                     nil "Ok"))
          ((and (eq :collection element-type)
                (not (validate-collection elem)))
           (cg:pop-up-message-dialog editor-popup "Error: Invalid Element"
                                     (format nil "Unknown collection: ~A" elem)
                                     nil "Ok"))
          ((eq :variable element-type)
           (replace-slot-value expr-slot (intern (format nil "?~A" elem)) editor-popup)
           (highlight-associated-element expr-slot editor-popup))
          (t
           (replace-slot-value expr-slot elem editor-popup)
           (highlight-associated-element expr-slot editor-popup)))))



(defun display-predicate-completions (editor-popup)
  (setf (cg:available (expression-editor-element-completions-list editor-popup)) t)
  (setf (cg:background-color (expression-editor-element-completions-list editor-popup)) cg:white) 
  (setf (cg:read-only (expression-editor-element-box editor-popup)) nil)
  (setf (cg:background-color (expression-editor-element-box editor-popup)) cg:white)
  
  (setf (cg:value (expression-editor-element-box editor-popup)) "")
  (setf (cg:range (expression-editor-element-completions-list editor-popup))
    nil))

(defun display-individual-completions (editor-popup)
  (setf (cg:available (expression-editor-element-completions-list editor-popup)) t)
  (setf (cg:background-color (expression-editor-element-completions-list editor-popup)) cg:white)
  (setf (cg:read-only (expression-editor-element-box editor-popup)) t)
  (setf (cg:background-color (expression-editor-element-box editor-popup)) cg:white)
  
  (setf (cg:value (expression-editor-element-box editor-popup)) "")
  (let ((current-indvs (get-case-individuals (calling-window editor-popup))))
    (setf (cg:range (expression-editor-element-completions-list editor-popup))
      current-indvs)))

(defun display-collection-completions (editor-popup)
  (setf (cg:available (expression-editor-element-completions-list editor-popup)) t)
  (setf (cg:background-color (expression-editor-element-completions-list editor-popup)) cg:white)
  (setf (cg:read-only (expression-editor-element-box editor-popup)) nil)
  (setf (cg:background-color (expression-editor-element-box editor-popup)) cg:white)
  
  (setf (cg:value (expression-editor-element-box editor-popup)) "")
  (setf (cg:range (expression-editor-element-completions-list editor-popup)) 
    nil))

(defun display-variable-completions (editor-popup)
  (setf (cg:available (expression-editor-element-completions-list editor-popup)) nil)
  (setf (cg:background-color (expression-editor-element-completions-list editor-popup)) cg:gray)
  (setf (cg:read-only (expression-editor-element-box editor-popup)) nil)
  (setf (cg:background-color (expression-editor-element-box editor-popup)) cg:white)
  
  (setf (cg:value (expression-editor-element-box editor-popup)) "")
  (setf (cg:range (expression-editor-element-completions-list editor-popup))
    nil))

(defun complete-expression-element (elem editor-popup)
  (setf (cg:value (expression-editor-element-box editor-popup))
    (format nil "~A" elem)))


(defun invalidate-almost-everything (editor-popup)
  (setf (cg:available (cg:find-component :predicate-elem editor-popup)) nil)
  (setf (cg:available (cg:find-component :individual-elem editor-popup)) nil)
  (setf (cg:available (cg:find-component :collection-elem editor-popup)) nil)
  (setf (cg:available (cg:find-component :variable-elem editor-popup)) nil)
  (setf (cg:available (expression-editor-element-completions-list editor-popup)) nil)
  (setf (cg:available (expression-editor-element-box editor-popup)) nil)
  (setf (cg:available (cg:find-component :assign-elem editor-popup)) nil)
  (setf (cg:available (cg:find-component :assign-expr editor-popup)) nil))


(defun invalidate-everything (editor-popup)
  (invalidate-almost-everything editor-popup)
  (setf (cg:available (expression-editor-expr-element-combo editor-popup)) nil)
  (setf (cg:available (cg:find-component :erase editor-popup)) nil))


(defun mark-invalid-options (expr-slot editor-popup)
  ;; Marks the entry dialog-items (assign-expr, element, radio-buttons etc) invalid
  ;;  depending on what expr-slot is currently selected
  (let ((slot-type (expr-slot-type expr-slot)))
    (cond ((eq slot-type :main-expression)
           (invalidate-almost-everything editor-popup)
           )
          ((eq slot-type :predicate)
           (setf (cg:available (cg:find-component :predicate-elem editor-popup)) t)
           (setf (cg:available (cg:find-component :individual-elem editor-popup)) nil)
           (setf (cg:available (cg:find-component :collection-elem editor-popup)) nil)
           (setf (cg:available (cg:find-component :variable-elem editor-popup)) nil)
           (setf (cg:available (expression-editor-element-completions-list editor-popup)) t)
           (setf (cg:available (expression-editor-element-box editor-popup)) t)
           (setf (cg:available (cg:find-component :assign-elem editor-popup)) t)
           (setf (cg:available (cg:find-component :assign-expr editor-popup)) t)

           (setf (cg:value (cg:find-component :predicate-elem editor-popup)) t)
           )
          (t ;; arguments
           (setf (cg:available (cg:find-component :predicate-elem editor-popup)) t)
           (setf (cg:available (cg:find-component :individual-elem editor-popup)) t)
           (setf (cg:available (cg:find-component :collection-elem editor-popup)) t)          
           (setf (cg:available (cg:find-component :variable-elem editor-popup)) t)
           (setf (cg:available (expression-editor-element-completions-list editor-popup)) t)
           (setf (cg:available (expression-editor-element-box editor-popup)) t)
           (setf (cg:available (cg:find-component :assign-elem editor-popup)) t)
           (setf (cg:available (cg:find-component :assign-expr editor-popup)) t)
           ))))
  


(defun get-comment-for (predicate editor-popup)
  "Retrieve comment data for a predicate from the KB"
  (let ((text-display (calling-window editor-popup)))
    (first (fire:ask-it `(data::comment ,predicate data::?x)
                        :reasoner (fire-case-viewer::reasoner text-display)
                        :number 1
                        :response 'data::?x))))

(defun get-pidgin (predicate)
  (third (fire::get-genformat-for predicate)))

(defun display-category-info (info-win category info)
  (cg:set-character-format info-win :scope :selection :bold :on)
  (format info-win "~A:~%  "  category)
  (cg:set-character-format info-win :scope :selection :bold :off)
  (format info-win "~A~%~%" info))


(defmethod show-element-information ((elem-type t) elem editor-popup)
  (declare (ignore elem editor-popup))
  )

(defmethod show-element-information ((elem-type (eql :individual)) elem editor-popup)
  ;; Eventually show information about the invdividual - such as isa info and other expressions
  ;;  its used in
  (declare (ignore elem editor-popup))
  )


(defun get-isas (coll)
  (fire:retrieve-isas coll))

(defun get-genls (coll)
  (fire:immediate-genls coll))

(defun get-specs (coll)
  (fire:immediate-specs coll))


(defmethod show-element-information ((elem-type (eql :collection)) elem editor-popup)
  (let ((info-pane (cg:window (cg:find-component :element-information-text-box editor-popup)))
        (isas (get-isas elem))
        (genls (get-genls elem))
        (specs (get-specs elem))
        (doc-string (get-comment-for elem editor-popup)))
    (cg:clear-page info-pane)
    (display-category-info info-pane "COLLECTION" elem)
    (display-category-info info-pane "ISAS" isas)
    (display-category-info info-pane "GENLS" genls)
    (display-category-info info-pane "SPECS" specs)
    (display-category-info info-pane "DOCUMENTATION" doc-string)
    (cg:set-selection info-pane 0 0)))
    


(defmethod show-element-information ((elem-type (eql :predicate)) elem editor-popup)
  (let ((info-pane (cg:window (cg:find-component :element-information-text-box editor-popup)))
        (arity (fire::arity elem))
        (doc-string (get-comment-for elem editor-popup))
        (pidgin-string (get-pidgin elem)))
    (cg:clear-page info-pane)
    (display-category-info info-pane "PREDICATE" elem)
    (display-category-info info-pane "ARGUMENTS" arity)
    (display-category-info info-pane "PIDGIN" pidgin-string)
    (display-category-info info-pane "DOCUMENTATION" doc-string)
    (cg:set-selection info-pane 0 0)))
  




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

(defun expression-editor-element-combo-on-change (element-combo new-value old-value)
  (declare (ignore old-value))
  (let ((editor-popup (cg:parent element-combo)))
    (mark-invalid-options new-value editor-popup)
    (highlight-associated-element new-value editor-popup))
  t)


(defun expression-editor-erase-on-change (erase-button new old)
  (declare (ignore new old))
  (let ((editor-popup (cg:parent erase-button)))
    (erase-slot-value editor-popup))
  nil)


(defun expression-editor-assign-expr-on-change (assign-expr-button new old)
  (declare (ignore new old))
  (let* ((editor-popup (cg:parent assign-expr-button)))
    (assign-expression editor-popup))
  nil)


(defun expression-editor-assign-elem-on-change (assign-elem-button new old)
  (declare (ignore new old))
  (let* ((editor-popup (cg:parent assign-elem-button))
         (elem (expression-editor-element editor-popup)))
    (when elem
      (assign-element elem editor-popup)))
  nil)
    


(defun expression-editor-predicate-elem-on-change (predicate-radio-button new-value old-value)
  (declare (ignore old-value))
  (let ((editor-popup (cg:parent predicate-radio-button)))
    (when new-value
      (display-predicate-completions editor-popup)))
  t)

(defun expression-editor-individual-elem-on-change (individual-radio-button new-value old-value)
  (declare (ignore old-value))
  (let ((editor-popup (cg:parent individual-radio-button)))
    (when new-value
      (display-individual-completions editor-popup)))
  t)

(defun expression-editor-collection-elem-on-change (individual-radio-button new-value old-value)
  (declare (ignore old-value))
  (let ((editor-popup (cg:parent individual-radio-button)))
    (when new-value
      (display-collection-completions editor-popup)))
  t)

(defun expression-editor-variable-elem-on-change (variable-radio-button new-value old-value)
  (declare (ignore old-value))
  (let ((editor-popup (cg:parent variable-radio-button)))
    (when new-value
      (display-variable-completions editor-popup)))
  t)



(defun predicate? (pred)
  (let ((arity (fire::arity pred)))
    (or (equal arity ':n-ary)
        (and (numberp (fire::arity pred))
             (> (fire::arity pred) 0)))))
        
(defun complete-predicate (sub-predicate editor-popup)
  ;; sub-predicate has to be at least 1 letter long...
  (when (>= (length sub-predicate) 1)
    (let ((completions (fire::complete-from-KB sub-predicate :filter 'predicate?))
          (completion-list (expression-editor-element-completions-list editor-popup)))
      (setf (cg:range completion-list) completions))))

(defun complete-element-collection  (sub-collection editor-popup)
  ;; sub-predicate 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 (expression-editor-element-completions-list editor-popup)))
      (setf (cg:range completion-list) completions))))

(defun expression-editor-expression-editor-element-on-change (element-box new old)
  (declare (ignore old))
  (when (> (length new) 3)
    (let* ((editor-popup (cg:parent element-box))
           (element-type (expression-editor-element-type editor-popup)))
      (when (eq :predicate element-type)
        (complete-predicate new editor-popup))
      (when (eq :collection element-type)
        (complete-element-collection new editor-popup))))
  t)




(defun expression-editor-expression-editor-completions-on-double-click (editor-popup
                                                                        element-completions-list)
  (complete-expression-element (cg:value element-completions-list) editor-popup)
  t)

(defun expression-editor-expression-editor-completions-on-change (element-completions-list new old)
  (declare (ignore old))
  (let ((editor-popup (cg:parent element-completions-list)))
    (show-element-information (expression-editor-element-type editor-popup) new editor-popup))
  t)


(defun expression-editor-advanced-on-change (advanced-button new-value old-value)
  (declare (ignore new-value old-value))
  (let ((editor-popup (cg:parent advanced-button)))
    (invalidate-everything editor-popup)
    (setf (cg:read-only (expression-editor-expression-box editor-popup)) nil))
  nil) 

(defun expression-editor-browse-kb-on-change (browse-kb-button new-value old-value)
  (declare (ignore browse-kb-button new-value old-value))
  #+fire-kb-browser (when (fire:open-kb? fire:*kb*) (fire-kb-browser:browse-fire-kb))
  nil)

(defun expression-editor-ok-button-on-change (ok-button new-value old-value)
  (declare (ignore new-value old-value))
  (let ((editor-popup (cg:parent ok-button)))
    ;; set the read only attribute back to T for the next time we open this popup
    ;;  since it's not actually closed, but hidden instead
    (setf (cg:read-only (expression-editor-expression-box editor-popup)) t)
  
    (cg:flag-modal-completion editor-popup 
                              (expression-editor-expression editor-popup)))
  t) 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Expression Editor Window Creation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun make-expression-editor-popup-dialog-items ()
  (list (make-instance 'expression-display :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 88 :left 20 :name
                       :expression-editor-expression :read-only t :tabs
          nil :template-string nil :top 25
          :on-click 'expression-editor-expression-on-click
          :on-set-focus 'expression-editor-expression-on-set-focus
          :up-down-control nil :value "(PRED ARGUMENT)"
          :show-selection-when-unfocused t
          :width 501)
        (make-instance 'common-graphics:single-item-list :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 95 :left 19 :name
                       :expression-editor-completions :on-change
                       'expression-editor-expression-editor-completions-on-change
                       :on-double-click
                       'expression-editor-expression-editor-completions-on-double-click
                       :tabs nil :top 282
          :width 212)
        (make-instance 'common-graphics:editable-text :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
          :left 19 :name :expression-editor-element
          :delayed nil
                       :on-change
                       'expression-editor-expression-editor-element-on-change
                       :template-string nil :top 252 :up-down-control
                       nil :value "" :width 212)
        (make-instance 'common-graphics:button :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 19 :left 142 :name :assign-elem
                       :on-change
                       'expression-editor-assign-elem-on-change :title
                       "Assign Element" :top 177 :width 90)
        (make-instance 'common-graphics:combo-box :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 152 :left 20 :name
                       :expression-editor-element-combo :on-change
                       'expression-editor-element-combo-on-change
                       :range '(:main-expression) :top 148 :value
                       :main-expression :width 150)
        (make-instance 'common-graphics:button :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
          :height 19 :left 177 :name :erase 
          :on-change 'expression-editor-erase-on-change
          :title "Erase" :top 148
          :width 55)
        
        (make-instance 'cg:radio-button 
          :name :predicate-elem 
          :font (common-graphics:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Predicate" 
          :value t 
          :cluster 'element-type-cluster
          :on-change 'expression-editor-predicate-elem-on-change
          :left 20 
          :top 200
          :width 66)
        (make-instance 'cg:radio-button 
          :name :individual-elem 
          :font (common-graphics:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Individual" 
          :cluster 'element-type-cluster
          :on-change 'expression-editor-individual-elem-on-change
          :left 95 
          :top 200 
          :width 74)
        (make-instance 'cg:radio-button
          :name :collection-elem 
          :font (common-graphics:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Collection" 
          :cluster 'element-type-cluster
          :on-change 'expression-editor-collection-elem-on-change
          :left 169 
          :top 200 
          :width 74)
        (make-instance 'cg:radio-button 
          :name :variable-elem 
          :font (common-graphics:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Variable" 
          :cluster 'element-type-cluster
          :on-change 'expression-editor-variable-elem-on-change 
          :left 20 
          :top 218 
          :width 63)

        
        (make-instance 'cg:lisp-group-box
                       :contained-widgets
                       '(:expression-editor-expression) :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 118 :left 10 :name :lisp-group-box-6
                       :title "New Statement" :top 7 :width 522)
        (make-instance 'cg:button :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 19 :left 20 :name :assign-expr
                       :on-change
                       'expression-editor-assign-expr-on-change :title
                       "Assign Expression" :top 177 :width 107)
        (make-instance 'cg:lisp-group-box
                       :contained-widgets
                       '(:expression-editor-completions
                         :expression-editor-element :button7
                         :expression-editor-element-combo :button9
                         :static-text-10 :radio-button-1
                         :radio-button-2 :radio-button-3 :button10)
                       :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 261 :left 10 :name :lisp-group-box-3
                       :title "Statement Elements" :top 125 :width 238)
        (make-instance 'cg:rich-edit
                       :background-color common-graphics:light-gray
                       :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 237 :left 264 :name
                       :element-information-text-box :read-only t :tabs
                       nil :template-string nil :top 140
                       :up-down-control nil :value
                       "Element information will be displayed here."
                       :width 257)
        (make-instance 'cg:lisp-group-box
                       :contained-widgets
                       '(:multi-line-editable-text-2) :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 261 :left 257 :name :lisp-group-box-7
                       :title "Info" :top 125 :width 274)
        (make-instance 'cg:button :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 21 :left 359 :name :ok-button :on-change
                       'expression-editor-ok-button-on-change :title
                       "Ok" :top 391)
        (make-instance 'cg:cancel-button :font
                       (common-graphics:make-font-ex nil
                         "Tahoma / ANSI" 11 nil)
                       :height 21 :left 450 :name :cancel-button :top
                       391)
        (make-instance 'cg:button 
          :name :advanced 
          :font (common-graphics:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Advanced"
          :on-change 'expression-editor-advanced-on-change 
          :left 271 
          :top 391
          :height 21 
          :tooltip "Switch to Advanced mode"
          :help-string "Makes the New Statement Edit window directly editable - WARNING you cannot switch back from advanced")
        (make-instance 'cg:button 
          :name :browse-kb 
          :font (common-graphics:make-font-ex nil "Tahoma / ANSI" 11 nil)
          :title "Browse KB"
          :on-change 'expression-editor-browse-kb-on-change 
          :left 185 
          :top 391
          :height 21 
          :tooltip "Browse Current KB")
        ))

  
(defun initialize-expression-editor (expr text-dialog editor-popup)
  (declare (ignore text-dialog))
  (clear-expression editor-popup)
  (when expr
    (let ((editor-expr (make-editor-expression expr)))
      (setf (expression editor-popup) editor-expr)
      (setf (cg:value (expression-editor-expression-box editor-popup))
        (pprint-form (expression editor-expr)))
      (when (expr-slots editor-expr)
        (setf (cg:range (expression-editor-expr-element-combo editor-popup))
          (append (cg:range (expression-editor-expr-element-combo editor-popup))
                  (mapcar 'first (expr-slots editor-expr))))))))


(defun make-expression-editor-popup (&optional (owner (cg:screen cg:*system*)) (form-p nil))
  (let* ((pop-up? (not form-p))
         (expr-editor-popup (cg:make-window :expression-editor-popup
                              :owner owner
                              :calling-window owner
                              :class 'expression-editor-popup
                              :background-color (cg:background-color owner)
                              :title "Create or Edit an expression"
                              :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
                              :status-bar t
                              :dialog-items (make-expression-editor-popup-dialog-items)
                              
                              :width 547
                              :height 461
                              
                              :path #p"D:\\QRG\\FIRE\\V1\\case-manager\\case-viewer\\text-display-and-edit\\expression-editor-popup.lsp"
                              :form-p form-p
                              :package-name :textual-case-display
                              )))
    (let ((stat-bar (cg:make-window :status-bar :owner expr-editor-popup
                      :owner nil
                      :class 'cg:common-status-bar
                      :parts nil
                      :minimum-height 0)))
      stat-bar)
    expr-editor-popup))



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





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