widget 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish "$0" ${1+"$@"}
  4. # widget --
  5. # This script demonstrates the various widgets provided by Tk, along with many
  6. # of the features of the Tk toolkit. This file only contains code to generate
  7. # the main window for the application, which invokes individual
  8. # demonstrations. The code for the actual demonstrations is contained in
  9. # separate ".tcl" files is this directory, which are sourced by this script as
  10. # needed.
  11. package require Tk 8.5
  12. package require msgcat
  13. eval destroy [winfo child .]
  14. set tk_demoDirectory [file join [pwd] [file dirname [info script]]]
  15. ::msgcat::mcload $tk_demoDirectory
  16. namespace import ::msgcat::mc
  17. wm title . [mc "Widget Demonstration"]
  18. if {[tk windowingsystem] eq "x11"} {
  19. # This won't work everywhere, but there's no other way in core Tk at the
  20. # moment to display a coloured icon.
  21. image create photo TclPowered \
  22. -file [file join $tk_library images logo64.gif]
  23. wm iconwindow . [toplevel ._iconWindow]
  24. pack [label ._iconWindow.i -image TclPowered]
  25. wm iconname . [mc "tkWidgetDemo"]
  26. }
  27. if {"defaultFont" ni [font names]} {
  28. # TIP #145 defines some standard named fonts
  29. if {"TkDefaultFont" in [font names] && "TkFixedFont" in [font names]} {
  30. # FIX ME: the following technique of cloning the font to copy it works
  31. # fine but means that if the system font is changed by Tk
  32. # cannot update the copied font. font alias might be useful
  33. # here -- or fix the app to use TkDefaultFont etc.
  34. font create mainFont {*}[font configure TkDefaultFont]
  35. font create fixedFont {*}[font configure TkFixedFont]
  36. font create boldFont {*}[font configure TkDefaultFont] -weight bold
  37. font create titleFont {*}[font configure TkDefaultFont] -weight bold
  38. font create statusFont {*}[font configure TkDefaultFont]
  39. font create varsFont {*}[font configure TkDefaultFont]
  40. if {[tk windowingsystem] eq "aqua"} {
  41. font configure titleFont -size 17
  42. }
  43. } else {
  44. font create mainFont -family Helvetica -size 12
  45. font create fixedFont -family Courier -size 10
  46. font create boldFont -family Helvetica -size 12 -weight bold
  47. font create titleFont -family Helvetica -size 18 -weight bold
  48. font create statusFont -family Helvetica -size 10
  49. font create varsFont -family Helvetica -size 14
  50. }
  51. }
  52. set widgetDemo 1
  53. set font mainFont
  54. image create photo ::img::refresh -format GIF -data {
  55. R0lGODlhEAAQAJEDAP///wAAACpnKv///yH5BAEAAAMALAAAAAAQABAAAAI63IKp
  56. xgcPH2ouwgBCw1HIxHCQ4F3hSJKmwZXqWrmWxj7lKJ2dndcon9EBUq+gz3brVXAR
  57. 2tICU0gXBQA7
  58. }
  59. image create photo ::img::view -format GIF -data {
  60. R0lGODlhEAAQAKIHAP///wwMDAAAAMDAwNnZ2SYmJmZmZv///yH5BAEAAAcALAAA
  61. AAAQABAAAANMKLos90+ASamDRxJCgw9YVnlDOXiQBgRDBRgHKE6sW8QR3doPKK27
  62. yg33q/GIOhdg6OsEJzeZykiBSUcs06e56Xx6np8ScIkFGuhQAgA7
  63. }
  64. image create photo ::img::delete -format GIF -data {
  65. R0lGODlhEAAQAIABAIQAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjI+pmwAc3HGy
  66. PUSvqYpuvWQg40FfSVacBa5nN6JYDI3mzRQAOw==
  67. }
  68. image create photo ::img::print -format GIF -data {
  69. R0lGODlhEAAQALMKAAAAAP///52VunNkl8C82Yl+qldBgq+pyrOzs1fYAP///wAA
  70. AAAAAAAAAAAAAAAAACH5BAEAAAoALAAAAAAQABAAAARGUMlJKwU4AztB+ODGeUiJ
  71. fGLlgeEYmGWQXmx7aXgmAUTv/74N4EAsGhOJg1DAbDqbwoJ0Sp0KB9isNis0eL/g
  72. ryhH5pgnEQA7
  73. }
  74. # Note that this is run through the message catalog! This is because this is
  75. # actually an image of a word.
  76. image create photo ::img::new -format GIF -data [mc {
  77. R0lGODlhHgAOALMPALMAANyIiOu7u8dEROaqqvru7sxVVeGZmbgREfXd3b0iItZ3
  78. d8IzM9FmZvDMzP///yH5BAEAAA8ALAAAAAAeAA4AAASa8MlJq7046827WVOCHEkw
  79. nANhUgJlEBIABJIwL3K+4IcUALCHjfbItYZDSgJgkBiYPmBMAUAkkLPKs/BAyLgM
  80. wAQwOAAY2ByCaw4QAFQSoDEePJ6DmU1xInYZTw5nOEFFdgVUelkVDTIMd3AKFGQ1
  81. MgI2AwEmQW8APZ0gdRONAks5nhIFVVxdAAkUAS2pAVwFl7ITB4UqHb0XEQA7
  82. }]
  83. #----------------------------------------------------------------
  84. # The code below create the main window, consisting of a menu bar and a text
  85. # widget that explains how to use the program, plus lists all of the demos as
  86. # hypertext items.
  87. #----------------------------------------------------------------
  88. menu .menuBar -tearoff 0
  89. if {[tk windowingsystem] ne "aqua"} {
  90. # This is a tk-internal procedure to make i18n easier
  91. ::tk::AmpMenuArgs .menuBar add cascade -label [mc "&File"] \
  92. -menu .menuBar.file
  93. menu .menuBar.file -tearoff 0
  94. ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \
  95. -command {tkAboutDialog} -accelerator [mc "<F1>"]
  96. bind . <F1> {tkAboutDialog}
  97. .menuBar.file add sep
  98. if {[string match win* [tk windowingsystem]]} {
  99. # Windows doesn't usually have a Meta key
  100. ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \
  101. -command {exit} -accelerator [mc "Ctrl+Q"]
  102. bind . <[mc "Control-q"]> {exit}
  103. } else {
  104. ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \
  105. -command {exit} -accelerator [mc "Meta-Q"]
  106. bind . <[mc "Meta-q"]> {exit}
  107. }
  108. }
  109. . configure -menu .menuBar
  110. ttk::frame .statusBar
  111. ttk::label .statusBar.lab -text " " -anchor w
  112. if {[tk windowingsystem] eq "aqua"} {
  113. ttk::separator .statusBar.sep
  114. pack .statusBar.sep -side top -expand yes -fill x -pady 0
  115. }
  116. pack .statusBar.lab -side left -padx 2 -expand yes -fill both
  117. if {[tk windowingsystem] ne "aqua"} {
  118. ttk::sizegrip .statusBar.foo
  119. pack .statusBar.foo -side left -padx 2
  120. }
  121. pack .statusBar -side bottom -fill x -pady 2
  122. set textheight 30
  123. catch {
  124. set textheight [expr {
  125. ([winfo screenheight .] * 0.7) /
  126. [font metrics mainFont -displayof . -linespace]
  127. }]
  128. }
  129. ttk::frame .textFrame
  130. ttk::scrollbar .s -orient vertical -command {.t yview} -takefocus 1
  131. pack .s -in .textFrame -side right -fill y
  132. text .t -yscrollcommand {.s set} -wrap word -width 70 -height $textheight \
  133. -font mainFont -setgrid 1 -highlightthickness 0 \
  134. -padx 4 -pady 2 -takefocus 0
  135. pack .t -in .textFrame -expand y -fill both -padx 1
  136. pack .textFrame -expand yes -fill both
  137. if {[tk windowingsystem] eq "aqua"} {
  138. pack configure .statusBar.lab -padx {10 18} -pady {4 6}
  139. pack configure .statusBar -pady 0
  140. .t configure -padx 10 -pady 0
  141. }
  142. # Create a bunch of tags to use in the text widget, such as those for section
  143. # titles and demo descriptions. Also define the bindings for tags.
  144. .t tag configure title -font titleFont
  145. .t tag configure subtitle -font titleFont
  146. .t tag configure bold -font boldFont
  147. if {[tk windowingsystem] eq "aqua"} {
  148. .t tag configure title -spacing1 8
  149. .t tag configure subtitle -spacing3 3
  150. }
  151. # We put some "space" characters to the left and right of each demo
  152. # description so that the descriptions are highlighted only when the mouse
  153. # cursor is right over them (but not when the cursor is to their left or
  154. # right).
  155. #
  156. .t tag configure demospace -lmargin1 1c -lmargin2 1c
  157. if {[winfo depth .] == 1} {
  158. .t tag configure demo -lmargin1 1c -lmargin2 1c \
  159. -underline 1
  160. .t tag configure visited -lmargin1 1c -lmargin2 1c \
  161. -underline 1
  162. .t tag configure hot -background black -foreground white
  163. } else {
  164. .t tag configure demo -lmargin1 1c -lmargin2 1c \
  165. -foreground blue -underline 1
  166. .t tag configure visited -lmargin1 1c -lmargin2 1c \
  167. -foreground #303080 -underline 1
  168. .t tag configure hot -foreground red -underline 1
  169. }
  170. .t tag bind demo <ButtonRelease-1> {
  171. invoke [.t index {@%x,%y}]
  172. }
  173. set lastLine ""
  174. .t tag bind demo <Enter> {
  175. set lastLine [.t index {@%x,%y linestart}]
  176. .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
  177. .t config -cursor [::ttk::cursor link]
  178. showStatus [.t index {@%x,%y}]
  179. }
  180. .t tag bind demo <Leave> {
  181. .t tag remove hot 1.0 end
  182. .t config -cursor [::ttk::cursor text]
  183. .statusBar.lab config -text ""
  184. }
  185. .t tag bind demo <Motion> {
  186. set newLine [.t index {@%x,%y linestart}]
  187. if {$newLine ne $lastLine} {
  188. .t tag remove hot 1.0 end
  189. set lastLine $newLine
  190. set tags [.t tag names {@%x,%y}]
  191. set i [lsearch -glob $tags demo-*]
  192. if {$i >= 0} {
  193. .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
  194. }
  195. }
  196. showStatus [.t index {@%x,%y}]
  197. }
  198. ##############################################################################
  199. # Create the text for the text widget.
  200. # addFormattedText --
  201. #
  202. # Add formatted text (but not hypertext) to the text widget after first
  203. # passing it through the message catalog to allow for localization.
  204. # Lines starting with @@ are formatting directives (insert title, insert
  205. # demo hyperlink, begin newline, or change style) and all other lines
  206. # are literal strings to be inserted. Substitutions are performed,
  207. # allowing processing pieces through the message catalog. Blank lines
  208. # are ignored.
  209. #
  210. proc addFormattedText {formattedText} {
  211. set style normal
  212. set isNL 1
  213. set demoCount 0
  214. set new 0
  215. foreach line [split $formattedText \n] {
  216. set line [string trim $line]
  217. if {$line eq ""} {
  218. continue
  219. }
  220. if {[string match @@* $line]} {
  221. set data [string range $line 2 end]
  222. set key [lindex $data 0]
  223. set values [lrange $data 1 end]
  224. switch -exact -- $key {
  225. title {
  226. .t insert end [mc $values]\n title \n normal
  227. }
  228. newline {
  229. .t insert end \n $style
  230. set isNL 1
  231. }
  232. subtitle {
  233. .t insert end "\n" {} [mc $values] subtitle \
  234. " \n " demospace
  235. set demoCount 0
  236. }
  237. demo {
  238. set description [lassign $values name]
  239. .t insert end "[incr demoCount]. [mc $description]" \
  240. [list demo demo-$name]
  241. if {$new} {
  242. .t image create end -image ::img::new -padx 5
  243. set new 0
  244. }
  245. .t insert end " \n " demospace
  246. }
  247. new {
  248. set new 1
  249. }
  250. default {
  251. set style $key
  252. }
  253. }
  254. continue
  255. }
  256. if {!$isNL} {
  257. .t insert end " " $style
  258. }
  259. set isNL 0
  260. .t insert end [mc $line] $style
  261. }
  262. }
  263. addFormattedText {
  264. @@title Tk Widget Demonstrations
  265. This application provides a front end for several short scripts
  266. that demonstrate what you can do with Tk widgets. Each of the
  267. numbered lines below describes a demonstration; you can click on
  268. it to invoke the demonstration. Once the demonstration window
  269. appears, you can click the
  270. @@bold
  271. See Code
  272. @@normal
  273. button to see the Tcl/Tk code that created the demonstration. If
  274. you wish, you can edit the code and click the
  275. @@bold
  276. Rerun Demo
  277. @@normal
  278. button in the code window to reinvoke the demonstration with the
  279. modified code.
  280. @@newline
  281. @@subtitle Labels, buttons, checkbuttons, and radiobuttons
  282. @@demo label Labels (text and bitmaps)
  283. @@demo unicodeout Labels and UNICODE text
  284. @@demo button Buttons
  285. @@demo check Check-buttons (select any of a group)
  286. @@demo radio Radio-buttons (select one of a group)
  287. @@demo puzzle A 15-puzzle game made out of buttons
  288. @@demo icon Iconic buttons that use bitmaps
  289. @@demo image1 Two labels displaying images
  290. @@demo image2 A simple user interface for viewing images
  291. @@demo labelframe Labelled frames
  292. @@demo ttkbut The simple Themed Tk widgets
  293. @@subtitle Listboxes and Trees
  294. @@demo states The 50 states
  295. @@demo colors Colors: change the color scheme for the application
  296. @@demo sayings A collection of famous and infamous sayings
  297. @@demo mclist A multi-column list of countries
  298. @@demo tree A directory browser tree
  299. @@subtitle Entries, Spin-boxes and Combo-boxes
  300. @@demo entry1 Entries without scrollbars
  301. @@demo entry2 Entries with scrollbars
  302. @@demo entry3 Validated entries and password fields
  303. @@demo spin Spin-boxes
  304. @@demo combo Combo-boxes
  305. @@demo form Simple Rolodex-like form
  306. @@subtitle Text
  307. @@demo text Basic editable text
  308. @@demo style Text display styles
  309. @@demo bind Hypertext (tag bindings)
  310. @@demo twind A text widget with embedded windows and other features
  311. @@demo search A search tool built with a text widget
  312. @@demo textpeer Peering text widgets
  313. @@subtitle Canvases
  314. @@demo items The canvas item types
  315. @@demo plot A simple 2-D plot
  316. @@demo ctext Text items in canvases
  317. @@demo arrow An editor for arrowheads on canvas lines
  318. @@demo ruler A ruler with adjustable tab stops
  319. @@demo floor A building floor plan
  320. @@demo cscroll A simple scrollable canvas
  321. @@demo knightstour A Knight's tour of the chess board
  322. @@subtitle Scales and Progress Bars
  323. @@demo hscale Horizontal scale
  324. @@demo vscale Vertical scale
  325. @@new
  326. @@demo ttkscale Themed scale linked to a label with traces
  327. @@demo ttkprogress Progress bar
  328. @@subtitle Paned Windows and Notebooks
  329. @@demo paned1 Horizontal paned window
  330. @@demo paned2 Vertical paned window
  331. @@demo ttkpane Themed nested panes
  332. @@demo ttknote Notebook widget
  333. @@subtitle Menus and Toolbars
  334. @@demo menu Menus and cascades (sub-menus)
  335. @@demo menubu Menu-buttons
  336. @@demo ttkmenu Themed menu buttons
  337. @@demo toolbar Themed toolbar
  338. @@subtitle Common Dialogs
  339. @@demo msgbox Message boxes
  340. @@demo filebox File selection dialog
  341. @@demo clrpick Color picker
  342. @@demo fontchoose Font selection dialog
  343. @@subtitle Animation
  344. @@demo anilabel Animated labels
  345. @@demo aniwave Animated wave
  346. @@demo pendulum Pendulum simulation
  347. @@demo goldberg A celebration of Rube Goldberg
  348. @@subtitle Miscellaneous
  349. @@demo bitmap The built-in bitmaps
  350. @@demo dialog1 A dialog box with a local grab
  351. @@demo dialog2 A dialog box with a global grab
  352. }
  353. ##############################################################################
  354. .t configure -state disabled
  355. focus .s
  356. # addSeeDismiss --
  357. # Add "See Code" and "Dismiss" button frame, with optional "See Vars"
  358. #
  359. # Arguments:
  360. # w - The name of the frame to use.
  361. proc addSeeDismiss {w show {vars {}} {extra {}}} {
  362. ## See Code / Dismiss buttons
  363. ttk::frame $w
  364. ttk::separator $w.sep
  365. #ttk::frame $w.sep -height 2 -relief sunken
  366. grid $w.sep -columnspan 4 -row 0 -sticky ew -pady 2
  367. ttk::button $w.dismiss -text [mc "Dismiss"] \
  368. -image ::img::delete -compound left \
  369. -command [list destroy [winfo toplevel $w]]
  370. ttk::button $w.code -text [mc "See Code"] \
  371. -image ::img::view -compound left \
  372. -command [list showCode $show]
  373. set buttons [list x $w.code $w.dismiss]
  374. if {[llength $vars]} {
  375. ttk::button $w.vars -text [mc "See Variables"] \
  376. -image ::img::view -compound left \
  377. -command [concat [list showVars $w.dialog] $vars]
  378. set buttons [linsert $buttons 1 $w.vars]
  379. }
  380. if {$extra ne ""} {
  381. set buttons [linsert $buttons 1 [uplevel 1 $extra]]
  382. }
  383. grid {*}$buttons -padx 4 -pady 4
  384. grid columnconfigure $w 0 -weight 1
  385. if {[tk windowingsystem] eq "aqua"} {
  386. foreach b [lrange $buttons 1 end] {$b configure -takefocus 0}
  387. grid configure $w.sep -pady 0
  388. grid configure {*}$buttons -pady {10 12}
  389. grid configure [lindex $buttons 1] -padx {16 4}
  390. grid configure [lindex $buttons end] -padx {4 18}
  391. }
  392. return $w
  393. }
  394. # positionWindow --
  395. # This procedure is invoked by most of the demos to position a new demo
  396. # window.
  397. #
  398. # Arguments:
  399. # w - The name of the window to position.
  400. proc positionWindow w {
  401. wm geometry $w +300+300
  402. }
  403. # showVars --
  404. # Displays the values of one or more variables in a window, and updates the
  405. # display whenever any of the variables changes.
  406. #
  407. # Arguments:
  408. # w - Name of new window to create for display.
  409. # args - Any number of names of variables.
  410. proc showVars {w args} {
  411. catch {destroy $w}
  412. toplevel $w
  413. if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
  414. wm title $w [mc "Variable values"]
  415. set b [ttk::frame $w.frame]
  416. grid $b -sticky news
  417. set f [ttk::labelframe $b.title -text [mc "Variable values:"]]
  418. foreach var $args {
  419. ttk::label $f.n$var -text "$var:" -anchor w
  420. ttk::label $f.v$var -textvariable $var -anchor w
  421. grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w
  422. }
  423. ttk::button $b.ok -text [mc "OK"] \
  424. -command [list destroy $w] -default active
  425. bind $w <Return> [list $b.ok invoke]
  426. bind $w <Escape> [list $b.ok invoke]
  427. grid $f -sticky news -padx 4
  428. grid $b.ok -sticky e -padx 4 -pady {6 4}
  429. if {[tk windowingsystem] eq "aqua"} {
  430. $b.ok configure -takefocus 0
  431. grid configure $b.ok -pady {10 12} -padx {16 18}
  432. grid configure $f -padx 10 -pady {10 0}
  433. }
  434. grid columnconfig $f 1 -weight 1
  435. grid rowconfigure $f 100 -weight 1
  436. grid columnconfig $b 0 -weight 1
  437. grid rowconfigure $b 0 -weight 1
  438. grid columnconfig $w 0 -weight 1
  439. grid rowconfigure $w 0 -weight 1
  440. }
  441. # invoke --
  442. # This procedure is called when the user clicks on a demo description. It is
  443. # responsible for invoking the demonstration.
  444. #
  445. # Arguments:
  446. # index - The index of the character that the user clicked on.
  447. proc invoke index {
  448. global tk_demoDirectory
  449. set tags [.t tag names $index]
  450. set i [lsearch -glob $tags demo-*]
  451. if {$i < 0} {
  452. return
  453. }
  454. set cursor [.t cget -cursor]
  455. .t configure -cursor [::ttk::cursor busy]
  456. update
  457. set demo [string range [lindex $tags $i] 5 end]
  458. uplevel 1 [list source [file join $tk_demoDirectory $demo.tcl]]
  459. update
  460. .t configure -cursor $cursor
  461. .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars"
  462. }
  463. # showStatus --
  464. #
  465. # Show the name of the demo program in the status bar. This procedure is
  466. # called when the user moves the cursor over a demo description.
  467. #
  468. proc showStatus index {
  469. set tags [.t tag names $index]
  470. set i [lsearch -glob $tags demo-*]
  471. set cursor [.t cget -cursor]
  472. if {$i < 0} {
  473. .statusBar.lab config -text " "
  474. set newcursor [::ttk::cursor text]
  475. } else {
  476. set demo [string range [lindex $tags $i] 5 end]
  477. .statusBar.lab config -text [mc "Run the \"%s\" sample program" $demo]
  478. set newcursor [::ttk::cursor link]
  479. }
  480. if {$cursor ne $newcursor} {
  481. .t config -cursor $newcursor
  482. }
  483. }
  484. # evalShowCode --
  485. #
  486. # Arguments:
  487. # w - Name of text widget containing code to eval
  488. proc evalShowCode {w} {
  489. set code [$w get 1.0 end-1c]
  490. uplevel #0 $code
  491. }
  492. # showCode --
  493. # This procedure creates a toplevel window that displays the code for a
  494. # demonstration and allows it to be edited and reinvoked.
  495. #
  496. # Arguments:
  497. # w - The name of the demonstration's window, which can be used to
  498. # derive the name of the file containing its code.
  499. proc showCode w {
  500. global tk_demoDirectory
  501. set file [string range $w 1 end].tcl
  502. set top .code
  503. if {![winfo exists $top]} {
  504. toplevel $top
  505. if {[tk windowingsystem] eq "x11"} {wm attributes $top -type dialog}
  506. set t [frame $top.f]
  507. set text [text $t.text -font fixedFont -height 24 -wrap word \
  508. -xscrollcommand [list $t.xscroll set] \
  509. -yscrollcommand [list $t.yscroll set] \
  510. -setgrid 1 -highlightthickness 0 -pady 2 -padx 3]
  511. ttk::scrollbar $t.xscroll -command [list $t.text xview] \
  512. -orient horizontal
  513. ttk::scrollbar $t.yscroll -command [list $t.text yview] \
  514. -orient vertical
  515. grid $t.text $t.yscroll -sticky news
  516. #grid $t.xscroll
  517. grid rowconfigure $t 0 -weight 1
  518. grid columnconfig $t 0 -weight 1
  519. set btns [ttk::frame $top.btns]
  520. ttk::separator $btns.sep
  521. grid $btns.sep -columnspan 4 -row 0 -sticky ew -pady 2
  522. ttk::button $btns.dismiss -text [mc "Dismiss"] \
  523. -default active -command [list destroy $top] \
  524. -image ::img::delete -compound left
  525. ttk::button $btns.print -text [mc "Print Code"] \
  526. -command [list printCode $text $file] \
  527. -image ::img::print -compound left
  528. ttk::button $btns.rerun -text [mc "Rerun Demo"] \
  529. -command [list evalShowCode $text] \
  530. -image ::img::refresh -compound left
  531. set buttons [list x $btns.rerun $btns.print $btns.dismiss]
  532. grid {*}$buttons -padx 4 -pady 4
  533. grid columnconfigure $btns 0 -weight 1
  534. if {[tk windowingsystem] eq "aqua"} {
  535. foreach b [lrange $buttons 1 end] {$b configure -takefocus 0}
  536. grid configure $btns.sep -pady 0
  537. grid configure {*}$buttons -pady {10 12}
  538. grid configure [lindex $buttons 1] -padx {16 4}
  539. grid configure [lindex $buttons end] -padx {4 18}
  540. }
  541. grid $t -sticky news
  542. grid $btns -sticky ew
  543. grid rowconfigure $top 0 -weight 1
  544. grid columnconfig $top 0 -weight 1
  545. bind $top <Return> {
  546. if {[winfo class %W] ne "Text"} { .code.btns.dismiss invoke }
  547. }
  548. bind $top <Escape> [bind $top <Return>]
  549. } else {
  550. wm deiconify $top
  551. raise $top
  552. }
  553. wm title $top [mc "Demo code: %s" [file join $tk_demoDirectory $file]]
  554. wm iconname $top $file
  555. set id [open [file join $tk_demoDirectory $file]]
  556. $top.f.text delete 1.0 end
  557. $top.f.text insert 1.0 [read $id]
  558. $top.f.text mark set insert 1.0
  559. close $id
  560. }
  561. # printCode --
  562. # Prints the source code currently displayed in the See Code dialog. Much
  563. # thanks to Arjen Markus for this.
  564. #
  565. # Arguments:
  566. # w - Name of text widget containing code to print
  567. # file - Name of the original file (implicitly for title)
  568. proc printCode {w file} {
  569. set code [$w get 1.0 end-1c]
  570. set dir "."
  571. if {[info exists ::env(HOME)]} {
  572. set dir "$::env(HOME)"
  573. }
  574. if {[info exists ::env(TMP)]} {
  575. set dir $::env(TMP)
  576. }
  577. if {[info exists ::env(TEMP)]} {
  578. set dir $::env(TEMP)
  579. }
  580. set filename [file join $dir "tkdemo-$file"]
  581. set outfile [open $filename "w"]
  582. puts $outfile $code
  583. close $outfile
  584. switch -- $::tcl_platform(platform) {
  585. unix {
  586. if {[catch {exec lp -c $filename} msg]} {
  587. tk_messageBox -title "Print spooling failure" \
  588. -message "Print spooling probably failed: $msg"
  589. }
  590. }
  591. windows {
  592. if {[catch {PrintTextWin32 $filename} msg]} {
  593. tk_messageBox -title "Print spooling failure" \
  594. -message "Print spooling probably failed: $msg"
  595. }
  596. }
  597. default {
  598. tk_messageBox -title "Operation not Implemented" \
  599. -message "Wow! Unknown platform: $::tcl_platform(platform)"
  600. }
  601. }
  602. #
  603. # Be careful to throw away the temporary file in a gentle manner ...
  604. #
  605. if {[file exists $filename]} {
  606. catch {file delete $filename}
  607. }
  608. }
  609. # PrintTextWin32 --
  610. # Print a file under Windows using all the "intelligence" necessary
  611. #
  612. # Arguments:
  613. # filename - Name of the file
  614. #
  615. # Note:
  616. # Taken from the Wiki page by Keith Vetter, "Printing text files under
  617. # Windows".
  618. # Note:
  619. # Do not execute the command in the background: that way we can dispose of the
  620. # file smoothly.
  621. #
  622. proc PrintTextWin32 {filename} {
  623. package require registry
  624. set app [auto_execok notepad.exe]
  625. set pcmd "$app /p %1"
  626. catch {
  627. set app [registry get {HKEY_CLASSES_ROOT\.txt} {}]
  628. set pcmd [registry get \
  629. {HKEY_CLASSES_ROOT\\$app\\shell\\print\\command} {}]
  630. }
  631. regsub -all {%1} $pcmd $filename pcmd
  632. puts $pcmd
  633. regsub -all {\\} $pcmd {\\\\} pcmd
  634. set command "[auto_execok start] /min $pcmd"
  635. eval exec $command
  636. }
  637. # tkAboutDialog --
  638. #
  639. # Pops up a message box with an "about" message
  640. #
  641. proc tkAboutDialog {} {
  642. tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \
  643. -message [mc "Tk widget demonstration application"] -detail \
  644. "[mc "Copyright \u00a9 %s" {1996-1997 Sun Microsystems, Inc.}]
  645. [mc "Copyright \u00a9 %s" {1997-2000 Ajuba Solutions, Inc.}]
  646. [mc "Copyright \u00a9 %s" {2001-2009 Donal K. Fellows}]
  647. [mc "Copyright \u00a9 %s" {2002-2007 Daniel A. Steffen}]"
  648. }
  649. # Local Variables:
  650. # mode: tcl
  651. # End: