Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
executable file 96 lines (76 sloc) 2.87 KB
;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*-
#|
Celtk -- Cells, Tcl, and Tk
Copyright (C) 2006 by Kenneth Tilton
This library is free software; you can redistribute it and/or
modify it under the terms of the Lisp Lesser GNU Public License
(http://opensource.franz.com/preamble.html), known as the LLGPL.
This library is distributed WITHOUT ANY WARRANTY; without even
the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the Lisp Lesser GNU Public License for more details.
|#
(in-package :celtk)
;--- button ----------------------------------------------
(deftk button (commander widget)
()
(:tk-spec button
-activebackground -activeforeground -anchor
-background -bitmap -borderwidth -cursor
-disabledforeground (tkfont -font) -foreground
-highlightbackground -highlightcolor -highlightthickness -image
(tk-justify -justify)
-padx -pady -relief -repeatdelay
-repeatinterval -takefocus -text -textvariable
-underline -wraplength
-command -compound -default -height -overrelief -state -width)
(:default-initargs
:id (gentemp "B")))
(defmacro mk-button-ex ((text command) &rest initargs)
`(make-instance 'button
:fm-parent *parent*
:text ,text
:on-command (c? (lambda (self)
(declare (ignorable self))
,command))
,@initargs))
; --- checkbutton ---------------------------------------------
(deftk radiocheck (commander widget)
()
(:tk-spec radiocheck
-activebackground -activeforeground -anchor
-background -bitmap -borderwidth -compound -cursor
-disabledforeground (tkfont -font) -foreground
-highlightbackground -highlightcolor -highlightthickness -image
(tk-justify -justify) -padx -pady -relief -takefocus -text -textvariable
-underline -wraplength
-command -height -indicatoron -offrelief
-overrelief -selectcolor -selectimage -state -tristateimage
-tristatevalue (tk-variable -variable) -width))
(deftk checkbutton (radiocheck)
()
(:tk-spec checkbutton
-offvalue -onvalue)
(:default-initargs
:id (gentemp "CK")
:value (c-in nil)
:tk-variable (c? (^path))
:on-command (lambda (self)
(setf (^value) (not (^value))))))
(defobserver .value ((self checkbutton))
(tk-format `(:variable ,self) "set ~(~a~) ~a" (path self) (if new-value 1 0)))
; --- radiobutton -------------------------------------
(deftk radiobutton (radiocheck)
()
(:tk-spec radiobutton
-value)
(:default-initargs
:id (gentemp "RB")
:tk-variable (c? (path (upper self tk-selector)))
:on-command (lambda (self)
(setf (selection (upper self tk-selector)) (value self)))))
(defmacro mk-radiobutton-ex ((text value) &rest initargs)
`(make-instance 'radiobutton
:fm-parent *parent*
:text ,text
:value ,value
,@initargs))