Add 'Print Code' support to Widget demo [Patch 835644]

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