Ltk:電卓アプリ(ボタン応用)と同様のものをCAPIで作成した例です。

;; http://kaolin.unice.fr/STk/STk.html
;; STk-4.0.1/Demos/calc.stklos を参考にLispWorks CAPIへ移植

(defpackage calc
  (:use cl capi))

(in-package calc)

(defun digit? (s)
  (or (parse-integer s :junk-allowed T)
      (string= s ".")))

(defclass calc-screen (title-pane)
  ((result :initform 0 :accessor result)
   (previous-action :initform "" :accessor previous-action)
   (acc :initform 0 :accessor acc)
   (operator :initform #'+ :accessor operator)))

(defmethod value ((obj calc-screen))
  (read-from-string (title-pane-text obj) nil 0))

(defmethod (setf result) :after (val (obj calc-screen))
  (setf (title-pane-text obj) 
        (princ-to-string (slot-value obj 'result))))

(define-interface calc ()
  ()
  (:panes
   (screen calc-screen :text "0")
   (buttons push-button-panel 
            :items '("Off"  "Sqrt"  "C"  "/"
                     "7"    "8"    "9"  "*"
                     "4"    "5"    "6"  "-"
                     "1"    "2"    "3"  "+"
                     "0"    "."   "+/-" "=")
            :layout-class 'grid-layout
            :layout-args '(:columns 4)
            :selection-callback #'execute-action
            :callback-type '(:interface :data)))
  (:layouts (main column-layout '(screen buttons))))

(defmethod execute-action ((itf calc) str)
  (with-accessors ((operator operator)
                   (result result)
                   (acc acc)
                   (previous-action previous-action)
                   (value value)
                   (text title-pane-text))
                  (slot-value itf 'screen)
    (cond ((string= str "Off")  (destroy itf))
          ((string= str "Sqrt") (setq result (sqrt value)))
          ((string= str "C")    (setq result 0))
          ((string= str "/")    (setq operator #'/))
          ((string= str "*")    (setq operator #'*))
          ((string= str "-")    (setq operator #'-))
          ((string= str "+")    (setq operator #'+))
          ((string= str "+/-")  (setq result (- value)))
          ((string= str "=")
           (setf result (funcall operator acc value)))
          ('ELSE
           (setq result (if (digit? previous-action)
                            (concatenate 'string text str)
                            (progn
                              (setq acc value)
                              str)))))
    (setq previous-action str)))

(defun calc ()
  (find-interface 'calc))

;; 実行
(calc)

参考

• Ltk:電卓アプリ(ボタン応用)