neingeist
/
arduinisten
Archived
1
0
Fork 0
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.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

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"
}