(in-package "KPML")

;;; File: utilities.lisp
;;;
;;; Contains general utility functions that do not depend on particular
;;; forms of the interface...

(defun MAKE-EXAMPLE-RESULTS-FILENAME ()
  (multiple-value-bind 
   (second minute hour date month year) 
   (get-decoded-time)
   (format nil "eg-runner-~2,'0D~2,'0D~2,'0D-~2,'0D~2,'0D~2,'0D.text" 
	   year month date hour minute second)))
  
(defun SET-ENVIRONMENT-DIRECTORIES 
  (&optional
     (stream  (clim::frame-top-level-sheet clim:*application-frame*)))
  (unless *root-of-resources*                            ;; 3.2 stops bombs
    (setf *root-of-resources* *base-default-directory*))
  (unless *local-root-of-resources*
    (setf *local-root-of-resources* *root-of-resources*))
  (clim:accepting-values
      (stream :own-window kpml-i::*own-window*
	      :resynchronize-every-pass t
	      :label "Environment directories" :exit-boxes 
	      '((:exit "Click here when selection complete")
		(:abort "Click here to cancel")))
     
     (setf *root-of-resources*
       (coerce-directory
	(clim:accept 'clim:pathname :stream stream
                     #+lispworks :view #+lispworks clim:+textual-dialog-view+
		     :prompt "Root of resources         ............"
		     :default *root-of-resources*)))
     ;; 0.7.33 : also update the user package variable...
     (setf common-lisp-user::*root-of-resources* *root-of-resources*)
     (kpml-i-terpri stream)
     
     ;; 2.0.50
     (setf *local-root-of-resources*
       (coerce-directory
	(clim:accept 'clim:pathname :stream stream
                     #+lispworks :view #+lispworks clim:+textual-dialog-view+
		     :prompt "Local root of resources  ............"
		     :default *local-root-of-resources*)))
     (kpml-i-terpri stream)     
     
     (setf kpml-i::*default-kpml-hardcopy-directory* 
       (clim:accept 'clim:pathname :stream stream
		    :prompt "Directory for hardcopies  ............"
		    #+lispworks :view #+lispworks clim:+textual-dialog-view+
		    :default kpml-i::*default-kpml-hardcopy-directory* ))
     (kpml-i-terpri stream)
     
     (setf *merging-trace-records*
	   (clim:accept 'clim:pathname :stream stream
                        #+lispworks :view 
			#+lispworks clim:+textual-dialog-view+
			:prompt "Merging results directory  ............"
			:default *merging-trace-records*))
     (kpml-i-terpri stream)
     
     (setf *example-runner-results*
	   (clim:accept 'clim:pathname :stream stream
                        #+lispworks :view 
			#+lispworks clim:+textual-dialog-view+
			:prompt "Example runner results directory......"
			:default *example-runner-results*))
     (kpml-i-terpri stream)
     #+lispworks(kpml-i::dialog-end-spacing)
     )
    )

;;; ----------------------------------------------------------------------

(defun TRUNCATE-STRING (string truncate-at)
  (if (> (length string) truncate-at)
      (subseq string 0 truncate-at)
      string))

;;; ----------------------------------------------------------------------
;;; 
(defun GIVE-KPML-MESSAGE-OF-THE-DAY ()
  (when *motd*
    (cond ((stringp *motd*)
	   (clim:notify-user kpml-i::*resource-manager-frame* *motd*))
	  ((symbolp *motd*)
	   (if (boundp *motd*)
	       (clim:notify-user kpml-i::*resource-manager-frame* 
				 (symbol-value *motd*))
	     nil)))))


;;; ----------------------------------------------------------------------
;;; Odds and ends for example record displays...
;;;
(defvar *example-constituent-display-mode* nil)   ;; 4.0

(defmethod FUNDLE-DISPLAY-METHOD (fundle stream mode)
  (unless kpml-i::*show-cycle-numbers-in-graph*
    (setf fundle (mapcar #'remove-fn-tag fundle)))
  (case kpml-i::*hardcopy-structure-orientation*
	(:vertical
	 (let ((output-string nil))
	   (dolist (fn fundle)
		   (if output-string
		       (setq output-string 
			     (substitute #\newline #\space
					 (format nil "~a/ ~a" output-string fn)))
		     (setq output-string (format nil "~a" fn))))
	   (format stream "~a" output-string)))
	  (:horizontal
	   (format stream "~a" (kpml::function-pack fundle)))))

;;; 4.0 and some new ones...

(defmethod FUNDLE-DISPLAY-METHOD-NEW (fundle features stream mode) 
  (fundle-display-method fundle stream mode))

(defmethod FUNDLE-DISPLAY-METHOD-NEW (fundle features stream (mode (eql :selexp)))
  (let ((kpml-i::*feature-lists-in-structure-graph-width* 45)
	(kpml-i::*structure-details-font* kpml-i::*sans-serif--bold--8*))
    (declare (special kpml-i::*feature-lists-in-structure-graph-width*
		      kpml-i::*structure-details-font*))
  (unless kpml-i::*show-cycle-numbers-in-graph*
    (setf fundle (mapcar #'remove-fn-tag fundle)))
  (case kpml-i::*hardcopy-structure-orientation*
	(:vertical
	 (let ((output-string nil))
	   (dolist (fn fundle)
		   (if output-string
		       (setq output-string 
			     (substitute #\newline #\space
					 (format nil "~a/ ~a" output-string fn)))
		     (setq output-string (format nil "~a" fn))))
	   (format stream "~a" output-string)
           (when features
	     (kpml-i::print-small-list-of-features 
	      (if (consp features) features
	        (list features))
	      stream clim:+red+ 8))
	   ))
	  (:horizontal
	   (format stream "~a" (kpml::function-pack fundle))))))

