Did you get the bit I sent to prion.de? I will resend to your mac account.

On 4/13/06, Frank Goenninger fgoenninger@prion.de wrote:

Hi again ...

With substantial help I was able to get some more stuff to work as expected. Now I am struggling with the fact that the menubar does indeed have the menus I installed but the few widgets I placed into the window simply don't appear...

Hmm - well, yes, why?? (As always, there's a FRGO placed here and there)

Nothing inherits from any TK widget. I added ctk::button to application-object and made other changes I noted in what I sent and could see a panel. Actually I went back and exported button from Celtk, which was just an oversight.

How do I debug what is being sent to wish ?

Hack ctk::tk-format-now in various ways to see all or selected messages.

Totally late, gotta run, but will resend shortly.

kt

Thx for any inputs.

Frank

---

;; -*- mode: Lisp; Syntax: Common-Lisp; Package: celtk-user; -*-

(in-package :cl-user)

(eval-when (:load-toplevel :compile-toplevel :execute) #+asdf (progn #-cells (asdf:operate 'asdf:load-op :cells) #-Celtk (asdf:operate 'asdf:load-op :Celtk) ))

(in-package :celtk-user)

(defparameter *psu-rc-app* nil "The instance of the PSU Remote Control application.")

;; BASE CLASS FOR APPLICATIONS

(defmodel application () (( .md-value :cell t :accessor view :initform (c-in nil) :initarg :view ) ( name :cell t :accessor name :initform (c-in nil) :initarg :name ) ( status :cell t :accessor status :initform (c- in :disabled) :initarg :status) ))

;(defmethod initialize-instance :after ((self application) &key) ; (incf (nr-instances self))) - does not work ...

(defmodel application-object (family) (( .md-name :cell t :accessor id :initform (c- in :unknown) :initarg :id )))

;; PUSHBUTTON, SIGNAL-LAMP, PUSHBUTTON-WITH-SIGNAL-LAMP MODELS

(defmodel pushbutton (application-object) (( .md-value :cell t :accessor pb-state :initform (c? (if (^pressed) (on-off-toggle .cache) (initial-pb-state self))) :initarg :pb-state ) ( initial-pb-state :cell nil :initform :off :initarg :initial-pb-state :reader initial-pb-state ) ( pressed :cell :ephemeral :accessor pressed :initform (c-in nil))))

(defmacro mk-pushbutton (&rest initargs) `(make-instance 'pushbutton :fm-parent *parent* ,@initargs))

;(defmacro push-the-button (button-id) ; `(setf (fm^v ,button-id) :pressed))

(defmodel signal-lamp (application-object) ((lamp-state :cell t :accessor lamp-state :initform (c? (if (^switched) (not .cache) (initial-lamp-state self))) :initarg :lamp-state ) ( initial-lamp-state :cell nil :initform :off :initarg :initial-lamp-state :reader initial-lamp-state ) ( switched :cell :ephemeral :accessor switched :initform (c-in nil))))

(defmacro mk-signal-lamp (&rest initargs) `(make-instance 'signal-lamp :fm-parent *parent* ,@initargs))

(defmodel pushbutton-with-signal-lamp (pushbutton signal-lamp) ())

(defmacro mk-pushbutton-with-signal-lamp (&rest initargs) `(make-instance 'pushbutton-with-signal-lamp :fm-parent *parent* ,@initargs))

;; PSU-APP-RC MODEL

(defun control-panel () (list ;; SIGNAL LAMPS

 ;; Mains signal lamp
 (mk-signal-lamp :id :mains-lamp
                ;:lamp-state (cr-mains-lamp-state)
                )

 ;; OPER signal lamp
 (mk-signal-lamp :id :oper-lamp
                ;:lamp-state (cr-oper-lamp-state)
                )

 ;; TEST signal lamp
 (mk-signal-lamp :id :test-lamp
                ;:lamp-state (cr-test-lamp-state)
                )

 ;; FAIL signal lamp
 (mk-signal-lamp :id :fail-lamp
                ;:lamp-state (cr-fail-lamp-state)
                )
 ;; PUSH BUTTONS AND LAMPS

 ;; Oper mode pushbutton with lamp
 (mk-pushbutton-with-signal-lamp :id :oper-mode-pb
                                :initial-pb-state :off
                                :lamp-state (c? (if (^pressed)
                                                      (^pb-state)
                                                    (initial-lamp-state

self))) )

 ;; Test mode pushbutton with lamp
 (mk-pushbutton-with-signal-lamp :id :test-mode-pb
                                :initial-pb-state :off
                                ;:lamp-state (c? (^pb-state))
                                )

 ;; Ua-enable pushbutton with lamp
 (mk-pushbutton-with-signal-lamp :id :Ua-enable-pb
                                :initial-pb-state :off)

 ;; Ug1 pushbutton with lamp
 (mk-pushbutton-with-signal-lamp :id :Ug1-pb
                                :initial-pb-state :off)

 ;; Ug2 pushbutton with lamp
 (mk-pushbutton-with-signal-lamp :id :Ug2-pb
                                :initial-pb-state :off)

 ;; Uh pushbutton with lamp
 (mk-pushbutton-with-signal-lamp :id :Uh-pb
                                :initial-pb-state :off)

 ;; Uh pushbutton with lamp
 (mk-pushbutton-with-signal-lamp :id :Uh-pb
                                :initial-pb-state :off)

) )

(defmodel psu-rc-app (application) ( ;; Mains status (may have several vaklues, :ok indicates OK ;-) ( mains-status :cell t :accessor mains-status :initform (c-in nil) :initarg :mains-status )

 ;; Operate status: eitehr :operate-mode  or :test-mode
 ( operate-status :cell t :accessor operate-status :initform (c-

in nil) :initarg :operate-status )

 ;; RS232C port
 ;; As soon as the port name is set try to read data from this port
 ;; DARC stands for Device and Application Remote Control
 ( darc-rs232c-port :cell t :accessor darc-rs232c-port
                   :initform (c-in nil)
                   :initarg :darc-rs232c-port )

 ;; Voltage and current values to be

displayed Units ( Ua :cell t :accessor Ua :initform (c-in nil) :initarg :Ua ) ; [ V ] ( Ia :cell t :accessor Ia :initform (c-in nil) :initarg :Ia ) ; [ A ] ( Uh :cell t :accessor Uh :initform (c-in nil) :initarg :Uh ) ; [ V ] ( Ih :cell t :accessor Ih :initform (c-in nil) :initarg :Ih ) ; [ A ] ( Ug1 :cell t :accessor Ug1 :initform (c-in nil) :initarg :Ug1 ) ; [ V ] ( Ig1 :cell t :accessor Ig1 :initform (c-in nil) :initarg :Ig1 ) ; [ mA ] ( Ug2 :cell t :accessor Ug2 :initform (c-in nil) :initarg :Ug2 ) ; [ V ] ( Ig2 :cell t :accessor Ig2 :initform (c-in nil) :initarg :Ig2 ) ; [ mA ] ) )

(defmodel rs232c-port (window) ; needs to be a widget to get a ; timer easily ;-) (( status :accessor status :cell t :initform (c-in :not-connected)) ( device-name :accessor device-name :cell t :initform (c-in nil) :initarg :device-name )) (:default-initargs :id :darc-port :timers (c? (list (make-instance 'timer :state (c-in :off) :repeat t :delay 10000 ; 10 s delay :action (lambda (timer) (declare (ignore timer)) (let ((status (status (darc-rs232c-port *psu-rc-app*))) (device-name (device-name (darc-rs232c-port *psu-rc-app*)))) (if (and (eq status :not-connected) device-name ) (connect-to-darc device-name)))))))))

(defun connect-to-darc (device-name)

(format t "~%*** connect-to-darc been called for port ~a ...~&" device-name)

(when device-name (format t "~%*** Trying to connect to DARC via port ~a ...~&" device-name)

 ;; Missing: Code that connects to the DARC port via USB ...
 ;; For now, just return NOT CONNECTED ...

 :not-connected
 )

)

(defobserver status ((self rs232c-port)) (format t "~%*** Status of RS232C port ~a is now ~s.~%" (device-name self) (status self)) (when new-value (if (eq new-value :connected) (setf (state (first (timers self))) :off) (setf (state (first (timers self))) :on) )))

;; HELPER FUNCTIONS

;; Toggles :on to :off and vice versa (defun on-off-toggle (on-or-off) (case on-or-off ( :on :off) ( :off :on ) (otherwise :off))) ; Safety ! Turn off in case of unknown value given ; (= bug in app) ...

;; PSU-RC-APP OBSERVERS

(defobserver mains-status ((self psu-rc-app)) (format t "~%*** Mains-status is now ~s.~%" new-value))

(defobserver lamp-state ((self signal-lamp)) (format t "~%*** Signal lamp ~a is now ~s.~%" (id self) new-value))

(defobserver pressed ((self pushbutton)) (format t "~%*** Pushbutton ~a has been pressed (~s).~%" (id self) new-value))

(defobserver switched ((self signal-lamp)) (format t "~%*** Lamp ~a has been switched (~s).~%" (id self) new- value))

;(defobserver pressed ((self pushbutton-with-signal-lamp)) ; (setf (switched (fm^ (md-name self)) t)))

;; Get a view / window right after making an instance ;; We only allow one instance to run !

(defmethod initialize-instance :after ((self psu-rc-app) &key) (when *psu-rc-app* (error "*** A PSU-APP-RC instance already exists. Only one allowed.")) (setq *psu-rc-app* self) (setf (view self) (make-instance 'psu-rc-app-view)) (setf (darc-rs232c-port self) (make-instance 'rs232c-port)))

;; PSU-RC-APP-VIEW - the view/GUI for the PSU Remote Control Application

(defmodel psu-rc-app-view (window) ((selected-oper-pb :cell :ephemeral :accessor selected-oper-pb :initform (c-in nil) :initarg :selected-oper-pb) (selected-test-pb :cell :ephemeral :accessor selected-test-pb :initform (c-in nil) :initarg :selected-test-pb)) (:default-initargs :id :psu-rc-app-view :kids (c? (the-kids (app-menubar) (control-panel) (darc-setup-panel) ))))

;(defmethod initialize-instance :after ((self psu-rc-app-view) &key) ; (tk-format '(:configure "title") "wm title . ~a" (slot-value self 'title$)))

(defobserver title$ ((self window)) (tk-format '(:configure "title") "wm title . ~a" (or new-value "Untitled")))

(defun app-menubar () (mk-menubar :id :psu-rc-menu-bar :kids (c? (the-kids (mk-menu-entry-cascade-ex (:label "File") (mk-menu-entry-command :label "Quit" :command "exit")) (mk-menu-entry-cascade-ex (:label "Operate") (mk-menu-entry-command :label "Set Mains Status to :OK" :command (c? (tk-callback .tkw 'set-mains-ok (lambda () (setf (mains-status *psu-rc-app*) :ok))))) (mk-menu-entry-command :label "Action: Push the OPER MODE button" :command (c? (tk-callback .tkw 'push-oper- mode-pb (lambda () (setf (pressed (fm^ :oper-mode-pb)) t)))) ) ) ) ) ) )

(defun darc-setup-panel () ; <<< frgo: HERE

(mk-stack () (mk-row () (mk-label :text "DARC RS232C Port Device Name:") (mk-entry :id :darc-port-device-name :md-value (c-in "") :background "grey")) (mk-row () (mk-label :text "DARC Connect Status:") (mk-canvas ;; :height 40 :width 40 :kids (c? (the-kids (mk-rectangle :coords '(0 0 40 40) :tk-fill (c? (if (eq (if (darc-rs232c-port *psu-rc-app*) (status (darc-rs232c-port *psu-rc-app*)) nil) :connected) "green" "red"))))))) (mk-row () (mk-label :text (c? (if (darc-rs232c-port *psu-rc-app*) (status (darc-rs232c-port *psu-rc-app*)) "")) :relief 'sunken))))

(defun run-psu-rc-app () (cells-reset 'tk-user-queue-handler) (tk-test-class 'psu-rc-app))

---

cells-devel site list cells-devel@common-lisp.net http://common-lisp.net/mailman/listinfo/cells-devel