;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: case-management-interface.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: July 26, 2002 10:27:58
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Saturday, May 10, 2003 at 14:13:14 by nicholson
;;;; ---------------------------------------------------------------------------

(in-package :textual-case-display)


(defun deselect-selected-facts (casename reasoner &key (selection-list nil) (deselect-all? nil))
  "If deselect-all? is TRUE it will delete all currently selected case facts (entities and expressions).
    Otherwise it will only deselect those facts in the selection-list."
  (when casename
    (let ((currently-selected (fire::currently-selected-case-facts casename :reasoner reasoner 
                                                                   :retrieve-all? deselect-all?
                                                                   :selection-list (mapcar #'fact selection-list))))
      (dolist (fact currently-selected)
        (fire::deselect-case-fact casename fact :reasoner reasoner)))))



(defun select-fact (text-display datum &key (selection-list nil) (deselect-others? nil))
  "If deselect-others is true all other selected facts in the selection-list will be deselected."
  (when deselect-others?
    (deselect-selected-facts (fire-case-viewer::case-name text-display) 
                             (fire-case-viewer::reasoner text-display) 
                             :selection-list selection-list
                             :deselect-all? nil))
  (fire::select-case-fact (fire-case-viewer::case-name text-display) datum 
                          :reasoner (fire-case-viewer::reasoner text-display)))


(defun toggle-select-fact (text-display datum &key (selection-list nil) (deselect-others? t))
  "If deselect-others is true all other selected facts in the selection-list will be deselected.
    Returns true if we selected the fact, false if we deselected it."
  (let ((casename (fire-case-viewer::case-name text-display))
        (reasoner (fire-case-viewer::reasoner text-display)))
    (cond ((fire::case-fact-selected? datum :case-name casename :reasoner reasoner)
           (fire::deselect-case-fact casename datum :reasoner reasoner)
           (when deselect-others?
             (deselect-selected-facts casename reasoner :selection-list selection-list
                                      :deselect-all? nil))
           nil)
          (t
           (select-fact text-display datum :selection-list selection-list 
                        :deselect-others? deselect-others?)
           t))))





(defmethod filter-individuals (indv) (declare (ignore indv)) t)
(defmethod filter-expressions (expr) (declare (ignore expr)) t)


(defmethod get-case-individuals ((disp t) &key (filter #'filter-individuals))
  (declare (ignore filter))
  nil)

(defmethod get-case-individuals ((text-display text-case-display) 
                                 &key (filter #'filter-individuals))
  (let ((reasoner (fire-case-viewer::reasoner text-display))
        (casename (fire-case-viewer::case-name text-display)))
    (fire::case-individuals casename :reasoner reasoner :filter filter)))


(defmethod get-case-expressions ((text-display text-case-display) 
                                 &key (filter #'filter-expressions))
  (let ((reasoner (fire-case-viewer::reasoner text-display))
        (casename (fire-case-viewer::case-name text-display)))
    (fire::case-expressions casename :reasoner reasoner :filter filter)))


(defmethod get-type-assignments (indv (text-display text-case-display))
  (mapcar #'(lambda (expr)
              (if (fire:isa-statement? expr)
                (third expr)
                (first expr)))
    (get-case-expressions text-display 
                          :filter #'(lambda (expr)
                                      (and (equal (second expr) indv)
                                           (or (fire:isa-statement? expr)
                                               (eq (fire:predicate-type (first expr)) :attribute)))))))


(defmethod delete-expression (expr (text-display text-case-display))
  (fire::delete-case-fact (fire-case-viewer::case-name text-display) expr 
                          :reasoner (fire-case-viewer::reasoner text-display)))

(defmethod delete-expressions (del-exprs (text-display text-case-display))
  ;; del-exprs is a list of expressions to be deleted
  (dolist (expr del-exprs) 
    (delete-expression expr text-display)))

(defmethod purge-expressions (p-exprs (text-display text-case-display))
  ;; p-indvs is a list of expressions to be purged
  (dolist (expr p-exprs)
    (fire::delete-case-fact (fire-case-viewer::case-name text-display) expr
                            :reasoner (fire-case-viewer::reasoner text-display)
                            :purge? t)))

(defmethod undelete-expressions (undel-exprs (text-display text-case-display))
  ;; undel-exprs is a list of expressions to be undeleted
  (dolist (expr undel-exprs)
    (fire::undelete-case-fact (fire-case-viewer::case-name text-display) expr 
                              :reasoner (fire-case-viewer::reasoner text-display))))

(defun delete-referencing-expressions (indv text-display)
  (let* ((exprs (current-text-display-expressions text-display))
         (exprs-to-delete (remove-if-not #'(lambda (expr)
                                             (member indv 
                                                     (fire::extract-entities-from-expression expr)))
                                         exprs)))
    (delete-expressions exprs-to-delete text-display)))


(defun undelete-referencing-expressions (indv text-display)
  (let* ((exprs (current-text-display-expressions text-display))
         (exprs-to-undelete (remove-if-not #'(lambda (expr)
                                             (member indv 
                                                     (fire::extract-entities-from-expression expr)))
                                         exprs)))
    (undelete-expressions exprs-to-undelete text-display)))


(defun purge-referencing-expressions (indv text-display)
  (let* ((exprs (current-text-display-expressions text-display))
         (exprs-to-purge (remove-if-not #'(lambda (expr)
                                             (member indv 
                                                     (fire::extract-entities-from-expression expr)))
                                         exprs)))
    (purge-expressions exprs-to-purge text-display)
    exprs-to-purge))

(defmethod delete-individuals (del-indvs (text-display text-case-display))
  ;; What does it mean to delete an individual?  In the current implementation
  ;;  this means simply to go through and delete every expression in the working
  ;;  memory that mentions the indv AS AN INDIVIDUAL  (these caps are there to 
  ;;  specifically refer to the situation where the user tries to delete a Collection
  ;;  We don't want to delete every expression that simply mentions it since this
  ;;  will delete every (isa foo Collection)...)
  (dolist (indv del-indvs)
    (fire::delete-case-fact (fire-case-viewer::case-name text-display) indv
                            :reasoner (fire-case-viewer::reasoner text-display))
    (delete-referencing-expressions indv text-display)))


(defmethod purge-individuals (p-indvs (text-display text-case-display))
  ;; p-indvs is a list of individuals to be purged
  (let ((purged-exprs nil))
    (dolist (indv p-indvs)
      (fire::delete-case-fact (fire-case-viewer::case-name text-display) indv
                              :reasoner (fire-case-viewer::reasoner text-display)
                              :purge? t)
      (setq purged-exprs (append purged-exprs
                                 (purge-referencing-expressions indv text-display))))
    purged-exprs))


(defmethod undelete-individuals (undel-indvs (text-display text-case-display))
  ;; undel-indvs is a list of individuals to be undeleted 
  (dolist (indv undel-indvs)
    (fire::undelete-case-fact (fire-case-viewer::case-name text-display) indv
                              :reasoner (fire-case-viewer::reasoner text-display))
    (undelete-referencing-expressions indv text-display)))



(defmethod edit-individuals-spelling (edited (text-display text-case-display))
  (declare (ignore edited))
  )


(defmethod modify-individual-type (indv new-types (text-display text-case-display))
  (declare (ignore indv new-types))
  )


(defmethod modify-individual-types (modified (text-display text-case-display))
  (mapcar #'(lambda (mod-info)
              (modify-individual-type (first mod-info) (second mod-info) text-display))
    modified))



(defmethod add-new-expressions (new-exprs (text-display text-case-display))
  ;; New is a list of expressions to be added
  (dolist (expr new-exprs)
    (fire::add-case-fact (fire-case-viewer::case-name text-display) expr
                         :reasoner (fire-case-viewer::reasoner text-display)))
  (add-text-display-expressions text-display new-exprs))


(defmethod add-new-individuals (new-indvs (text-display text-case-display))
  ;; new-indvs is an alist of (indv type1 type2 type3...)
  (dolist (new-indv-info new-indvs)
    (add-text-display-individuals text-display (list (first new-indv-info)))
    (add-new-expressions (mapcar #'(lambda (indv-type)
                                     (fire:make-isa (first new-indv-info) indv-type))
                           (second new-indv-info))
                         text-display)))


(defmethod indv-collection? (indv)
  (fire:collection? indv :kb fire:*kb*))




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