summaryrefslogtreecommitdiffstats
path: root/library/demos/widget
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2003-11-04 13:26:33 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2003-11-04 13:26:33 (GMT)
commitb18bd686d4087700be99e8047262921ce9f9380f (patch)
treef6b1db3e341f22c1860226544b27f6ad92e16924 /library/demos/widget
parentcc145a23218a5bfacb8aaf799203c070812be5fe (diff)
downloadtk-b18bd686d4087700be99e8047262921ce9f9380f.zip
tk-b18bd686d4087700be99e8047262921ce9f9380f.tar.gz
tk-b18bd686d4087700be99e8047262921ce9f9380f.tar.bz2
Add 'Print Code' support to Widget demo [Patch 835644]
Diffstat (limited to 'library/demos/widget')
-rw-r--r--library/demos/widget124
1 files changed, 122 insertions, 2 deletions
diff --git a/library/demos/widget b/library/demos/widget
index 65bdb4c..da680d1 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -11,7 +11,7 @@ exec wish "$0" "$@"
# ".tcl" files is this directory, which are sourced by this script
# as needed.
#
-# RCS: @(#) $Id: widget,v 1.18 2003/11/03 15:30:45 dkf Exp $
+# RCS: @(#) $Id: widget,v 1.19 2003/11/04 13:26:33 dkf Exp $
package require Tcl 8.4
package require Tk 8.4
@@ -64,6 +64,34 @@ image create photo ::img::delete -height 16 -format GIF -data {
lI9pAKHbIHNoVhYhTdjlJ2AWKG2g+CldmB6rxo2uybYhbS80eRQAOw==
}
+image create photo ::img::print -height 19 -format GIF -data {
+ R0lGODlhGgATAPcAACEQOTEpQjEpUkIpc0IxY0I5c0oxjEo5SlJCY1JCe1JK
+ UlpChFpCjFpGkFpSc1paa2NKc2NKnGNja2tapWtjc29KnHNanHNjc3NjrXNr
+ jHNrnHNzc3tjpXtrtXtzhICAgIRzvYSEjIZzqox7tYyEnIyMjJSEtZSEvZSM
+ lJyMtZyMvZyUlJyUrZyUvZycnKWctaWlpa2czq2lzrWtvbWtzrW1tb21xr21
+ 1sa9zs693s7OztbO3tbO597W1t7W7+fe7+fn5////+/n7+/v7+/v9////wAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAACH5BAEAAEEALAAAAAAaABMAQAj/AIMIHBhkg0GC
+ CBMGIQEiQgseQT4oeCBBAokgRYYQ0JBixg8hRIiUUEBBYYmTByBwiCBCRYwH
+ CxY8cKFw4AogRXLqLAJkQ80gCBBg3BkxZswTNGh4MGqgQQUMJRHCwMkTSE+D
+ Pn8eCKBhxIMhO3ei2OHDBw6sWSlMMMoWgwwfMDZI8GBjx44NARZwEGGi5MkS
+ PcIWKRGz5YgLbAco+KkQBQoJIRgjdGEVq+SaJajqtNrzMgsPCmoIzqmDgmWE
+ KOBuUKAAwYabYTfs4OHjY0giGyhk4MAWRI4eKyRQqPgggYUXPH4A+XBAgwoK
+ DiIsCFxjA9sFEVQQCRJCAYAFDJxiKhAxvMTonEFimrhhYinTBgWiCvxLNX3M
+ DkkpsKV5OYhjBxCMYAICAigUEAA7
+}
+
#----------------------------------------------------------------
# The code below create the main window, consisting of a menu bar
# and a text widget that explains how to use the program, plus lists
@@ -475,11 +503,14 @@ proc showCode w {
button $btns.dismiss -text [mc "Dismiss"] \
-default active -command [list destroy $top] \
-image ::img::delete -compound left
+ button $btns.print -text [mc "Print Code"] \
+ -command [list printCode $text $file] \
+ -image ::img::print -compound left
button $btns.rerun -text [mc "Rerun Demo"] \
-command [list evalShowCode $text] \
-image ::img::refresh -compound left
- grid x $btns.rerun $btns.dismiss -padx 4 -pady {6 4}
+ grid x $btns.rerun $btns.print $btns.dismiss -padx 4 -pady {6 4}
grid columnconfigure $btns 0 -weight 1
grid $t -sticky news
@@ -504,6 +535,95 @@ proc showCode w {
close $id
}
+# printCode --
+# Prints the source code currently displayed in the See Code dialog.
+# Much thanks to Arjen Markus for this.
+#
+# Arguments:
+# w - Name of text widget containing code to print
+# file - Name of the original file (implicitly for title)
+
+proc printCode {w file} {
+ set code [$w get 1.0 end-1c]
+
+ set dir "."
+ if {[info exists ::env(HOME)]} {
+ set dir "$::env(HOME)"
+ }
+ if {[info exists ::env(TMP)]} {
+ set dir $::env(TMP)
+ }
+ if {[info exists ::env(TEMP)]} {
+ set dir $::env(TEMP)
+ }
+
+ set filename [file join $dir "tkdemo-$file"]
+ set outfile [open $filename "w"]
+ puts $outfile $code
+ close $outfile
+
+ switch -- $::tcl_platform(platform) {
+ unix {
+ if {[catch {exec lp -c $filename} msg]} {
+ tk_messageBox -title "Print spooling failure" \
+ -message "Print spooling probably failed: $msg"
+ }
+ }
+ windows {
+ if {[catch {PrintTextWin32 $filename} msg]} {
+ tk_messageBox -title "Print spooling failure" \
+ -message "Print spooling probably failed: $msg"
+ }
+ }
+ macintosh {
+ tk_messageBox -title "Operation not Implemented" \
+ -message "Oops, sorry: not implemented yet!"
+ }
+ default {
+ tk_messageBox -title "Operation not Implemented" \
+ -message "Wow! Unknown platform: $::tcl_platform(platform)"
+ }
+ }
+
+ #
+ # Be careful to throw away the temporary file in a gentle manner ...
+ #
+ if {[file exists $filename]} {
+ catch {file delete $filename}
+ }
+}
+
+# PrintTextWin32 --
+# Print a file under Windows using all the "intelligence" necessary
+#
+# Arguments:
+# filename - Name of the file
+#
+# Note:
+# Taken from the Wiki page by Keith Vetter, "Printing text files
+# under Windows"
+# Note:
+# Do not execute the command in the background: that way we can dispose
+# of the file smoothly
+#
+proc PrintTextWin32 {filename} {
+ package require registry
+ set app [auto_execok notepad.exe]
+ set pcmd "$app /p %1"
+ catch {
+ set app [registry get {HKEY_CLASSES_ROOT\.txt} {}]
+ set pcmd [registry get \
+ {HKEY_CLASSES_ROOT\\$app\\shell\\print\\command} {}]
+ }
+
+ regsub -all {%1} $pcmd $filename pcmd
+ puts $pcmd
+
+ regsub -all {\\} $pcmd {\\\\} pcmd
+ set command "[auto_execok start] /min $pcmd"
+ eval exec $command
+}
+
# aboutBox --
#
# Pops up a message box with an "about" message