;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: GARNETDRAW; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; This file contains the load gadget.  The functions for this gadget
;;; can be found in the save-load-functions.lisp file.
;;;
;;; Designed and Implemented by Rajan Parthasarathy
;;;

;;; Change log:
;;;
;;; 03/25/93  Andrew Mickish - Removed extra quote from Default-Load-Function
;;; 01/30/93  Rajan Parthasarathy - s-value'd the :initialize slot
;;; 12/14/92  Andrew Mickish - Added type and parameter declarations
;;; 06/26/92  Rajan Parthasarathy - Created
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "GARNET-GADGETS" :use '("LISP" "KR"))

(export '(LOAD-GADGET))

(create-instance 'LOAD-GADGET opal:aggregadget
  :declare ((:parameters :parent-window :window-title :window-left :window-top
			 :min-gadget-width :initial-directory :message-string
			 :button-panel-items :button-panel-h-spacing
			 :num-visible :check-filenames-p :modal-p
			 :dir-input-field-font :dir-input-label-font
			 :file-input-field-font :file-input-label-font
			 :message-font :button-panel-font :file-menu-font
			 :selection-function)
	    (:type ((or (is-a-p inter:interactor-window) null) :parent-window)
		   ((or null string) :window-title)
		   (integer :window-left :window-top :button-panel-h-spacing)
		   ((integer 0) :min-gadget-width :num-visible)
		   (string :initial-directory :message-string)
		   (list :button-panel-items)
		   (kr-boolean :check-filenames-p :modal-p)
		   ((or null function symbol) :selection-function)
		   ((or (is-a-p opal:font) (is-a-p opal:font-from-file))
		    :dir-input-field-font :dir-input-label-font
		    :file-input-field-font :file-input-label-font
		    :message-font :button-panel-font :file-menu-font))
	   (:maybe-constant :left :top :parent-window :window-title :window-left
		     :window-top :dir-input-field-font :dir-input-label-font
		     :message-font :message-string :num-visible :file-menu-font
		     :initial-directory :file-input-field-font
		     :file-input-label-font :button-panel-items
		     :button-panel-font :button-panel-h-spacing
		     :min-gadget-width :modal-p :check-filenames-p))
;;; Customizable slots
  (:LEFT 10)
  (:TOP 24)
  (:PARENT-WINDOW NIL)
  
  ;; Slots for window customization
  (:WINDOW-TITLE "Load Window")
  (:WINDOW-TOP (o-formula (if (gvl :parent-window)
			       (floor (- (gvl :parent-window :height)
					 (gvl :window :height)) 2)
			       0)))
  (:WINDOW-LEFT (o-formula (if (gvl :parent-window)
			      (floor (- (gvl :parent-window :width)
					(gvl :window :width)) 2)
			      0)))

  ;; Slots for dir-input customization
  (:DIR-INPUT-FIELD-FONT (opal:get-standard-font NIL NIL :small))
  (:DIR-INPUT-LABEL-FONT (opal:get-standard-font NIL :BOLD NIL))
   
  ;; Slots for message customization
  (:MESSAGE-FONT (OPAL:GET-STANDARD-FONT :FIXED :ITALIC :SMALL))
  (:MESSAGE-STRING "Fetching directory...")

  ;; Slots for file-menu customization
  (:NUM-VISIBLE 6)
  (:FILE-MENU-FONT (opal:get-standard-font NIL :BOLD NIL))
  (:INITIAL-DIRECTORY "./")
   
  ;; Slots for file-input customization
  (:FILE-INPUT-FIELD-FONT (opal:get-standard-font NIL NIL :small))
  (:FILE-INPUT-LABEL-FONT (opal:get-standard-font NIL :BOLD NIL))
   
  ;; Slots for button customization
  (:BUTTON-PANEL-ITEMS '("Load" "Cancel"))
  (:BUTTON-PANEL-FONT OPAL:DEFAULT-FONT)
  (:BUTTON-PANEL-H-SPACING 25)

  ;; Other slots
  (:MIN-GADGET-WIDTH 240)
  (:MODAL-P NIL)
  (:SELECTION-FUNCTION NIL)
  (:CHECK-FILENAMES-P T)
  
;;; Non customizable slots
  (:destroy #'Save-Load-Gadget-Destroy)
  (:parts `(

;;; This is the box labeled "Directory"
    (:DIR-INPUT ,GARNET-GADGETS:SCROLLING-LABELED-BOX
      (:LEFT ,(o-formula (gvl :parent :left) 10))
      (:TOP ,(o-formula (gvl :parent :top) 24))
      (:WIDTH ,(o-formula (gvl :parent :min-gadget-width) 240))
      (:MIN-FRAME-WIDTH NIL)
      (:FIELD-FONT ,(o-formula (gvl :parent :dir-input-field-font)))
      (:FIELD-OFFSET 0)
      (:LABEL-OFFSET 5)
      (:LABEL-FONT ,(o-formula (gvl :parent :dir-input-label-font)))
      (:GROW-P T)
      (:LABEL-STRING "Directory:")
      (:VALUE ,(o-formula (directory-namestring
			   (truename (gvl :parent :initial-directory)))))
      (:SELECTION-FUNCTION Update-File-Menu))

;;;  This is the scrolling menu with a list of files in it
	    
    (:FILE-MENU ,GARNET-GADGETS:SCROLLING-MENU
      (:TOGGLE-P NIL)
      (:FINAL-FEEDBACK-P NIL)
      (:MAX-ITEM-WIDTH ,(o-formula (gvl :min-frame-width)))
      (:LEFT ,(o-formula (+ (gvl :parent :left) 22) 32))
      (:TOP ,(o-formula (+ (gvl :parent :dir-input :top)
			   (gvl :parent :dir-input :height)
			   20)))
      (:INDICATOR-FONT ,(create-instance nil OPAL:FONT
            (:SIZE :SMALL)))
      (:MULTIPLE-P T)
      (:PAGE-INCR 5)
      (:SCR-INCR 1)
      (:SCROLL-SELECTION-FUNCTION NIL)
      (:MENU-SELECTION-FUNCTION file-menu-selection)
      (:H-ALIGN :LEFT)
      (:SCROLL-ON-LEFT-P T)
      (:MIN-FRAME-WIDTH ,(o-formula (- (gvl :parent :min-gadget-width) 60)))
      (:TEXT-OFFSET 4)
      (:INT-MENU-FEEDBACk-P T)
      (:ITEM-FONT ,(o-formula (gvl :parent :file-menu-font)))
      (:V-SPACING 3)
      (:MIN-SCROLL-BAR-WIDTH 20)
      (:INDICATOR-TEXT-P NIL)
      (:PAGE-TRILL-P NIL)
      (:SCR-TRILL-P T)
      (:NUM-VISIBLE ,(o-formula (gvl :parent :num-visible)))
      (:INT-SCROLL-FEEDBACK-P NIL)
      (:TITLE NIL)
      (:SELECTED-RANKS NIL))

;;; This is the box that says "Filename"
	    
    (:FILE-INPUT ,GARNET-GADGETS:SCROLLING-LABELED-BOX
      (:LEFT ,(o-formula (gvl :parent :left)))
      (:TOP ,(o-formula (+ (gvl :parent :file-menu :top)
			   (gvl :parent :file-menu :height)
			   20)))
      (:WIDTH ,(o-formula (gvl :parent :min-gadget-width) 240))
      (:CONSTANT (:KNOWN-AS :COMPONENTS :FIELD-TEXT :FRAME :LABEL-TEXT))
      (:MIN-FRAME-WIDTH NIL)
      (:FIELD-FONT ,(o-formula (gvl :parent :file-input-field-font)))
      (:FIELD-OFFSET 0)
      (:LABEL-OFFSET 5)
      (:LABEL-FONT ,(o-formula (gvl :parent :file-input-label-font)))
      (:GROW-P T)
      (:SELECTION-FUNCTION Check-Load-Filename)
      (:LABEL-STRING "Filename:")
      (:VALUE ""))

;;; This is the little message that appears everytime a directory is being
;;; fetched	    
	   
    (:MESSAGE ,OPAL:TEXT
      (:LEFT ,(o-formula (+ (gvl :parent :left) 20) 30))
      (:TOP ,(o-formula (+ (gvl :parent :top) 20) 44))
      (:FONT ,(o-formula (gvl :parent :message-font))))

;;; These are the two buttons for load and cancel
	    
    (:OK-CANCEL-BUTTONS ,GARNET-GADGETS:TEXT-BUTTON-PANEL
     (:CONSTANT (:KNOWN-AS :COMPONENTS :TEXT-BUTTON-PRESS :FINAL-FEEDBACK
			    :TEXT-BUTTON-LIST))
     (:left ,(o-formula (floor (- (gvl :parent :min-gadget-width)
				  (gvl :width)) 2)))
     (:top ,(o-formula
	     (let ((comps (gvl :parent :components))
		   (me (gvl :parent :ok-cancel-buttons))
		   (maxbot 0))
	       (dolist (ob comps)
		 (when (and (not (equal ob me))
			    (> (opal:bottom ob)
			       maxbot))
		   (setf maxbot (opal:bottom ob))))
	       (+ maxbot 25))))
	   
     (:SELECTION-FUNCTION default-load-function)
     (:FONT ,(o-formula (gvl :parent :button-panel-font)))
     (:H-ALIGN :CENTER)
     (:PIXEL-MARGIN NIL)
     (:RANK-MARGIN NIL)
     (:FIXED-HEIGHT-P T)
     (:FIXED-WIDTH-P T)
     (:INDENT 0)
     (:V-SPACING 5)
     (:H-SPACING ,(o-formula (gvl :parent :button-panel-h-spacing)))
     (:DIRECTION :HORIZONTAL)
     (:SHADOW-OFFSET 5)
     (:TEXT-OFFSET 2)
     (:FINAL-FEEDBACK-P NIL)
     (:GRAY-WIDTH 3)
     (:ITEMS ,(o-formula (gvl :parent :button-panel-items)))))))

(s-value load-gadget :initialize #'Save-Load-Gadget-Initialize)
