#!/bin/sh # the next line restarts using wish \ exec wish8.6 "$0" ${1+"$@"} # widget -- # This script demonstrates the various widgets provided by Tk, along with many # of the features of the Tk toolkit. This file only contains code to generate # the main window for the application, which invokes individual # demonstrations. The code for the actual demonstrations is contained in # separate ".tcl" files is this directory, which are sourced by this script as # needed. package require Tk 8.5 package require msgcat eval destroy [winfo child .] set tk_demoDirectory [file join [pwd] [file dirname [info script]]] ::msgcat::mcload $tk_demoDirectory namespace import ::msgcat::mc wm title . [mc "Widget Demonstration"] if {[tk windowingsystem] eq "x11"} { # This won't work everywhere, but there's no other way in core Tk at the # moment to display a coloured icon. image create photo TclPowered \ -file [file join $tk_library images logo64.gif] wm iconwindow . [toplevel ._iconWindow] pack [label ._iconWindow.i -image TclPowered] wm iconname . [mc "tkWidgetDemo"] } if {"defaultFont" ni [font names]} { # TIP #145 defines some standard named fonts if {"TkDefaultFont" in [font names] && "TkFixedFont" in [font names]} { # FIX ME: the following technique of cloning the font to copy it works # fine but means that if the system font is changed by Tk # cannot update the copied font. font alias might be useful # here -- or fix the app to use TkDefaultFont etc. font create mainFont {*}[font configure TkDefaultFont] font create fixedFont {*}[font configure TkFixedFont] font create boldFont {*}[font configure TkDefaultFont] -weight bold font create titleFont {*}[font configure TkDefaultFont] -weight bold font create statusFont {*}[font configure TkDefaultFont] font create varsFont {*}[font configure TkDefaultFont] if {[tk windowingsystem] eq "aqua"} { font configure titleFont -size 17 } } else { font create mainFont -family Helvetica -size 12 font create fixedFont -family Courier -size 10 font create boldFont -family Helvetica -size 12 -weight bold font create titleFont -family Helvetica -size 18 -weight bold font create statusFont -family Helvetica -size 10 font create varsFont -family Helvetica -size 14 } } set widgetDemo 1 set font mainFont image create photo ::img::refresh -format GIF -data { R0lGODlhEAAQAJEDAP///wAAACpnKv///yH5BAEAAAMALAAAAAAQABAAAAI63IKp xgcPH2ouwgBCw1HIxHCQ4F3hSJKmwZXqWrmWxj7lKJ2dndcon9EBUq+gz3brVXAR 2tICU0gXBQA7 } image create photo ::img::view -format GIF -data { R0lGODlhEAAQAKIHAP///wwMDAAAAMDAwNnZ2SYmJmZmZv///yH5BAEAAAcALAAA AAAQABAAAANMKLos90+ASamDRxJCgw9YVnlDOXiQBgRDBRgHKE6sW8QR3doPKK27 yg33q/GIOhdg6OsEJzeZykiBSUcs06e56Xx6np8ScIkFGuhQAgA7 } image create photo ::img::delete -format GIF -data { R0lGODlhEAAQAIABAIQAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjI+pmwAc3HGy PUSvqYpuvWQg40FfSVacBa5nN6JYDI3mzRQAOw== } image create photo ::img::print -format GIF -data { R0lGODlhEAAQALMKAAAAAP///52VunNkl8C82Yl+qldBgq+pyrOzs1fYAP///wAA AAAAAAAAAAAAAAAAACH5BAEAAAoALAAAAAAQABAAAARGUMlJKwU4AztB+ODGeUiJ fGLlgeEYmGWQXmx7aXgmAUTv/74N4EAsGhOJg1DAbDqbwoJ0Sp0KB9isNis0eL/g ryhH5pgnEQA7 } # Note that this is run through the message catalog! This is because this is # actually an image of a word. image create photo ::img::new -format PNG -data [mc { iVBORw0KGgoAAAANSUhEUgAAAB4AAAAOCAYAAAA45qw5AAACMElEQVR4AeVTAwxd QRCc2tZHGtQ2w9q2bdsOa9u2bUW1bdt2Z372JZe6DapJLqtb3h7+T8yKi5j4CsYD EUQXxETclT7kWOlH2VV+tFkdQHPSwksSISF+BauCqL0qgOcMWgGfgEkaMsHxqUBk 3plE/sOnh/qDPAPJH/CKFBivGHWzFwBRnHhlqbu1Mh6CoFNnC/JshQ9p4YC2lrKt DCAV+THiVejyhMjAbrNSrroiEfKR9g7ZfCgOog8QfnUQV62wAk68ndQ9ZbyoWO1H Y6eDY1LCQL6a9ApOp9Hi1T0+gQq2JKMlky/oTKQliKWxEZvyG575kpW4pl1aZnQK CLOVt45Lkp8uXp2SL8KO6uitNTZLdpK6s+I/eZbhpmsmWeOGOVQNKYLITzpKPAO3 tY7LSNZ7ccSLxX9y3uuOxRkg3dKESMoCHvL+GRVCutXsB3guLgDCeXOv4iWWkvwG BaS+PmlpK6SI9ApI2oC2UtrwZQEkhkH+NtolVlQXJl1I+QltuU3XEc721bIRFpa8 IA5iqTo6vNNWmkNBLQbPeXwF2g17Q94nTQAfY3YzeY+WSu8MDzQ2kpELUhSGJUHE 0zeR3rY1L+Xl5G/re+jbiK6KhThwwInsts1fbMUUcpZszKeVtggZEiGdZDe5AtHh 7vL4CGiRvvKPS8FAvq9Nr4ZkFadR2y6kggu1z4vlyIbBp6BugQ8JLEg4bTkD9eMZ QZ8hpJ3VvTtuvbWrY/ElvP/9R+Aj3603+iE3fkEAAAAASUVORK5CYII= }] #---------------------------------------------------------------- # The code below creates the main window, consisting of a menu bar and a text # widget that explains how to use the program, plus lists all of the demos as # hypertext items. #---------------------------------------------------------------- menu .menuBar -tearoff 0 # On Aqua, just use the default menu. if {[tk windowingsystem] ne "aqua"} { # This is a tk-internal procedure to make i18n easier ::tk::AmpMenuArgs .menuBar add cascade -label [mc "&File"] \ -menu .menuBar.file menu .menuBar.file -tearoff 0 ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \ -command {tkAboutDialog} -accelerator [mc ""] bind . {tkAboutDialog} .menuBar.file add sep if {[string match win* [tk windowingsystem]]} { # Windows doesn't usually have a Meta key ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \ -command {exit} -accelerator [mc "Ctrl+Q"] bind . <[mc "Control-q"]> {exit} } else { ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \ -command {exit} -accelerator [mc "Meta-Q"] bind . <[mc "Meta-q"]> {exit} } . configure -menu .menuBar } ttk::frame .statusBar ttk::label .statusBar.lab -text " " -anchor w if {[tk windowingsystem] eq "aqua"} { ttk::separator .statusBar.sep pack .statusBar.sep -side top -expand yes -fill x -pady 0 } pack .statusBar.lab -side left -padx 2 -expand yes -fill both if {[tk windowingsystem] ne "aqua"} { ttk::sizegrip .statusBar.foo pack .statusBar.foo -side left -padx 2 } pack .statusBar -side bottom -fill x -pady 2 set textheight 30 catch { set textheight [expr { ([winfo screenheight .] * 0.7) / [font metrics mainFont -displayof . -linespace] }] } ttk::frame .textFrame ttk::scrollbar .s -orient vertical -command {.t yview} -takefocus 1 pack .s -in .textFrame -side right -fill y text .t -yscrollcommand {.s set} -wrap word -width 70 -height $textheight \ -font mainFont -setgrid 1 -highlightthickness 0 \ -padx 4 -pady 2 -takefocus 0 pack .t -in .textFrame -expand y -fill both -padx 1 pack .textFrame -expand yes -fill both if {[tk windowingsystem] eq "aqua"} { pack configure .statusBar.lab -padx {10 18} -pady {4 6} pack configure .statusBar -pady 0 .t configure -padx 10 -pady 0 } # Create a bunch of tags to use in the text widget, such as those for section # titles and demo descriptions. Also define the bindings for tags. .t tag configure title -font titleFont .t tag configure subtitle -font titleFont .t tag configure bold -font boldFont if {[tk windowingsystem] eq "aqua"} { .t tag configure title -spacing1 8 .t tag configure subtitle -spacing3 3 } # We put some "space" characters to the left and right of each demo # description so that the descriptions are highlighted only when the mouse # cursor is right over them (but not when the cursor is to their left or # right). # .t tag configure demospace -lmargin1 1c -lmargin2 1c if {[winfo depth .] == 1} { .t tag configure demo -lmargin1 1c -lmargin2 1c \ -underline 1 .t tag configure visited -lmargin1 1c -lmargin2 1c \ -underline 1 .t tag configure hot -background black -foreground white } else { .t tag configure demo -lmargin1 1c -lmargin2 1c \ -foreground blue -underline 1 .t tag configure visited -lmargin1 1c -lmargin2 1c \ -foreground #303080 -underline 1 if {[tk windowingsystem] eq "aqua"} { .t tag configure demo -foreground systemLinkColor .t tag configure visited -foreground purple } .t tag configure hot -foreground red -underline 1 } .t tag bind demo { invoke [.t index {@%x,%y}] } set lastLine "" .t tag bind demo { set lastLine [.t index {@%x,%y linestart}] .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars" .t config -cursor [::ttk::cursor link] showStatus [.t index {@%x,%y}] } .t tag bind demo { .t tag remove hot 1.0 end .t config -cursor [::ttk::cursor text] .statusBar.lab config -text "" } .t tag bind demo { set newLine [.t index {@%x,%y linestart}] if {$newLine ne $lastLine} { .t tag remove hot 1.0 end set lastLine $newLine set tags [.t tag names {@%x,%y}] set i [lsearch -glob $tags demo-*] if {$i >= 0} { .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars" } } showStatus [.t index {@%x,%y}] }