← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to gcl-tk/demos/mkLabel.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
gcl-tk/demos/mkLabel.lisp
 
1
;;# mkLabel w
 
2
;;
 
3
;; Create a top-level window that displays a bunch of labels.
 
4
;;
 
5
;; Arguments:
 
6
;;    w -       Name to use for new top-level window.
 
7
 
 
8
(in-package "TK")
 
9
(defun mkLabel (&optional (w '.l1)) 
 
10
;    (global :tk_library)
 
11
    (if (winfo :exists w :return 'boolean) (destroy w))
 
12
    (toplevel w)
 
13
    (dpos w)
 
14
    (wm :title w "Label Demonstration")
 
15
    (wm :iconname w "Labels")
 
16
    (message (conc w '.msg) :font :Adobe-times-medium-r-normal--*-180* :aspect 300 
 
17
            :text "Five labels are displayed below: three textual ones on the left, and a bitmap label and a text label on the right.  Labels are pretty boring because you can't do anything with them.  Click the \"OK\" button when you've seen enough.")
 
18
    (frame (conc w '.left))
 
19
    (frame (conc w '.right))
 
20
    (button (conc w '.ok) :text "OK" :command `(destroy ',w))
 
21
    (pack (conc w '.msg) :side "top")
 
22
    (pack (conc w '.ok) :side "bottom" :fill "x")
 
23
    (pack (conc w '.left) (conc w '.right) :side "left" :expand "yes" :padx 10 :pady 10 :fill "both")
 
24
 
 
25
    (label (conc w '.left.l1) :text "First label")
 
26
    (label (conc w '.left.l2) :text "Second label, raised just for fun" :relief "raised")
 
27
    (label (conc w '.left.l3) :text "Third label, sunken" :relief "sunken")
 
28
    (pack (conc w '.left.l1) (conc w '.left.l2) (conc w '.left.l3) 
 
29
            :side "top" :expand "yes" :pady 2 :anchor "w")
 
30
 
 
31
    (label (conc w '.right.bitmap) :bitmap "@": *tk-library* : "/demos/images/face" 
 
32
            :borderwidth 2 :relief "sunken")
 
33
    (label (conc w '.right.caption) :text "Tcl/Tk Proprietor")
 
34
    (pack (conc w '.right.bitmap) (conc w '.right.caption) :side "top")
 
35
)