(backport) Merge tkprint-cups branch. Ok by Kevin Walzer

1 files changed, 567 insertions, 232 deletions

diff --git a/library/print.tcl b/library/print.tcl
index 1a7f710..5908b41 100644
--- a/library/print.tcl
+++ b/library/print.tcl
@@ -652,271 +652,606 @@ namespace eval ::tk::print {
 	_init_print_canvas
     }
     #end win32 procedures
+}
+
+# Begin X11 procedures. They depends on Cups being installed.
+# X11 procedures abstracts print management with a "cups" ensemble command
+
+#	cups defaultprinter	returns the default printer
+#	cups getprinters	returns a dictionary of printers along
+#				with printer info
+#	cups print $printer $data ?$options?
+#				print the data (binary) on a given printer
+#				with the provided (supported) options:
+#				-colormode -copies -format -margins
+# 				-media -nup -orientation
+#				-prettyprint -title -tzoom
+
+# Some output configuration that on other platforms is managed through
+# the printer driver/dialog is configured through the canvas postscript command.
+if {[tk windowingsystem] eq "x11"} {
+    if {[info commands ::tk::print::cups] eq ""} {
+	namespace eval ::tk::print::cups {
+	    # Pure Tcl cups ensemble command implementation
+	    variable pcache
+	}
+
+	proc ::tk::print::cups::defaultprinter {} {
+	    set default {}
+	    regexp {: ([^[:space:]]+)$} [exec lpstat -d] _ default
+	    return $default
+	}
+
+	proc ::tk::print::cups::getprinters {} {
+	    variable pcache
+	    # Test for existence of lpstat command to obtain the list of
+	    # printers.
+	    # Return an error if not found.
+	    set res {}
+	    try {
+		set printers [lsort -unique [split [exec lpstat -e] \n]]
+		foreach printer $printers {
+		    set options [Parseoptions [exec lpoptions -p $printer]]
+		    dict set res $printer $options
+		}
+	    } trap {POSIX ENOENT} {e o} {
+		# no such command in PATH
+		set cmd [lindex [dict get $o -errorstack ] 1 2]
+		return -code error "Unable to obtain the list of printers.\
+		    Command \"$cmd\" not found.\
+		    Please install the CUPS package for your system."
+	    } trap {CHILDSTATUS} {} {
+		# command returns a non-0 exit status. Wrong print system?
+		set cmd [lindex [dict get $o -errorstack ] 1 2]
+		return -code error "Command \"$cmd\" return with errors"
+	    }
+	    return [set pcache $res]
+	}
+
+	# Parseoptions
+	#   Parse lpoptions -d output. It has three forms
+	#     option-key
+	#     option-key=option-value
+	#     option-key='option value with spaces'
+	# Arguments:
+	#   data - data to process.
+	#
+	proc ::tk::print::cups::Parseoptions {data} {
+	    set res {}
+	    set re {[^ =]+|[^ ]+='[^']+'|[^ ]+=[^ ']+}
+	    foreach tok [regexp -inline -all $re $data] {
+		lassign [split $tok "="] k v
+		dict set res $k [string trim $v "'"]
+	    }
+	    return $res
+	}
+
+	proc ::tk::print::cups::print {printer data args} {
+	    variable pcache
+	    if {$printer ni [dict keys $pcache]} {
+		return -code error "unknown printer or class \"$printer\""
+	    }
+	    set title "Tk print job"
+	    set options {
+		-colormode -copies -format -margins -media -nup -orientation
+		-prettyprint -title -tzoom
+	    }
+	    while {[llength $args]} {
+		set opt [tcl::prefix match $options [lpop args 0]]
+		switch  $opt {
+		    -colormode {
+			set opts {auto monochrome color}
+			set val [tcl::prefix match $opts [lpop args 0]]
+			lappend printargs -o print-color-mode=$val
+		    }
+		    -copies {
+			set val [lpop args 0]
+			if {![string is integer -strict $val] ||
+			    $val < 0 || $val > 100
+			} {
+			    # save paper !!
+			    return -code error "copies must be an integer\
+				between 0 and 100"
+			}
+			lappend printargs -o copies=$val
+		    }
+		    -format {
+			set opts {auto pdf postscript text}
+			set val [tcl::prefix match $opts [lpop args 0]]
+			# lpr uses auto always
+		    }
+		    -margins {
+			set val [lpop args 0]
+			if {[llength $val] != 4 ||
+			    ![string is integer -strict [lindex $val 0]] ||
+			    ![string is integer -strict [lindex $val 1]] ||
+			    ![string is integer -strict [lindex $val 2]] ||
+			    ![string is integer -strict [lindex $val 3]]
+			} {
+			    return -code error "margins must be a list of 4\
+				integers: top left bottom right"
+			}
+			lappend printargs -o page-top=[lindex $val 0]
+			lappend printargs -o page-left=[lindex $val 1]
+			lappend printargs -o page-bottom=[lindex $val 2]
+			lappend printargs -o page-right=[lindex $val 3]
+		    }
+		    -media {
+			set opts {a4 legal letter}
+			set val [tcl::prefix match $opts [lpop args 0]]
+			lappend printargs -o media=$val
+		    }
+		    -nup {
+			set val [lpop args 0]
+			if {$val ni {1 2 4 6 9 16}} {
+			    return -code error "number-up must be 1, 2, 4, 6, 9 or\
+				16"
+			}
+			lappend printargs -o number-up=$val
+		    }
+		    -orientation {
+			set opts {portrait landscape}
+			set val [tcl::prefix match $opts [lpop args 0]]
+			if {$val eq "landscape"}
+			lappend printargs -o landscape=true
+		    }
+		    -prettyprint {
+			lappend printargs -o prettyprint=true
+			# prettyprint mess with these default values if set
+			# so we force them.
+			# these will be overriden if set after this point
+			if {[lsearch $printargs {cpi=*}] == -1} {
+			    lappend printargs -o cpi=10.0
+			    lappend printargs -o lpi=6.0
+			}
+		    }
+		    -title {
+			set title [lpop args 0]
+		    }
+		    -tzoom {
+			set val [lpop args 0]
+			if {![string is double -strict $val] ||
+			    $val < 0.5 || $val > 2.0
+			 } {
+			    return -code error "text zoom must be a number between\
+				0.5 and 2.0"
+			}
+			# CUPS text filter defaults to lpi=6 and cpi=10
+			lappend printargs -o cpi=[expr {10.0 / $val}]
+			lappend printargs -o lpi=[expr {6.0 / $val}]
+		    }
+		    default {
+			# shouldn't happen
+		    }
+		}
+	    }
+	    # build our options
+	    lappend printargs -T $title
+	    lappend printargs -P $printer
+	    # open temp file
+	    set fd [file tempfile fname tk_print]
+	    chan configure $fd -encoding binary -translation binary
+	    chan puts $fd $data
+	    chan close $fd
+	    # add -r to automatically delete temp files
+	    exec lpr {*}$printargs -r $fname &
+	}
 
-    #begin X11 procedures
+	namespace eval ::tk::print::cups {
+	    namespace export defaultprinter getprinters print
+	    namespace ensemble create
+	}
+    };# ::tk::print::cups
+
+    namespace eval ::tk::print {
+
+	variable mcmap
+	set mcmap(media) [dict create \
+	    [mc "Letter"]	letter \
+	    [mc "Legal"]	legal \
+	    [mc "A4"]		a4]
+	set mcmap(orient) [dict create \
+	    [mc "Portrait"]	portrait \
+	    [mc "Landscape"]	landscape]
+	set mcmap(color) [dict create \
+	    [mc "RGB"]		color \
+	    [mc "Grayscale"]	gray]
+
+	# available print options
+	variable optlist
+	set optlist(printer)	{}
+	set optlist(media)	[dict keys $mcmap(media)]
+	set optlist(orient)	[dict keys $mcmap(orient)]
+	set optlist(color)	[dict keys $mcmap(color)]
+	set optlist(number-up)	{1 2 4 6 9 16}
 
-    # X11 procedures wrap standard Unix shell commands such as lp/lpr and
-    # lpstat for printing. Some output configuration that on other platforms
-    # is managed through the printer driver/dialog is configured through the
-    # canvas postscript command.
+	# selected options
+	variable option
+	set option(printer)	{}
+	# Initialize with sane defaults.
+	set option(copies)	1
+	set option(media)	[mc "A4"]
+	# Canvas options
+	set option(orient)	[mc "Portrait"]
+	set option(color)	[mc "RGB"]
+	set option(czoom)	100
+	# Text options.
+	# See libcupsfilter's cfFilterTextToPDF() and cups-filters's texttopdf
+	# known options:
+	# prettyprint, wrap, columns, lpi, cpi
+	set option(number-up)	1
+	set option(tzoom)	100; # we derive lpi and cpi from this value
+	set option(pprint)	0  ; # pretty print
+	set option(margin-top)	20 ; # ~ 7mm (~ 1/4")
+	set option(margin-left)	20 ; # ~ 7mm (~ 1/4")
+	set option(margin-right)  20 ; # ~ 7mm (~ 1/4")
+	set option(margin-bottom) 20 ; # ~ 7mm (~ 1/4")
+
+	# array to collect printer information
+	variable pinfo
+	array set pinfo {}
+
+	# a map for printer state -> human readable message
+	variable statemap
+	dict set statemap 3 [mc "Idle"]
+	dict set statemap 4 [mc "Printing"]
+	dict set statemap 5 [mc "Printer stopped"]
+    }
 
-    if {[tk windowingsystem] eq "x11"} {
-	variable printcmd {}
+    # ttk version of [tk_optionMenu]
+    # var should be a full qualified varname
+    proc ::tk::print::ttk_optionMenu {w var args} {
+	ttk::menubutton $w -textvariable $var -menu $w.menu
+	menu $w.menu
+	foreach option $args {
+	    $w.menu add command \
+		-label $option \
+		-command [list set $var $option]
+	}
+	# return the same value as tk_optionMenu
+	return $w.menu
+    }
 
-	# print options
+    # _setprintenv
+    #   Set the print environtment - list of printers, state and options.
+    # Arguments:
+    #   none.
+    #
+    proc ::tk::print::_setprintenv {} {
+	variable option
 	variable optlist
+	variable pinfo
+
 	set optlist(printer) {}
-	set optlist(paper)   [list [mc "Letter"] [mc "Legal"] [mc "A4"]]
-	set optlist(orient)  [list [mc "Portrait"] [mc "Landscape"]]
-	set optlist(color)   [list [mc "Grayscale"] [mc "RGB"]]
-	set optlist(zoom)    {100 90 80 70 60 50 40 30 20 10}
+	dict for {printer options} [cups getprinters] {
+	    lappend optlist(printer) $printer
+	    set pinfo($printer) $options
+	}
 
-	# selected options
-	variable sel
-	array set sel {
-	    printer {}
-	    copies  {}
-	    paper   {}
-	    orient  {}
-	    color   {}
-	    zoom    {}
+	# It's an error to not have any printer configured
+	if {[llength $optlist(printer)] == 0} {
+	    return -code error "No installed printers found.\
+	    Please check or update your CUPS installation."
 	}
 
+	# If no printer is selected, check for the default one
+	# If none found, use the first one from the list
+	if {$option(printer) eq ""} {
+	    set option(printer) [cups defaultprinter]
+	    if {$option(printer) eq ""} {
+		set option(printer) [lindex $optlist(printer) 0]
+	    }
+	}
+    }
+
+    # _print
+    #   Main printer dialog.
+    #   Select printer, set options, and fire print command.
+    # Arguments:
+    #   w - widget with contents to print.
+    #
+    proc ::tk::print::_print {w} {
+	variable optlist
+	variable option
+	variable pinfo
+	variable statemap
+
 	# default values for dialog widgets
 	option add *Printdialog*TLabel.anchor e
 	option add *Printdialog*TMenubutton.Menu.tearOff 0
 	option add *Printdialog*TMenubutton.width 12
 	option add *Printdialog*TSpinbox.width 12
-	# this is tempting to add, but it's better to leave it to user's taste
+	# this is tempting to add, but it's better to leave it to
+	# user's taste.
 	# option add *Printdialog*Menu.background snow
 
-	# returns the full qualified var name
-	proc myvar {varname} {
-	    set fqvar [uplevel 1 [list namespace which -variable $varname]]
-	    # assert var existence
-	    if {$fqvar eq ""} {
-		return -code error "Wrong varname \"$varname\""
-	    }
-	    return $fqvar
-	}
-
-	# ttk version of [tk_optionMenu]
-	# var should be a full qualified varname
-	proc ttk_optionMenu {w var args} {
-	    ttk::menubutton $w \
-		-textvariable $var \
-		-menu $w.menu
-	    menu $w.menu
-	    foreach option $args {
-		$w.menu add command \
-		    -label $option \
-		    -command [list set $var $option]
-	    }
-	    # return the same value as tk_optionMenu
-	    return $w.menu
-	}
-
-	# _setprintenv
-	#  Set the print environtment - print command, and list of printers.
-	#  Arguments:
-	#    none.
-
-	proc _setprintenv {} {
-	    variable printcmd
-	    variable optlist
-
-	    #Test for existence of lpstat command to obtain list of printers. Return error
-	    #if not found.
-
-	    catch {exec lpstat -a} msg
-	    set notfound "command not found"
-	    if {[string first $notfound $msg] >= 0} {
-		error "Unable to obtain list of printers. Please install the CUPS package \
-		for your system."
-		return
-	    }
- 	    set notfound "No destinations added"
- 	    if {[string first $notfound $msg] != -1} {
-		error "Please check or update your CUPS installation."
-		return
+	set class [winfo class $w]
+	if {$class ni {Text Canvas}} {
+	    return -code error "printing windows of class \"$class\"\
+		is not supported"
+	}
+	# Should this be called with every invocaton?
+	# Yes. It allows dynamic discovery of newly added printers
+	# whithout having to restart the app
+	_setprintenv
+
+	set p ._print
+	destroy $p
+
+	# Copy the current values to a dialog's temporary variable.
+	# This allow us to cancel the dialog discarding any changes
+	# made to the options
+	namespace eval dlg {variable option}
+	array set dlg::option [array get option]
+	set var [namespace which -variable dlg::option]
+
+	# The toplevel of our dialog
+	toplevel $p -class Printdialog
+	place [ttk::frame $p.background] -x 0 -y 0 -relwidth 1.0 -relheight 1.0
+	wm title $p [mc "Print"]
+	wm resizable $p 0 0
+	wm attributes $p -type dialog
+	wm transient $p [winfo toplevel $w]
+
+	# The printer to use
+	set pf [ttk::frame $p.printerf]
+	pack $pf -side top -fill x -expand no -padx 9p -pady 9p
+
+	ttk::label $pf.printerl -text "[mc "Printer"]"
+	set tv [ttk::treeview $pf.prlist -height 5 \
+	    -columns {printer location state} \
+	    -show headings \
+	    -selectmode browse]
+	$tv configure \
+	    -yscrollcommand [namespace code [list _scroll $pf.sy]] \
+	    -xscrollcommand [namespace code [list _scroll $pf.sx]]
+	ttk::scrollbar $pf.sy -command [list $tv yview]
+	ttk::scrollbar $pf.sx -command [list $tv xview] -orient horizontal
+	$tv heading printer  -text [mc "Printer"]
+	$tv heading location -text [mc "Location"]
+	$tv heading state    -text [mc "State"]
+	$tv column printer  -width 200 -stretch 0
+	$tv column location -width 100 -stretch 0
+	$tv column state    -width 250 -stretch 0
+
+	foreach printer $optlist(printer) {
+	    set location [dict getdef $pinfo($printer) printer-location ""]
+	    set nstate [dict getdef $pinfo($printer) printer-state 0]
+	    set state [dict getdef $statemap $nstate ""]
+	    switch -- $nstate {
+		3 - 4 {
+		    set accepting [dict getdef $pinfo($printer) \
+			printer-is-accepting-jobs ""]
+		    if {$accepting ne ""} {
+			append state ". " [mc "Printer is accepting jobs"]
+		    }
+		}
+		5 {
+		    set reason [dict getdef $pinfo($printer) \
+			printer-state-reasons ""]
+		    if {$reason ne ""} {
+			    append state ". (" $reason ")"
+		    }
+		}
 	    }
-
-	    # Select print command. We prefer lpr, but will fall back to lp if
-	    # necessary.
-	    if {[auto_execok lpr] ne ""} {
-		set printcmd lpr
-	    } else {
-		set printcmd lp
+	    set id [$tv insert {} end \
+		-values [list $printer $location $state]]
+	    if {$option(printer) eq $printer} {
+		$tv selection set $id
 	    }
+	}
 
-	    #Build list of printers
-	    set printers {}
-	    set printdata [exec lpstat -a]
-	    foreach item [split $printdata \n] {
-		lappend printers [lindex [split $item] 0]
-	    }
-	    # filter out duplicates
-	    set optlist(printer) [lsort -unique $printers]
+	grid $pf.printerl -sticky w
+	grid $pf.prlist $pf.sy -sticky news
+	grid $pf.sx -sticky ew
+	grid remove $pf.sy $pf.sx
+	bind $tv <<TreeviewSelect>> [namespace code {_onselect %W}]
+
+	# Start of printing options
+	set of [ttk::labelframe $p.optionsframe -text [mc "Options"]]
+	pack $of -fill x -padx 9p -pady {0 9p} -ipadx 2p -ipady 2p
+
+	# COPIES
+	ttk::label $of.copiesl -text "[mc "Copies"] :"
+	ttk::spinbox $of.copies -textvariable ${var}(copies) \
+	    -from 1 -to 1000
+	grid $of.copiesl $of.copies -sticky ew -padx 2p -pady 2p
+	$of.copies state readonly
+
+	# PAPER SIZE
+	ttk::label $of.medial -text "[mc "Paper"] :"
+	ttk_optionMenu $of.media ${var}(media) {*}$optlist(media)
+	grid $of.medial $of.media -sticky ew -padx 2p -pady 2p
+
+	if {$class eq "Canvas"} {
+	    # additional options for Canvas output
+	    # SCALE
+	    ttk::label $of.percentl -text "[mc "Scale"] :"
+	    ttk::spinbox $of.percent -textvariable ${var}(czoom) \
+		-from 5 -to 500 -increment 5
+	    grid $of.percentl $of.percent -sticky ew -padx 2p -pady 2p
+	    $of.percent state readonly
+
+	    # ORIENT
+	    ttk::label $of.orientl -text "[mc "Orientation"] :"
+	    ttk_optionMenu $of.orient ${var}(orient) {*}$optlist(orient)
+	    grid $of.orientl $of.orient -sticky ew -padx 2p -pady 2p
+
+	    # COLOR
+	    ttk::label $of.colorl -text "[mc "Output"] :"
+	    ttk_optionMenu $of.color ${var}(color) {*}$optlist(color)
+	    grid $of.colorl $of.color -sticky ew -padx 2p -pady 2p
+	} elseif {$class eq "Text"} {
+	    # additional options for Text output
+	    # NUMBER-UP
+	    ttk::label $of.nupl -text "[mc "Pages per sheet"] :"
+	    ttk_optionMenu $of.nup ${var}(number-up) {*}$optlist(number-up)
+	    grid $of.nupl $of.nup -sticky ew -padx 2p -pady 2p
+
+	    # TEXT SCALE
+	    ttk::label $of.tzooml -text "[mc "Text scale"] :"
+	    ttk::spinbox $of.tzoom -textvariable ${var}(tzoom) \
+		-from 50 -to 200 -increment 5
+	    grid $of.tzooml $of.tzoom -sticky ew -padx 2p -pady 2p
+	    $of.tzoom state readonly
+
+	    # PRETTY PRINT (banner on top)
+	    ttk::checkbutton $of.pprint -onvalue 1 -offvalue 0 \
+		-text [mc "Pretty print"] \
+		-variable ${var}(pprint)
+	    grid $of.pprint - -sticky ew -padx 2p -pady 2p
 	}
 
-	# _print
-	#  Main printer dialog. Select printer, set options, and
-	#  fire print command.
-	# Arguments:
-	#  w - widget with contents to print.
-	#
+	# The buttons frame.
+	set bf [ttk::frame $p.buttonf]
+	pack $bf -fill x -expand no -side bottom -padx 9p -pady {0 9p}
 
-	proc _print {w} {
-	# TODO: revise padding
-	    variable optlist
-	    variable sel
-
-	    # should this be called with every invocaton?
-	    _setprintenv
-	    if {$sel(printer) eq "" && [llength $optlist(printer)] > 0} {
-		set sel(printer) [lindex $optlist(printer) 0]
-	    }
-
-	    set p ._print
-	    catch {destroy $p}
-
-	    # copy the current values to a dialog's temorary variable
-	    # this allow us to cancel the dialog discarding any changes
-	    # made to the options
-	    namespace eval dlg {variable sel}
-	    array set dlg::sel [array get sel]
-
-	    # The toplevel of our dialog
-	    toplevel $p -class Printdialog
-	    place [ttk::frame $p.background] -x 0 -y 0 -relwidth 1.0 -relheight 1.0
-	    wm title $p [mc "Print"]
-	    wm resizable $p 0 0
-	    wm attributes $p -type dialog
-
-	    # The printer to use
-	    set pf [ttk::frame $p.printerf]
-	    pack $pf -side top -fill x -expand no -padx 9p -pady 9p
-
-	    ttk::label $pf.printerl -text "[mc "Printer"] :"
-	    ttk::combobox $pf.printer \
-		-textvariable [myvar dlg::sel](printer) \
-		-state readonly \
-		-values $optlist(printer)
-	    pack $pf.printerl -side left -padx {0 4.5p}
-	    pack $pf.printer  -side left
-
-	    # Start of printing options
-	    set of [ttk::labelframe $p.optionsframe -text [mc "Options"]]
-	    pack $of -fill x -padx 9p -pady {0 9p} -ipadx 2p -ipady 2p
-
-	    # COPIES
-	    ttk::label $of.copiesl -text "[mc "Copies"] :"
-	    ttk::spinbox $of.copies -from 1 -to 1000 \
-		-textvariable [myvar dlg::sel](copies)
-	    grid $of.copiesl $of.copies -sticky ew -padx 2p -pady 2p
-
-	    # PAPER SIZE
-	    ttk::label $of.paperl -text "[mc "Paper"] :"
-	    ttk_optionMenu $of.paper [myvar dlg::sel](paper) {*}$optlist(paper)
-	    grid $of.paperl $of.paper -sticky ew -padx 2p -pady 2p
-
-	    # additional options for canvas output
-	    if {[winfo class $w] eq "Canvas"} {
-		# SCALE
-		ttk::label $of.percentl -text "[mc "Scale"] :"
-		ttk_optionMenu $of.percent [myvar dlg::sel](zoom) {*}$optlist(zoom)
-		grid $of.percentl $of.percent -sticky ew -padx 2p -pady 2p
-
-		# ORIENT
-		ttk::label $of.orientl -text "[mc "Orientation"] :"
-		ttk_optionMenu $of.orient [myvar dlg::sel](orient) {*}$optlist(orient)
-		grid $of.orientl $of.orient -sticky ew -padx 2p -pady 2p
-
-		# COLOR
-		ttk::label $of.colorl -text "[mc "Output"] :"
-		ttk_optionMenu $of.color [myvar dlg::sel](color) {*}$optlist(color)
-		grid $of.colorl $of.color -sticky ew -padx 2p -pady 2p
-	    }
-
-	    # The buttons frame.
-	    set bf [ttk::frame $p.buttonf]
-	    pack $bf -fill x -expand no -side bottom -padx 9p -pady {0 9p}
-
-	    ttk::button $bf.print -text [mc "Print"] \
-		-command [namespace code [list _runprint $w $p]]
-	    ttk::button $bf.cancel -text [mc "Cancel"] \
-		-command [namespace code [list _cancel $p]]
-	    pack $bf.print  -side right
-	    pack $bf.cancel -side right -padx {0 4.5p}
-	    #Center the window as a dialog.
-	    ::tk::PlaceWindow $p
-	}
-
-	proc _cancel {p} {
-	    namespace delete dlg
-	    destroy $p
-	}
-
-	# _runprint -
-	#   Execute the print command--print the file.
-	# Arguments:
-	#  w - widget with contents to print.
-	#
-	proc _runprint {w p} {
-	    variable printcmd
-	    variable sel
+	ttk::button $bf.print -text [mc "Print"] \
+	    -command [namespace code [list _runprint $w $class $p]]
+	ttk::button $bf.cancel -text [mc "Cancel"] \
+	    -command [list destroy $p]
+	pack $bf.print  -side right
+	pack $bf.cancel -side right -padx {0 4.5p}
 
-	    # copy the values back from the dialog
-	    array set sel [array get dlg::sel]
-	    namespace delete dlg
+	# cleanup binding
+	bind $bf <Destroy> [namespace code [list _cleanup $p]]
 
-	    #First, generate print file.
-	    if {[winfo class $w] eq "Text"} {
-		set file [makeTempFile tk_text.txt [$w get 1.0 end]]
-	    }
+	# Center the window as a dialog.
+	::tk::PlaceWindow $p
+    }
 
-	    if {[winfo class $w] eq "Canvas"} {
-		if {$sel(color) eq [mc "RGB"]} {
-		    set colormode color
-		} else {
-		    set colormode gray
-		}
+    # _onselect
+    #   Updates the selected printer when treeview selection changes.
+    # Arguments:
+    #   tv - treeview pathname.
+    #
+    proc ::tk::print::_onselect {tv} {
+	variable dlg::option
+	set id [$tv selection]
+	if {$id eq ""} {
+	    # is this even possible?
+	    set option(printer) ""
+	} else {
+	    set option(printer) [$tv set $id printer]
+	}
+    }
 
-		if {$sel(orient) eq [mc "Landscape"]} {
-		    set willrotate "1"
-		} else {
-		    set willrotate "0"
-		}
+    # _scroll
+    #   Implements autoscroll for the printers view
+    #
+    proc ::tk::print::_scroll {sbar from to} {
+	if {$from == 0.0 && $to == 1.0} {
+	    grid remove $sbar
+	} else {
+	    grid $sbar
+	    $sbar set $from $to
+	}
+    }
 
-		#Scale based on size of widget, not size of paper.
-		set printwidth [expr {$sel(zoom) / 100.00 * [winfo width $w]}]
-		set file [makeTempFile tk_canvas.ps]
-		$w postscript -file $file -colormode $colormode \
-		    -rotate $willrotate -pagewidth $printwidth
-	    }
+    # _cleanup
+    #   Perform cleanup when the dialog is destroyed.
+    # Arguments:
+    #   p - print dialog pathname (not used).
+    #
+    proc ::tk::print::_cleanup {p} {
+	namespace delete dlg
+    }
 
-	    #Build list of args to pass to print command.
-	    set printargs {}
-	    if {$printcmd eq "lpr"} {
-		lappend printargs -P $sel(printer) -# $sel(copies)
-	    } else {
-		lappend printargs -d $sel(printer) -n $sel(copies)
+    # _runprint -
+    #   Execute the print command--print the file.
+    # Arguments:
+    #   w     - widget with contents to print.
+    #   class - class of the widget to print (Canvas or Text).
+    #   p     - print dialog pathname.
+    #
+    proc ::tk::print::_runprint {w class p} {
+	variable option
+	variable mcmap
+
+	# copy the values back from the dialog
+	array set option [array get dlg::option]
+
+	# get (back) name of media from the translated one
+	set media [dict get $mcmap(media) $option(media)]
+	set printargs {}
+	lappend printargs -title "[tk appname]: Tk window $w"
+	lappend printargs -copies $option(copies)
+	lappend printargs -media $media
+
+	if {$class eq "Canvas"} {
+	    set colormode [dict get $mcmap(color) $option(color)]
+	    set rotate 0
+	    if {[dict get $mcmap(orient) $option(orient)] eq "landscape"} {
+		set rotate 1
 	    }
-
-	    # launch the job in the background
-	    after 0 [list exec $printcmd {*}$printargs -o PageSize=$sel(paper) $file]
-	    destroy $p
+	    # Scale based on size of widget, not size of paper.
+	    # TODO: is this correct??
+	    set printwidth [expr {
+		$option(czoom) / 100.0 * [winfo width $w]
+	    }]
+	    set data [encoding convertto iso8859-1 [$w postscript \
+		-colormode $colormode -rotate $rotate -pagewidth $printwidth]]
+	} elseif {$class eq "Text"} {
+	    set tzoom [expr {$option(tzoom) / 100.0}]
+	    if {$option(tzoom) != 100} {
+		lappend printargs -tzoom $tzoom
+	    }
+	    if {$option(pprint)} {
+		lappend printargs -prettyprint
+	    }
+	    if {$option(number-up) != 1} {
+		lappend printargs -nup $option(number-up)
+	    }
+	    # these are hardcoded. Should we allow the user to control
+	    # margins?
+	    lappend printargs -margins [list \
+		$option(margin-top)    $option(margin-left) \
+		$option(margin-bottom) $option(margin-right) ]
+	    # get the data in shape. Cupsfilter's text filter wraps lines
+	    # at character level, not words, so we do it by ourselves.
+	    # compute usable page width in inches
+	    set pw [dict get {a4 8.27 legal 8.5 letter 8.5} $media]
+	    set pw [expr {
+		$pw - ($option(margin-left) + $option(margin-right)) / 72.0
+	    }]
+	    # set the wrap length at 98% of computed page width in chars
+	    # the 9.8 constant is the product 10.0 (default cpi) * 0.95
+	    set wl [expr {int( 9.8 * $pw / $tzoom )}]
+	    set data [encoding convertto utf-8 [_wrapLines [$w get 1.0 end] $wl]]
 	}
 
-	# Initialize with sane defaults.
-	set sel(copies)  1
-	set sel(paper)   [mc "A4"]
-	set sel(orient)  [mc "Portrait"]
-	set sel(color)   [mc "RGB"]
-	set sel(zoom)    100
+	# launch the job in the background
+	after idle [namespace code \
+	    [list cups print $option(printer) $data {*}$printargs]]
+	destroy $p
+    }
+
+    # _wrapLines -
+    #   wrap long lines into lines of at most length wl at word boundaries
+    # Arguments:
+    #   str   - string to be wrapped
+    #   wl    - wrap length
+    #
+    proc ::tk::print::_wrapLines {str wl} {
+	# This is a really simple algorithm: it breaks a line on space or tab
+	# character, collapsing them only at the breaking point.
+	# Leading space is left as-is.
+	# For a full fledged line breaking algorithm see
+	# Unicode® Standard Annex #14 "Unicode Line Breaking Algorithm"
+	set res {}
+	incr wl -1
+	set re [format {((?:^|[^[:blank:]]).{0,%d})(?:[[:blank:]]|$)} $wl]
+	foreach line [split $str \n] {
+	    lappend res {*}[lmap {_ l} [regexp -all -inline -- $re $line] {
+		set l
+	    }]
+	}
+	return [join $res \n]
     }
-    #end X11 procedures
+}
+#end X11 procedures
 
+namespace eval ::tk::print {
     #begin macOS Aqua procedures
     if {[tk windowingsystem] eq "aqua"} {
 	# makePDF -