path: root/libgui/library/print.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"
}