(in-package "KPML-I")

(defun STARTUP-USED-FEATURES-TOOL (window
                                        &key 
                                        (incomplete-p nil)
                                        (reuse *re-use-selexpression-window*)
                                        (reset *reset-selection-tool*))
  (let ((label "features used")
	(whereami nil)                 
        (selexpr *cumulative-features-used*)
        (origin nil)
        (preselections nil)
        (reset-required (if (and *selexpression-frame*
				 (eq (clim:frame-state *selexpression-frame*) :disabled))
                            T
                          reset)))

    (startup-selexpression-tool-internal
     label 
     (let ((clim:*application-frame* window))
       (declare (special clim:*application-frame*))
       "node") selexpr origin whereami nil nil nil nil)))


;;; this needs to be changed so that the features shown are the complement
;;; with respect to (features-of-region) that are shown.

(defmethod SELECTION-EXPRESSION-DISPLAY ((frame selection-expression-frame) stream)
  (with-slots 
      (label selexpr incomplete-p selexpr-region-width features-size 
             hidden-metafunction-list preselections)
      frame
    (clim:with-output-recording-options (stream :record T)
      (let* ((selexpr2 (if *selexpr-show-gates*
                           (remove 'kpml::start selexpr)
                         (delete-if #'(lambda (f)
                                        (kpml::gate-p
                                         (first (kpml::who-has-as-output f))))
                                    (copy-list (remove 'kpml::start selexpr)))))
             (region->features (make-hash-table))
             (metafunctions nil)
             (metafunctions->regions (make-hash-table))
             (regions 
              (remove-duplicates
               (loop for f in selexpr2
                     as s = (first (kpml::who-has-as-output f))
                     as r = (kpml::fetch-system-region s)
                     as m = (kpml::fetch-system-metafunction s)
                     collect r
                     do
                     (if (gethash r region->features)
                         (push f (gethash r region->features))
                       (setf (gethash r region->features) (list f)))
                     (pushnew m metafunctions)
                     (if (gethash m metafunctions->regions)
                         (push r (gethash m metafunctions->regions))
                       (setf (gethash m metafunctions->regions) (list r)))))))
        
        (loop for m in (sort metafunctions #'string<)
              as regions = (let ((regions
				  (remove-duplicates 
				   (gethash m metafunctions->regions))))
			     (if *regions-shown-alphabetic*
				 (sort regions #'string<)
			       regions))
              as color = (if *selexpr-in-color*
                             (symbol-value
                              (cdr (assoc (if (member m (mapcar #'car *metafunction-colour-map*))
                                              m :other)
                                          *metafunction-colour-map*)))
                           clim:+black+)
              unless (member m hidden-metafunction-list)
              do
              (clim:with-output-as-presentation (stream m 'metafunction)
                (format stream "~2%~20A~40T" m))
              (clim:with-drawing-options (stream :ink color)
              (clim:formatting-table (stream :move-cursor T :x-spacing 6 :y-spacing 15)
                (loop while regions do
                      (clim:formatting-row (stream)
                        (loop for region-count from 1 to selexpr-region-width
                              while regions
                              do
                              (let ((r (pop regions)))
                                (clim:formatting-cell (stream)
                                  (clim:surrounding-output-with-border 
                                      (stream :shape :rectangle)
                                    (clim:with-text-size (stream (1+ features-size))
                                      (if r 
                                          (clim:with-output-as-presentation 
                                              (stream r 'kpml-i::region)
                                            (format stream "~%Region: ~A  ~25T" r))
                                        (format stream "~%Unassigned to any region were:")))
                                    (clim:with-text-style (stream *structure-details-font*)
                                      (clim:with-text-size (stream features-size)
                                        (loop for f 
                                              in (let ((features (gethash r region->features)))
                                                   (if *features-shown-alphabetic*
                                                       (sort features #'string<)
                                                     (reverse features)))
                                              do
                                              (clim:with-output-as-presentation 
                                                  (stream f 'kpml-i::feature)
                                                (if (member f preselections)
                                                    (clim:with-text-size
                                                     (stream :larger)
                                                     (clim:with-text-face 
                                                         (stream '(:italic :bold))
                                                       (format stream "~%~(~a~)" f)))
                                                  (format stream "~%~(~a~)" f)
                                                  ))))))))))))))))))