A brief example (The CMUCL Motif Toolkit)

10 A brief example ¶

The following gives a simple example that pops up a window containing a “Quit” button. Clicking on the button exits the application. Note that the application runs concurrently with CMUCL: you can evaluate forms in the listener while the Motif application is running. Exiting the application does not cause CMUCL to exit; once you have quit the application, you can run it again.

To run this example, save the code to a file named motif-example.lisp and in the CMUCL listener, type

   USER> (compile-file "motif-example")
   ; Loading #p"/opt/cmucl/lib/cmucl/lib/subsystems/clm-library.x86f".
   ;; Loading #p"/opt/cmucl/lib/cmucl/lib/subsystems/clx-library.x86f".
   ; Byte Compiling Top-Level Form: 
   ; Converted my-callback.
   ; Compiling defun my-callback: 
   ; Converted test-init.
   ; Compiling defun test-init: 
   ; Converted test.
   ; Compiling defun test: 
   ; Byte Compiling Top-Level Form: 
   #p"/home/CMUCL/motif-example.x86f"
   nil
   nil
   USER> (load *)
   ; Loading #p"/home/CMUCL/motif-example.x86f".
   t
   USER> (motif-example:test)
   #<X Toolkit Connection, fd=5>
   Got callback on #<X Toolkit Widget: push-button-gadget 82D89A0>
   Callback reason was cr-activate
   Quit button is #<X Toolkit Widget: push-button-gadget 82D7AD0>
   USER> (quit)

The source code:

;;; file motif-example.lisp

(eval-when (:load-toplevel :compile-toplevel)
  (require :clm))

(defpackage :motif-example
  (:use :cl :toolkit)
  (:export #:test))

(in-package :motif-example)


(defun my-callback (widget call-data quit)
  (format t "Got callback on ~A~%" widget)
  (format t "Callback reason was ~A~%" (any-callback-reason call-data))
  (format t "Quit button is ~A~%" quit))

(defun test-init ()
  (let* ((shell (create-application-shell))
	 (rc (create-row-column shell "rowColumn"))
	 (quit (create-push-button-gadget rc "quitButton"
					  :label-string "Quit"))
	 (button (create-push-button-gadget rc "button"
					    :highlight-on-enter t
					    :shadow-thickness 0
					    :label-string "This is a button")))

    (add-callback quit :activate-callback #'quit-application-callback)
    (add-callback button :activate-callback 'my-callback quit)

    (manage-child rc)
    (manage-children quit button)
    (realize-widget shell)))

(defun test ()
  (run-motif-application 'test-init))