share/redhat/gui/print.tcl - toolchains/skids - Git at Google

 # print.tcl -- some procedures for dealing with printing.  To print
 # PostScript on Windows, tkmswin.dll will need to be present.

 proc send_printer { args } {
     global tcl_platform

     parse_args {
 	{printer {}}
 	{outfile {}}
 	{parent {}}
 	ascii
 	file
     }

     if {[llength $args] == 0} {
 	error "No filename or data provided."
     }

     if {$ascii == 1} {
 	if {$tcl_platform(platform) == "windows"} then {
 	    PRINT_windows_ascii -file $file -parent $parent [lindex $args 0]
 	} else {
 	    send_printer_ascii -printer $printer -file $file \
 		    -outfile $outfile [lindex $args 0]
 	}
 	return
     }

     if {$outfile != ""} {
 	if {$file} {
 	    file copy [lindex 0 $args] $outfile
 	} else {
 	    set F [open $outfile w]
 	    puts $F [lindex 0 $args]
 	    close $F
 	}
 	return
     }

     if {$tcl_platform(platform) == "windows"} then {
 	load tkmswin.dll

 	set cmd {tkmswin print -postscript}
 	if {$printer != ""} {
 	    lappend cmd -printer $printer
 	}
 	if {$file} {
 	    lappend cmd -file
 	}
 	lappend cmd [lindex $args 0]
 	eval $cmd

     } else {

 	# Unix box, assume lpr, but if it fails try lp.
 	foreach prog {lpr lp} {
 	    set cmd [list exec $prog]
 	    if {$printer != ""} {
 		if {$prog == "lpr"} {
 		    lappend cmd "-P$printer"
 		} else {
 		    lappend cmd "-d$printer"
 		}
 	    }
 	    if {$file} {
 		lappend cmd "<"
 	    } else {
 		lappend cmd "<<"
 	    }
 	    # tack on data or filename
 	    lappend cmd [lindex $args 0]

 	    # attempt to run the command, and exit if successful
 	    if ![catch {eval $cmd} ret] {
 		return
 	    }
 	}
 	error "Couldn't run either `lpr' or `lp' to print"
     }
 }

 proc send_printer_ascii { args } {
     global tcl_platform

     parse_args {
 	{printer {}}
 	{outfile {}}
 	{file 0}
 	{font Courier}
 	{fontsize 10}
 	{pageheight 11}
 	{pagewidth 8.5}
 	{margin .5}
     }
     if {[llength $args] == 0} {
 	error "No filename or data provided."
     }

     if {$tcl_platform(platform) == "windows"} then {
 	PRINT_windows_ascii -file $file [lindex $args 0]
 	return
     }

     # convert the filename or data to ascii, and then send to the printer.

     set inch 72
     set pageheight [expr $pageheight*$inch]
     set pagewidth [expr $pagewidth*$inch]
     set margin [expr $margin*$inch]

     set output "%!PS-Adobe-1.0\n"
     append output "%%Creator: libgui ASCII-to-PS converter\n"
     append output "%%DocumentFonts: $font\n"
     append output "%%Pages: (atend)\n"
     append output "/$font findfont $fontsize scalefont setfont\n"
     append output "/M{moveto}def\n"
     append output "/S{show}def\n"

     set pages 1
     set y [expr $pageheight-$margin-$fontsize]

     if {$file == 1} {
 	set G [open [lindex $args 0] r]
 	set strlen [gets $G str]
     } else {
 	# make sure that we end with a newline
 	set args [lindex $args 0]
 	append args "\n"

 	set strlen [string first "\n" $args]
 	if {$strlen != -1} {
 	    set str [string range $args 0 [expr $strlen-1]]
 	    set args [string range $args [expr $strlen+1] end]
 	}
     }
     while {$strlen != -1} {
 	if {$y < $margin} {
 	    append output "showpage\n"
 	    incr pages
 	    set y [expr $pageheight-$margin-$fontsize]
 	}
 	regsub -all {[()\\]} $str {\\&} str
 	append output "$margin $y M ($str) S\n"
 	set y [expr $y-($fontsize+1)]

 	if {$file == 1} {
 	    set strlen [gets $G str]
 	} else {
 	    set strlen [string first "\n" $args]
 	    if {$strlen != -1} {
 		set str [string range $args 0 [expr $strlen-1]]
 		set args [string range $args [expr $strlen+1] end]
 	    }
 	}

     }
     append output "showpage\n"
     append output "%%Pages: $pages\n"

     if {$file == 1} {
 	close $G
     }

     send_printer -printer $printer -outfile $outfile $output
 }

 # Print ASCII text on Windows.

 proc PRINT_windows_ascii { args } {
     global tcl_platform errorInfo
     global PRINT_state

     parse_args {
 	{file 0}
 	{parent {}}
     }
     if {[llength $args] == 0} {
 	error "No filename or data provided."
     }

     if {$tcl_platform(platform) != "windows"} then {
 	error "Only works on Windows"
     }

     # Copied from tk_dialog, except that it returns.
     catch {destroy .cancelprint}
     toplevel .cancelprint -class Dialog
     wm withdraw .cancelprint
     wm title .cancelprint [gettext "Printing"]
     frame .cancelprint.bot
     frame .cancelprint.top
     pack .cancelprint.bot -side bottom -fill both
     pack .cancelprint.top -side top -fill both -expand 1
     set PRINT_state(pageno) [format [gettext "Now printing page %d"] 0]
     label .cancelprint.msg -justify left -textvariable PRINT_state(pageno)
     pack .cancelprint.msg -in .cancelprint.top -side right -expand 1 \
 	    -fill both -padx 1i -pady 5
     button .cancelprint.button -text [gettext "Cancel"] \
 	    -command { ide_winprint abort } -default active
     grid .cancelprint.button -in .cancelprint.bot -column 0 -row 0 \
 	    -sticky ew -padx 10
     grid columnconfigure .cancelprint.bot 0

     update idletasks
     set x [expr [winfo screenwidth .cancelprint]/2 \
 	    - [winfo reqwidth .cancelprint]/2 \
 	    - [winfo vrootx [winfo parent .cancelprint]]]
     set y [expr [winfo screenheight .cancelprint]/2 \
 	    - [winfo reqheight .cancelprint]/2 \
 	    - [winfo vrooty [winfo parent .cancelprint]]]
     wm geom .cancelprint +$x+$y
     update

     # We're going to change the focus and the grab as soon as we start
     # printing, so remember them now.
     set oldFocus [focus]
     set oldGrab [grab current .cancelprint]
     if {$oldGrab != ""} then {
 	set grabStatus [grab status $oldGrab]
     }

     focus .cancelprint.button

     set PRINT_state(start) 1
     set PRINT_state(file) $file
     if {$file == 1} then {
 	set PRINT_state(fp) [open [lindex $args 0] r]
     } else {
 	set PRINT_state(text) [lindex $args 0]
     }

     set cmd [list ide_winprint print_text PRINT_query PRINT_text \
 	       -pageproc PRINT_page]
     if {$parent != {}} then {
 	lappend cmd -parent $parent
     }

     set code [catch $cmd errmsg]
     set errinfo $errorInfo

     catch { focus $oldFocus }
     catch { destroy .cancelprint }
     if {$oldGrab != ""} then {
 	if {$grabStatus == "global"} then {
 	    grab -global $oldGrab
 	} else {
 	    grab $oldGrab
 	}
     }

     if {$code == 1} then {
 	error $errmsg $errinfo
     }
 }

 # The query procedure passed to ide_winprint print_text.  This should
 # return one of "continue", "done", or "newpage".

 proc PRINT_query { } {
     global PRINT_state

     # Fetch the next line into PRINT_state(str).

     if {$PRINT_state(file) == 1} then {
 	set strlen [gets $PRINT_state(fp) PRINT_state(str)]
     } else {
 	set strlen [string first "\n" $PRINT_state(text)]
 	if {$strlen != -1} then {
 	    set PRINT_state(str) \
 		    [string range $PRINT_state(text) 0 [expr $strlen-1]]
 	    set PRINT_state(text) \
 		    [string range $PRINT_state(text) [expr $strlen+1] end]
 	} else {
 	    if {$PRINT_state(text) != ""} then {
 		set strlen 0
 		set PRINT_state(str) $PRINT_state(text)
 		set PRINT_state(text) ""
 	    }
 	}
     }

     if {$strlen != -1} then {

 	# Expand tabs assuming tabstops every 8 spaces and a fixed
 	# pitch font.  Text written to other assumptions will have to
 	# be handled by the caller.

 	set str $PRINT_state(str)
 	while {[set i [string first "\t" $str]] >= 0} {
 	    set c [expr 8 - ($i % 8)]
 	    set spaces ""
 	    while {$c > 0} {
 		set spaces "$spaces "
 		incr c -1
 	    }
 	    set str "[string range $str 0 [expr $i - 1]]$spaces[string range $str [expr $i + 1] end]"
 	}
 	set PRINT_state(str) $str

 	return "continue"
     } else {
 	return "done"
     }
 }

 # The text procedure passed to ide_winprint print_text.  This should
 # return the next line to print.

 proc PRINT_text { } {
     global PRINT_state

     return $PRINT_state(str)
 }

 # This page procedure passed to ide_winprint print_text.  This is
 # called at the start of each page.

 proc PRINT_page { pageno } {
     global PRINT_state

     set PRINT_state(pageno) [format [gettext "Now printing page %d"] $pageno]

     if {$PRINT_state(start)} then {
 	wm deiconify .cancelprint

 	grab .cancelprint
 	focus .cancelprint.button

 	set PRINT_state(start) 0
     }

     update
     return "continue"
 }
	# print.tcl -- some procedures for dealing with printing. To print
	# PostScript on Windows, tkmswin.dll will need to be present.

	proc send_printer { args } {
	global tcl_platform

	parse_args {
	{printer {}}
	{outfile {}}
	{parent {}}
	ascii
	file
	}

	if {[llength $args] == 0} {
	error "No filename or data provided."
	}

	if {$ascii == 1} {
	if {$tcl_platform(platform) == "windows"} then {
	PRINT_windows_ascii -file $file -parent $parent [lindex $args 0]
	} else {
	send_printer_ascii -printer $printer -file $file \
	-outfile $outfile [lindex $args 0]
	}
	return
	}

	if {$outfile != ""} {
	if {$file} {
	file copy [lindex 0 $args] $outfile
	} else {
	set F [open $outfile w]
	puts $F [lindex 0 $args]
	close $F
	}
	return
	}

	if {$tcl_platform(platform) == "windows"} then {
	load tkmswin.dll

	set cmd {tkmswin print -postscript}
	if {$printer != ""} {
	lappend cmd -printer $printer
	}
	if {$file} {
	lappend cmd -file
	}
	lappend cmd [lindex $args 0]
	eval $cmd

	} else {

	# Unix box, assume lpr, but if it fails try lp.
	foreach prog {lpr lp} {
	set cmd [list exec $prog]
	if {$printer != ""} {
	if {$prog == "lpr"} {
	lappend cmd "-P$printer"
	} else {
	lappend cmd "-d$printer"
	}
	}
	if {$file} {
	lappend cmd "<"
	} else {
	lappend cmd "<<"
	}
	# tack on data or filename
	lappend cmd [lindex $args 0]

	# attempt to run the command, and exit if successful
	if ![catch {eval $cmd} ret] {
	return
	}
	}
	error "Couldn't run either `lpr' or `lp' to print"
	}
	}

	proc send_printer_ascii { args } {
	global tcl_platform

	parse_args {
	{printer {}}
	{outfile {}}
	{file 0}
	{font Courier}
	{fontsize 10}
	{pageheight 11}
	{pagewidth 8.5}
	{margin .5}
	}
	if {[llength $args] == 0} {
	error "No filename or data provided."
	}

	if {$tcl_platform(platform) == "windows"} then {
	PRINT_windows_ascii -file $file [lindex $args 0]
	return
	}

	# convert the filename or data to ascii, and then send to the printer.

	set inch 72
	set pageheight [expr $pageheight*$inch]
	set pagewidth [expr $pagewidth*$inch]
	set margin [expr $margin*$inch]

	set output "%!PS-Adobe-1.0\n"
	append output "%%Creator: libgui ASCII-to-PS converter\n"
	append output "%%DocumentFonts: $font\n"
	append output "%%Pages: (atend)\n"
	append output "/$font findfont $fontsize scalefont setfont\n"
	append output "/M{moveto}def\n"
	append output "/S{show}def\n"

	set pages 1
	set y [expr $pageheight-$margin-$fontsize]

	if {$file == 1} {
	set G [open [lindex $args 0] r]
	set strlen [gets $G str]
	} else {
	# make sure that we end with a newline
	set args [lindex $args 0]
	append args "\n"

	set strlen [string first "\n" $args]
	if {$strlen != -1} {
	set str [string range $args 0 [expr $strlen-1]]
	set args [string range $args [expr $strlen+1] end]
	}
	}
	while {$strlen != -1} {
	if {$y < $margin} {
	append output "showpage\n"
	incr pages
	set y [expr $pageheight-$margin-$fontsize]
	}
	regsub -all {[()\\]} $str {\\&} str
	append output "$margin $y M ($str) S\n"
	set y [expr $y-($fontsize+1)]

	if {$file == 1} {
	set strlen [gets $G str]
	} else {
	set strlen [string first "\n" $args]
	if {$strlen != -1} {
	set str [string range $args 0 [expr $strlen-1]]
	set args [string range $args [expr $strlen+1] end]
	}
	}

	}
	append output "showpage\n"
	append output "%%Pages: $pages\n"

	if {$file == 1} {
	close $G
	}

	send_printer -printer $printer -outfile $outfile $output
	}

	# Print ASCII text on Windows.

	proc PRINT_windows_ascii { args } {
	global tcl_platform errorInfo
	global PRINT_state

	parse_args {
	{file 0}
	{parent {}}
	}
	if {[llength $args] == 0} {
	error "No filename or data provided."
	}

	if {$tcl_platform(platform) != "windows"} then {
	error "Only works on Windows"
	}

	# Copied from tk_dialog, except that it returns.
	catch {destroy .cancelprint}
	toplevel .cancelprint -class Dialog
	wm withdraw .cancelprint
	wm title .cancelprint [gettext "Printing"]
	frame .cancelprint.bot
	frame .cancelprint.top
	pack .cancelprint.bot -side bottom -fill both
	pack .cancelprint.top -side top -fill both -expand 1
	set PRINT_state(pageno) [format [gettext "Now printing page %d"] 0]
	label .cancelprint.msg -justify left -textvariable PRINT_state(pageno)
	pack .cancelprint.msg -in .cancelprint.top -side right -expand 1 \
	-fill both -padx 1i -pady 5
	button .cancelprint.button -text [gettext "Cancel"] \
	-command { ide_winprint abort } -default active
	grid .cancelprint.button -in .cancelprint.bot -column 0 -row 0 \
	-sticky ew -padx 10
	grid columnconfigure .cancelprint.bot 0

	update idletasks
	set x [expr [winfo screenwidth .cancelprint]/2 \
	- [winfo reqwidth .cancelprint]/2 \
	- [winfo vrootx [winfo parent .cancelprint]]]
	set y [expr [winfo screenheight .cancelprint]/2 \
	- [winfo reqheight .cancelprint]/2 \
	- [winfo vrooty [winfo parent .cancelprint]]]
	wm geom .cancelprint +$x+$y
	update

	# We're going to change the focus and the grab as soon as we start
	# printing, so remember them now.
	set oldFocus [focus]
	set oldGrab [grab current .cancelprint]
	if {$oldGrab != ""} then {
	set grabStatus [grab status $oldGrab]
	}

	focus .cancelprint.button

	set PRINT_state(start) 1
	set PRINT_state(file) $file
	if {$file == 1} then {
	set PRINT_state(fp) [open [lindex $args 0] r]
	} else {
	set PRINT_state(text) [lindex $args 0]
	}

	set cmd [list ide_winprint print_text PRINT_query PRINT_text \
	-pageproc PRINT_page]
	if {$parent != {}} then {
	lappend cmd -parent $parent
	}

	set code [catch $cmd errmsg]
	set errinfo $errorInfo

	catch { focus $oldFocus }
	catch { destroy .cancelprint }
	if {$oldGrab != ""} then {
	if {$grabStatus == "global"} then {
	grab -global $oldGrab
	} else {
	grab $oldGrab
	}
	}

	if {$code == 1} then {
	error $errmsg $errinfo
	}
	}

	# The query procedure passed to ide_winprint print_text. This should
	# return one of "continue", "done", or "newpage".

	proc PRINT_query { } {
	global PRINT_state

	# Fetch the next line into PRINT_state(str).

	if {$PRINT_state(file) == 1} then {
	set strlen [gets $PRINT_state(fp) PRINT_state(str)]
	} else {
	set strlen [string first "\n" $PRINT_state(text)]
	if {$strlen != -1} then {
	set PRINT_state(str) \
	[string range $PRINT_state(text) 0 [expr $strlen-1]]
	set PRINT_state(text) \
	[string range $PRINT_state(text) [expr $strlen+1] end]
	} else {
	if {$PRINT_state(text) != ""} then {
	set strlen 0
	set PRINT_state(str) $PRINT_state(text)
	set PRINT_state(text) ""
	}
	}
	}

	if {$strlen != -1} then {

	# Expand tabs assuming tabstops every 8 spaces and a fixed
	# pitch font. Text written to other assumptions will have to
	# be handled by the caller.

	set str $PRINT_state(str)
	while {[set i [string first "\t" $str]] >= 0} {
	set c [expr 8 - ($i % 8)]
	set spaces ""
	while {$c > 0} {
	set spaces "$spaces "
	incr c -1
	}
	set str "[string range $str 0 [expr $i - 1]]$spaces[string range $str [expr $i + 1] end]"
	}
	set PRINT_state(str) $str

	return "continue"
	} else {
	return "done"
	}
	}

	# The text procedure passed to ide_winprint print_text. This should
	# return the next line to print.

	proc PRINT_text { } {
	global PRINT_state

	return $PRINT_state(str)
	}

	# This page procedure passed to ide_winprint print_text. This is
	# called at the start of each page.

	proc PRINT_page { pageno } {
	global PRINT_state

	set PRINT_state(pageno) [format [gettext "Now printing page %d"] $pageno]

	if {$PRINT_state(start)} then {
	wm deiconify .cancelprint

	grab .cancelprint
	focus .cancelprint.button

	set PRINT_state(start) 0
	}

	update
	return "continue"
	}