You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
335 lines
7.9 KiB
Tcl
335 lines
7.9 KiB
Tcl
# 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"
|
|
}
|