;; -*- Mode: lisp -*-

(in-package :clim-launcher)

(define-application-frame launcher ()
  () ;; no slots
  ;; options
  (:panes (application :application
		       :display-function #'display-commands
		       :display-after-commands nil
                       :width 200))
  (:layouts
   (defaults application)))

(define-launcher-command (com-exit :name "Exit" ;; :menu t
                          :keystroke (#\x))
    ()
  (frame-exit *application-frame*))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *applications* nil))

(defclass clim-application ()
  ((name :initarg :name :accessor application-name :initform "")
   (function :initarg :function :accessor application-function
             :initform (lambda (x) (format t "~A was called~%" x)))))

(defun slot-value-or-something (object &key (slot 'name) (something "without name"))
  (if (slot-boundp object slot)
      (slot-value object slot)
      something))

(defmethod print-object ((application clim-application) stream)
  (print-unreadable-object (application stream :type t)
    (write-string (slot-value-or-something application) stream)))

(defmethod display-commands ((frame launcher) stream) 
  (loop for application in *applications*
     do (present application 'clim-application :stream stream)))

(define-presentation-method present
    (application (type clim-application) stream (view textual-view) &key)
  (stream-increment-cursor-position stream 3 4)
  (surrounding-output-with-border (stream :shape :drop-shadow :move-cursor nil)
    (format stream "~23,A~%" (application-name application)))
  (stream-increment-cursor-position stream 0 8))

(define-launcher-command com-launch-application
    ((applicationl 'clim-application))
  (funcall (application-function applicationl)))

(define-presentation-to-command-translator launch-application
    (clim-application com-launch-application launcher
	      :gesture :select)
    (object) (list object))

(defun delete-application (name)
  (setf *applications*
        (delete name *applications*
                :key #'application-name
                :test #'string-equal)))
  
(defun add-application (name function)
  (delete-application name) ;; No, pushnew doesn't do the right thing.
  (setf *applications*
        (append *applications*
                (list (make-instance 'clim-application :name name
                                                       :function function))))
  #+nil (push (make-instance 'clim-application :name name :function function)
              *applications*))

;;; (defun start ()
;;;    #+:cmucl (multiprocessing::startup-idle-and-top-level-loops)
;;;   (run-frame-top-level (make-application-frame 'clim-launcher::launcher)))

(climi::define-application-starter launcher
                                   :function-name start
                                   :default-process-name "CLIM Launcher"
                                   :announce-to-clim-launcher nil)

(add-application "Exit Launcher" #'com-exit)

;;; These forms should be moved to the corresponding packages.
(add-application "Listener" (lambda () (clim-listener:run-listener :new-process t)))
(add-application "Closure"  #'closure:start)
(add-application "Beirc"  #'beirc:beirc)
;;; (add-application "climacs" (lambda () (climacs-gui::climacs :new-process t)))
(add-application "Clouseau" (lambda () (clouseau:inspector :object t :new-process t)))