;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:ZL -*-

;;; WINDOW-MAKER-EXAMPLE

;;; This example contains a flavor definition generated by the window
;;; maker, and then modified to be useful.  My additions are in lower
;;; case.  Use them as a guideline only -- there is no substitute for
;;; reading the Window System Manual!  -KmC

(DEFFLAVOR WM::KMC-FLAVOR ()
 (tv:process-mixin				;Added - very important!
  tv:select-mixin				;Helps with selecting and I/O
  tv:inferiors-not-in-select-menu-mixin		;Good house-keeping - no clutter on Select Menu
  tv:alias-for-inferiors-mixin			;E.g., killing inferior kills whole window
  tv:essential-mouse				;Seems to help...
  tv:bordered-constraint-frame-with-shared-io-buffer	;Instead of TV:CONSTRAINT-FRAME
  tv:top-box-label-mixin			;Puts label on top
  )
  
 (:DEFAULT-INIT-PLIST
   :process '(window-maker-initial-function)	;Added - this defines the top level function
   :label					;Added - a nice big label
   '(:string "Window-Maker Example" :font fonts:metsi :centered)

  :PANES

  '((KMC-LISP TV:LISP-LISTENER
              :BLINKER-DESELECTED-VISIBILITY
              :ON
              :BLINKER-FLAVOR
              TV:RECTANGULAR-BLINKER
              :BLINKER-P
              T
              :DEEXPOSED-TYPEIN-ACTION
              :NORMAL
              :DEEXPOSED-TYPEOUT-ACTION
              :NORMAL
              :LABEL				;modified
              (:string "Command Output Pane" :font fonts:cptfontb)
              :SAVE-BITS
              T)

    (KMC-BIG TV:COMMAND-MENU
             :BLINKER-DESELECTED-VISIBILITY
             :ON
             :BLINKER-FLAVOR
             TV:RECTANGULAR-BLINKER
             :BLINKER-P
             T
             :DEEXPOSED-TYPEIN-ACTION
             :NORMAL
             :DEEXPOSED-TYPEOUT-ACTION
             :NORMAL
             :LABEL				;modified
	     (:string "Commands" :font fonts:cptfontb)
             :SAVE-BITS
             T
             :ITEM-LIST				;modified - an example
	     (("(PRINT-HERALD)"
	       :eval (print-herald)
	       :documentation "Display system run-time and version information")
	      ("(PRINT-DISK-LABEL)"
	       :eval (print-disk-label)
	       :documentation "Display system disk label information")
	      ("Display user-id"
	       :eval (princ si:user-id)
	       :documentation "Display logged-in user identification")))

    (KMC-MESSAGE TV:WINDOW
                 :BLINKER-DESELECTED-VISIBILITY
                 :ON
                 :BLINKER-FLAVOR
                 TV:RECTANGULAR-BLINKER
                 :BLINKER-P nil
                 :DEEXPOSED-TYPEIN-ACTION
                 :NORMAL
                 :DEEXPOSED-TYPEOUT-ACTION
                 :NORMAL
                 :LABEL				;modified
		 (:string "Messages" :font fonts:cptfontb)
                 :SAVE-BITS
                 T)

    (KMC-LITTLE TV:WINDOW
                :BLINKER-DESELECTED-VISIBILITY
                :ON
                :BLINKER-FLAVOR
                TV:RECTANGULAR-BLINKER
                :BLINKER-P nil
                :DEEXPOSED-TYPEIN-ACTION
                :NORMAL
                :DEEXPOSED-TYPEOUT-ACTION
                :NORMAL
                :LABEL
		"This window left blank"
                :SAVE-BITS
                T)

    (KMC-BANNER TV:WINDOW
                 :BLINKER-DESELECTED-VISIBILITY
                 :ON
                 :BLINKER-FLAVOR
                 TV:RECTANGULAR-BLINKER
                 :BLINKER-P nil
                 :DEEXPOSED-TYPEIN-ACTION
                 :NORMAL
                 :DEEXPOSED-TYPEOUT-ACTION
                 :NORMAL
                 :LABEL				;modified
		 (:string "Blips" :font fonts:cptfontb)
                 :SAVE-BITS
                 T))

  :CONSTRAINTS
  '((KMC-CONFIG (DUMMY-NAME24 KMC-LISP)
                ((DUMMY-NAME24 :HORIZONTAL
                               (:EVEN)
                               (DUMMY-NAME40 KMC-BIG)
                               ((DUMMY-NAME40 :VERTICAL
                                              (0.499012s0)
                                              (DUMMY-NAME44 KMC-MESSAGE)
                                              ((DUMMY-NAME44 :HORIZONTAL
                                                             (:EVEN)
                                                             (KMC-BANNER KMC-LITTLE)
                                                             ((KMC-BANNER 0.63763s0))
                                                             ((KMC-LITTLE :EVEN)))
                                               (KMC-MESSAGE :EVEN)))
                                )
                               ((KMC-BIG :EVEN)))
                 (KMC-LISP :EVEN)))))
 :GETTABLE-INSTANCE-VARIABLES
 :SETTABLE-INSTANCE-VARIABLES
 :INITTABLE-INSTANCE-VARIABLES)

(DEFMETHOD (WM::KMC-FLAVOR :AFTER :INIT) (&REST IGNORE)
  (FUNCALL-SELF :SET-SELECTION-SUBSTITUTE
		(FUNCALL-SELF :GET-PANE
			      'kmc-lisp		;this works best
			      )))

;;; Added this function to listen to the command menu.

(defun window-maker-initial-function (window)    
  (let* ((*message-pane (send window :get-pane 'kmc-message))
	 (*banner-pane (send window :get-pane 'kmc-banner))
	 (*ll-pane (send window  :get-pane 'kmc-lisp))
	 (terminal-io *ll-pane)
	 (query-io *ll-pane)
	 (error-output *ll-pane))
    (loop for input = (send *ll-pane ':any-tyi) 
	  do
	  (cond
	    ((fixnump input)
	     (format *banner-pane "~c" input)
	     input)
	    ((atom input)
	     (format *banner-pane "~s" input)
	     t)
	    ((listp input)
	     (selectq (car input)
	       (:menu
		(format *banner-pane "~:|~s~%" (second input))
		(format *message-pane "~:|~a~%"
			(get (second input) :documentation "<not documented>"))
		(send (fourth input)  :execute (second input)))
	       (t
		(format *banner-pane "~s" input)
		(beep))))))))

(defvar w)					;hold on to a window instance

;;; Users call this function to get and use a window

(defun top (&aux mf)
  (setq mf (make-instance 'WM:KMC-FLAVOR))
  (send mf :activate)
  (send mf :expose)
  (send mf :select)
  (setq w mf))