git.zerfleddert.de Git - micropolis/blob - src/tk/library/demos/mkStyles.tcl

   1 # mkStyles w
   2 #
   3 # Create a top-level window with a text widget that demonstrates the
   4 # various display styles that are available in texts.
   5 #
   6 # Arguments:
   7 #    w -        Name to use for new top-level window.
   8
   9 proc mkStyles {{w .styles}} {
  10     catch {destroy $w}
  11     toplevel $w
  12     dpos $w
  13     wm title $w "Text Demonstration - Display Styles"
  14     wm iconname $w "Text Styles"
  15     button $w.ok -text OK -command "destroy $w"
  16     text $w.t -relief raised -bd 2 -yscrollcommand "$w.s set" -setgrid true \
  17             -width 70 -height 28
  18     scrollbar $w.s -relief flat -command "$w.t yview"
  19     pack append $w $w.ok {bottom fillx} $w.s {right filly} $w.t {expand fill}
  20
  21     # Set up display styles
  22
  23     $w.t tag configure bold -font -Adobe-Courier-Bold-O-Normal-*-120-*
  24     $w.t tag configure big -font -Adobe-Courier-Bold-R-Normal-*-140-*
  25     $w.t tag configure verybig -font -Adobe-Helvetica-Bold-R-Normal-*-240-*
  26     if {[winfo screendepth $w] > 4} {
  27         $w.t tag configure color1 -background #eed5b7
  28         $w.t tag configure color2 -foreground red
  29         $w.t tag configure raised -background #eed5b7 -relief raised \
  30                 -borderwidth 1
  31         $w.t tag configure sunken -background #eed5b7 -relief sunken \
  32                 -borderwidth 1
  33     } else {
  34         $w.t tag configure color1 -background black -foreground white
  35         $w.t tag configure color2 -background black -foreground white
  36         $w.t tag configure raised -background white -relief raised \
  37                 -borderwidth 1
  38         $w.t tag configure sunken -background white -relief sunken \
  39                 -borderwidth 1
  40     }
  41     $w.t tag configure bgstipple -background black -borderwidth 0 \
  42             -bgstipple gray25
  43     $w.t tag configure fgstipple -fgstipple gray50
  44     $w.t tag configure underline -underline on
  45
  46     $w.t insert 0.0 {\
  47 Text widgets like this one allow you to display information in a
  48 variety of styles.  Display styles are controlled using a mechanism
  49 called }
  50     insertWithTags $w.t tags bold
  51     insertWithTags $w.t {. Tags are just textual names that you can apply to one
  52 or more ranges of characters within a text widget.  You can configure
  53 tags with various display styles.  If you do this, then the tagged
  54 characters will be displayed with the styles you chose.  The
  55 available display styles are:
  56 }
  57     insertWithTags $w.t {
  58 1. Font.} big
  59     insertWithTags $w.t {  You can choose any X font, }
  60     insertWithTags $w.t large verybig
  61     insertWithTags $w.t { or }
  62     insertWithTags $w.t {small.
  63 }
  64     insertWithTags $w.t {
  65 2. Color.} big
  66     insertWithTags $w.t {  You can change either the }
  67     insertWithTags $w.t background color1
  68     insertWithTags $w.t { or }
  69     insertWithTags $w.t foreground color2
  70     insertWithTags $w.t {
  71 color, or }
  72     insertWithTags $w.t both color1 color2
  73     insertWithTags $w.t {.
  74 }
  75     insertWithTags $w.t {
  76 3. Stippling.} big
  77     insertWithTags $w.t {  You can cause either the }
  78     insertWithTags $w.t background bgstipple
  79     insertWithTags $w.t { or }
  80     insertWithTags $w.t foreground fgstipple
  81     insertWithTags $w.t {
  82 information to be drawn with a stipple fill instead of a solid fill.
  83 }
  84     insertWithTags $w.t {
  85 4. Underlining.} big
  86     insertWithTags $w.t {  You can }
  87     insertWithTags $w.t underline underline
  88     insertWithTags $w.t { ranges of text.
  89 }
  90     insertWithTags $w.t {
  91 5. 3-D effects.} big
  92     insertWithTags $w.t {  You can arrange for the background to be drawn
  93 with a border that makes characters appear either }
  94     insertWithTags $w.t raised raised
  95     insertWithTags $w.t { or }
  96     insertWithTags $w.t sunken sunken
  97     insertWithTags $w.t {.
  98 }
  99     insertWithTags $w.t {
 100 6. Yet to come.} big
 101     insertWithTags $w.t {  More display effects will be coming soon, such
 102 as the ability to change line justification and perhaps line spacing.}
 103
 104     $w.t mark set insert 0.0
 105     bind $w <Any-Enter> "focus $w.t"
 106 }
 107
 108 # The procedure below inserts text into a given text widget and
 109 # applies one or more tags to that text.  The arguments are:
 110 #
 111 # w             Window in which to insert
 112 # text          Text to insert (it's inserted at the "insert" mark)
 113 # args          One or more tags to apply to text.  If this is empty
 114 #               then all tags are removed from the text.
 115
 116 proc insertWithTags {w text args} {
 117     set start [$w index insert]
 118     $w insert insert $text
 119     foreach tag [$w tag names $start] {
 120         $w tag remove $tag $start insert
 121     }
 122     foreach i $args {
 123         $w tag add $i $start insert
 124     }
 125 }