(defpackage setup (:use xlisp))

(in-package setup)

(defvar *progman-available*
        (let ((conv (dde-connect "progman")))
          (if conv (dde-disconnect conv))
          conv))

(defproto preference-item-proto 
  '(section name default) () edit-text-item-proto)

(defmeth preference-item-proto :isnew (section name default &rest args)
  (setf (slot-value 'section) section)
  (setf (slot-value 'name) name)
  (setf (slot-value 'default) default)
  (apply #'call-next-method default args))

(defmeth preference-item-proto :configure ()
  (msw-write-profile-string (slot-value 'section)
                            (slot-value 'name)
                            (send self :text)
                            #+win32 "wxls32.ini"
                            #-win32 "wxls.ini"))

(defproto directory-item-proto () () preference-item-proto)

(defmeth directory-item-proto :isnew ()
  (call-next-method "Xlisp" 
                    "Libdir"
                    (get-working-directory)
                    :text-length 25))


(defproto font-name-item-proto () () preference-item-proto)

(defmeth font-name-item-proto :isnew (section &optional 
                                              (font "Courier New")
                                              (size 16))
  (call-next-method section "Font" font :text-length size))

(defproto font-size-item-proto () () preference-item-proto)

(defmeth font-size-item-proto :isnew (section &optional (size 12))
  (call-next-method section "FontSize" (format nil "~d" size)))

(defmeth font-size-item-proto :configure ()
  (let ((n (read-from-string (send self :text) nil)))
    (unless (integerp n)
            (send self :text (slot-value 'default)))
    (call-next-method)))

(defproto progman-item-proto () () edit-text-item-proto)

(defmeth progman-item-proto :exec (&rest args)
  (let ((conv (dde-connect "progman")))
   (when conv 
         (unwind-protect
          (dde-client-transaction conv :data (apply #'format nil args))
          (dde-disconnect conv)))))

(defproto progman-group-item-proto () () progman-item-proto)

(defun progman-group-exists (group)
  (let ((conv (dde-connect "progman")))
   (when conv 
         (unwind-protect
          (dde-client-transaction conv :type :request :item group)
          (dde-disconnect conv)))))


(defmeth progman-group-item-proto :configure ()
  (let ((group (send self :text)))
    (when (progman-group-exists group)
          (let ((delete (ok-or-cancel-dialog
                         (format nil "Delete existing ~a group?"
                                 group))))
            (if delete
                (send self :exec "[DeleteGroup(~a)]" group)
                (throw 'cancel nil)))))
  (send self :exec "[CreateGroup(~a)]" (send self :text)))

(defproto progman-program-item-proto
 '(application directory icon x y) () progman-item-proto)

(defmeth progman-program-item-proto :isnew (n a d i x y)
  (setf (slot-value 'application) a)
  (setf (slot-value 'directory) d)
  (setf (slot-value 'icon) i)
  (setf (slot-value 'x) x)
  (setf (slot-value 'y) y)
  (call-next-method n))

(defmeth progman-program-item-proto :configure ()
  (let* ((dir (send (slot-value 'directory) :text))
         (app (slot-value 'application))
         (file (format nil "~a\\~a" dir app)))
    (send self :exec "[AddItem(~a,~a,~a,~d,~d,~d,~a)]"
          file
          (send self :text)
          file
          (slot-value 'icon)
          (slot-value 'x)
          (slot-value 'y)
          (send (slot-value 'directory) :text))))

(let* ((list-font-size 12)
       (graph-font-size 12)
       (dir-item (send directory-item-proto :new))
       (list-font-item (send font-name-item-proto :new "Listener"))
       (list-font-size-item (send font-size-item-proto :new "Listener"))
       (graph-font-item (send font-name-item-proto :new "Graphics"))
       (graph-font-size-item (send font-size-item-proto :new "Graphics"))
       (progman-item (send toggle-item-proto :new
                           "Add Group and Items to Program Manager"
                           :value t))
       (group-name-item (send progman-group-item-proto :new
                              (format nil "XLISP-STAT ~d.~d~a"
                                      xls-major-release
                                      xls-minor-release
                                      #+win32 " - Win32"
                                      #-win32 "")))
       (xls-name-item (send progman-program-item-proto :new
                            "XLISP-STAT"
                            #+win32 "WXLS32.EXE"
                            #-win32 "WXLS.EXE"
                            dir-item 2 30 20))
       (lspedit-name-item (send progman-program-item-proto :new
                                "Lsp Edit" "LSPEDIT.EXE"
                                dir-item 0 90 20)))
  (flet ((configure ()
           (catch 'cancel
                  (send dir-item :configure)
                  (send list-font-item :configure)
                  (send list-font-size-item :configure)
                  (send graph-font-item :configure)
                  (send graph-font-size-item :configure)
                  (when (and *progman-available*
                             (send progman-item :value))
                        (send group-name-item :configure)
                        (send xls-name-item :configure)
                        (send lspedit-name-item :configure)))
           (msw-exit))
         (quit () (msw-exit)))
    (let ((pref-items (list (list "Startup Directory:" dir-item)
                            (list
                             (list
                              (list "Listener Font:" list-font-item)
                              (list "Graphics Font:" graph-font-item))
                             (list
                              (list "Size:" list-font-size-item)
                              (list "Size:" graph-font-size-item)))))
          (pm-items (list progman-item
                          (list "Program Group Name:" group-name-item)
                          (list (format nil "Program Item Name for ~a:"
                                        #+win32 "WXLS32.EXE"
                                        #-win32 "WXLS.EXE")
                                xls-name-item)
                          (list "Program Item Name for LSPEDIT.EXE:"
                                lspedit-name-item)))
          (buttons (list (list (send button-item-proto :new
                                     "Configure and Quit"
                                     :action #'configure)
                               (send button-item-proto :new
                                     "Quit"
                                     :action #'quit)))))
    (send dialog-proto :new
          (append pref-items
                  (if *progman-available* pm-items)
                  buttons)    
          :title "XLISP-STAT Setup"
          :location '(0 0)))))

(unless (probe-file "Data\\absorbtion.lsp")
	;; looks like a system that supports long file names -- rename
        ;; some files in Data and Examples.
	(rename-file "Data\\absorbti.lsp" "Data\\absorbtion.lsp")
	(rename-file "Data\\car-pric.lsp" "Data\\car-prices.lsp")
	(rename-file "Data\\metaboli.lsp" "Data\\metabolism.lsp")
	(rename-file "Data\\puromyci.lsp" "Data\\puromycin.lsp")
	(rename-file "Data\\stacklos.lsp" "Data\\stackloss.lsp")
	(rename-file "Examples\\abrasion.lsp" "Examples\\abrasiondemo.lsp")
	(rename-file "Examples\\addhandr.lsp" "Examples\\addhandrotate.lsp")
	(rename-file "Examples\\dataprot.lsp" "Examples\\dataprotos.lsp")
	(rename-file "Examples\\plotcont.lsp" "Examples\\plotcontrols.lsp")
	(rename-file "Examples\\rotatede.lsp" "Examples\\rotatedemo.lsp")
	(when (probe-file "xlsclien.exe")
	  (rename-file "xlsclien.exe" "xlsclient.exe")))