Merge 9.0

7 files changed, 1218 insertions, 236 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 -
diff --git a/unix/Makefile.in b/unix/Makefile.in
index a157615..543b388 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -266,8 +266,8 @@ TCL_STUB_FLAGS		= @TCL_STUB_FLAGS@
 
 # Libraries to use when linking.  This definition is determined by the
 # configure script.
-LIBS = @LIBS@ $(X11_LIB_SWITCHES) @TCL_LIBS@
-WISH_LIBS = $(TCL_LIB_SPEC) @LIBS@ $(X11_LIB_SWITCHES) @TCL_LIBS@ @EXTRA_WISH_LIBS@
+LIBS = @LIBS@ $(X11_LIB_SWITCHES) @TCL_LIBS@ @CUPS_LIBS@
+WISH_LIBS = $(TCL_LIB_SPEC) @LIBS@ $(X11_LIB_SWITCHES) @TCL_LIBS@ @CUPS_LIBS@ @EXTRA_WISH_LIBS@
 
 # The symbols below provide support for dynamic loading and shared
 # libraries.  See configure.ac for a description of what the
@@ -299,6 +299,10 @@ REZ_SWITCHES = @REZ_FLAGS@ -i $(GENERIC_DIR) -i $(TCL_GENERIC_DIR)
 XFT_CFLAGS		= @XFT_CFLAGS@
 XFT_LIBS		= @XFT_LIBS@
 
+# support for libcups
+CUPS_CFLAGS		= @CUPS_CFLAGS@
+CUPS_LIBS 		= @CUPS_LIBS@
+
 #----------------------------------------------------------------
 # The information below is modified by the configure script when
 # Makefile is generated from Makefile.in.  You shouldn't normally
@@ -394,7 +398,8 @@ X11_OBJS = tkUnix.o tkUnix3d.o tkUnixButton.o tkUnixColor.o tkUnixConfig.o \
 	tkUnixCursor.o tkUnixDraw.o tkUnixEmbed.o tkUnixEvent.o tkIcu.o \
 	tkUnixFocus.o  $(FONT_OBJS) tkUnixInit.o tkUnixKey.o tkUnixMenu.o \
 	tkUnixMenubu.o tkUnixScale.o tkUnixScrlbr.o tkUnixSelect.o \
-	tkUnixSend.o tkUnixSysNotify.o tkUnixSysTray.o tkUnixWm.o tkUnixXId.o
+	tkUnixSend.o tkUnixSysNotify.o tkUnixSysTray.o tkUnixWm.o tkUnixXId.o \
+	tkUnixPrint.o
 
 AQUA_OBJS = tkMacOSXBitmap.o tkMacOSXButton.o tkMacOSXClipboard.o \
 	tkMacOSXColor.o tkMacOSXConfig.o tkMacOSXCursor.o tkMacOSXDebug.o \
@@ -516,7 +521,8 @@ X11_SRCS = \
 	$(UNIX_DIR)/tkUnixScale.c $(UNIX_DIR)/tkUnixScrlbr.c \
 	$(UNIX_DIR)/tkUnixSelect.c $(UNIX_DIR)/tkUnixSend.c \
 	$(UNIX_DIR)/tkUnixSysNotify $(UNIX_DIR)/tkUnixSysTray.c \
-	$(UNIX_DIR)/tkUnixWm.c $(UNIX_DIR)/tkUnixXId.c
+	$(UNIX_DIR)/tkUnixWm.c $(UNIX_DIR)/tkUnixXId.c \
+	$(UNIX_DIR)/tkUnixPrint.c
 
 AQUA_SRCS = \
 	$(MAC_OSX_DIR)/tkMacOSXBitmap.c $(MAC_OSX_DIR)/tkMacOSXButton.c \
@@ -1330,6 +1336,9 @@ tkUnixMenu.o: $(UNIX_DIR)/tkUnixMenu.c
 tkUnixMenubu.o: $(UNIX_DIR)/tkUnixMenubu.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenubu.c
 
+tkUnixPrint.o: $(UNIX_DIR)/tkUnixPrint.c
+	$(CC) -c $(CC_SWITCHES) $(CUPS_CFLAGS) $(UNIX_DIR)/tkUnixPrint.c
+
 tkUnixScale.o: $(UNIX_DIR)/tkUnixScale.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixScale.c
 
diff --git a/unix/configure b/unix/configure
index ff77a98..85fa9fb 100755
--- a/unix/configure
+++ b/unix/configure
@@ -696,6 +696,8 @@ ZIP_PROG
 MACHER_PROG
 EXEEXT_FOR_BUILD
 CC_FOR_BUILD
+CUPS_LIBS
+CUPS_CFLAGS
 UNIX_FONT_OBJS
 XFT_LIBS
 XFT_CFLAGS
@@ -811,6 +813,7 @@ enable_symbols
 enable_aqua
 with_x
 enable_xft
+enable_libcups
 enable_xss
 enable_framework
 enable_zipfs
@@ -1464,6 +1467,7 @@ Optional Features:
   --enable-symbols        build with debugging symbols (default: off)
   --enable-aqua=yes|no    use Aqua windowingsystem on Mac OS X (default: no)
   --enable-xft            use freetype/fontconfig/xft (default: on)
+  --enable-libcups        use libcups (default: on)
   --enable-xss            use XScreenSaver for activity timer (default: on)
   --enable-framework      package shared libraries in MacOSX frameworks
                           (default: off)
@@ -8630,6 +8634,66 @@ printf "%s\n" "#define HAVE_XFT 1" >>confdefs.h
 fi
 
 #--------------------------------------------------------------------
+#	Check for libcups support
+#--------------------------------------------------------------------
+
+if test $tk_aqua = no; then
+    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use libcups" >&5
+printf %s "checking whether to use libcups... " >&6; }
+    # Check whether --enable-libcups was given.
+if test ${enable_libcups+y}
+then :
+  enableval=$enable_libcups; enable_libcups=$enableval
+else case e in #(
+  e) enable_libcups="default" ;;
+esac
+fi
+
+    CUPS_CFLAGS=""
+    CUPS_LIBS=""
+    if test "$enable_libcups" = "no" ; then
+	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $enable_libcups" >&5
+printf "%s\n" "$enable_libcups" >&6; }
+    else
+	found_cups=`cups-config 2>/dev/null`
+		        if test "$found_cups" = ""; then
+	    found_cups=no
+        else
+	    found_cups=yes
+	    CUPS_CFLAGS="-DHAVE_CUPS"
+	    CUPS_LIBS=`cups-config --libs`
+	fi
+	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $found_cups" >&5
+printf "%s\n" "$found_cups" >&6; }
+		if test "$found_cups" = "yes" ; then
+	    tk_oldCFlags=$CFLAGS
+	    CFLAGS="$CFLAGS $XINCLUDES $CUPS_CFLAGS"
+	    tk_oldLibs=$LIBS
+	    LIBS="$tk_oldLIBS $CUPS_LIBS $XLIBSW"
+	    ac_fn_c_check_header_compile "$LINENO" "cups/cups.h" "ac_cv_header_cups_cups_h" "#include <cups/cups.h>
+"
+if test "x$ac_cv_header_cups_cups_h" = xyes
+then :
+
+else case e in #(
+  e)
+		found_cups=no
+		CUPS_CFLAGS=""
+		CUPS_LIBS=""
+	     ;;
+esac
+fi
+
+	    CFLAGS=$tk_oldCFlags
+	    LIBS=$tk_oldLibs
+	fi
+    fi
+
+
+fi
+
+
+#--------------------------------------------------------------------
 # XXX Do this last.
 # It might modify XLIBSW which could affect other tests.
 #
diff --git a/unix/configure.ac b/unix/configure.ac
index 3bacf8b..4281a14 100644
--- a/unix/configure.ac
+++ b/unix/configure.ac
@@ -467,6 +467,52 @@ if test $tk_aqua = no; then
 fi
 
 #--------------------------------------------------------------------
+#	Check for libcups support
+#--------------------------------------------------------------------
+
+if test $tk_aqua = no; then
+    AC_MSG_CHECKING([whether to use libcups])
+    AC_ARG_ENABLE(libcups,
+	AS_HELP_STRING([--enable-libcups],
+	    [use libcups (default: on)]),
+	[enable_libcups=$enableval], [enable_libcups="default"])
+    CUPS_CFLAGS=""
+    CUPS_LIBS=""
+    if test "$enable_libcups" = "no" ; then
+	AC_MSG_RESULT([$enable_libcups])
+    else
+	found_cups=`cups-config 2>/dev/null`
+	dnl make sure package configurator (cups-config)
+	dnl says that libcups is present.
+        if test "$found_cups" = ""; then
+	    found_cups=no
+        else
+	    found_cups=yes
+	    CUPS_CFLAGS="-DHAVE_CUPS"
+	    CUPS_LIBS=`cups-config --libs`
+	fi
+	AC_MSG_RESULT([$found_cups])
+	dnl make sure that compiling against CUPS header file doesn't bomb
+	if test "$found_cups" = "yes" ; then
+	    tk_oldCFlags=$CFLAGS
+	    CFLAGS="$CFLAGS $XINCLUDES $CUPS_CFLAGS"
+	    tk_oldLibs=$LIBS
+	    LIBS="$tk_oldLIBS $CUPS_LIBS $XLIBSW"
+	    AC_CHECK_HEADER(cups/cups.h, [], [
+		found_cups=no
+		CUPS_CFLAGS=""
+		CUPS_LIBS=""
+	    ],[#include <cups/cups.h>])
+	    CFLAGS=$tk_oldCFlags
+	    LIBS=$tk_oldLibs
+	fi
+    fi
+    AC_SUBST(CUPS_CFLAGS)
+    AC_SUBST(CUPS_LIBS)
+fi
+
+
+#--------------------------------------------------------------------
 # XXX Do this last.
 # It might modify XLIBSW which could affect other tests.
 #
diff --git a/unix/tkUnixInit.c b/unix/tkUnixInit.c
index 34b67fc..c8acf22 100644
--- a/unix/tkUnixInit.c
+++ b/unix/tkUnixInit.c
@@ -44,6 +44,7 @@ TkpInit(
     Tktray_Init(interp);
     (void)SysNotify_Init (interp);
     Icu_Init(interp);
+    Cups_Init(interp);
     return TCL_OK;
 }
 
diff --git a/unix/tkUnixInt.h b/unix/tkUnixInt.h
index 5429236..f46212e 100644
--- a/unix/tkUnixInt.h
+++ b/unix/tkUnixInt.h
@@ -26,6 +26,7 @@
 
 MODULE_SCOPE  int       Tktray_Init (Tcl_Interp* interp);
 MODULE_SCOPE  int       SysNotify_Init (Tcl_Interp* interp);
+MODULE_SCOPE  int       Cups_Init (Tcl_Interp* interp);
 
 #endif /* _TKUNIXINT */
 
diff --git a/unix/tkUnixPrint.c b/unix/tkUnixPrint.c
new file mode 100644
index 0000000..830f580
--- /dev/null
+++ b/unix/tkUnixPrint.c
@@ -0,0 +1,526 @@
+/*
+ * tkUnixPrint.c --
+ *
+ *      tkUnixPrint.c implements a "::tk::print::cups" Tcl command which
+ *      interfaces the libcups2 API with the [tk print] command.
+ *
+ * Copyright © 2024 Emiliano Gavilán.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkUnixInt.h"
+
+#ifdef HAVE_CUPS
+#include <cups/cups.h>
+
+typedef int (CupsSubCmdOp)(Tcl_Interp *, int, Tcl_Obj *const []);
+
+static Tcl_ObjCmdProc Cups_Cmd;
+static CupsSubCmdOp DefaultPrinterOp;
+static CupsSubCmdOp GetPrintersOp;
+static CupsSubCmdOp PrintOp;
+static Tcl_ArgvGenFuncProc ParseEnumOptions;
+static Tcl_ArgvGenFuncProc ParseOptions;
+static Tcl_ArgvGenFuncProc ParseMargins;
+static Tcl_ArgvGenFuncProc ParseNup;
+static cups_dest_t* GetPrinterFromObj(Tcl_Obj *);
+
+static cups_dest_t *
+GetPrinterFromObj(Tcl_Obj *nameObj)
+{
+    cups_dest_t *printer;
+    Tcl_Size len;
+    const char *nameStr = Tcl_GetStringFromObj(nameObj, &len);
+    char *p;
+    char *name, *instance = NULL;
+    Tcl_DString ds;
+
+    Tcl_DStringInit(&ds);
+    name = Tcl_DStringAppend(&ds, nameStr, len);
+    p = strchr(name, '/');
+    if (p) {
+	*p = '\0';
+	instance = p+1;
+    }
+
+    printer = cupsGetNamedDest(CUPS_HTTP_DEFAULT, name, instance);
+    Tcl_DStringFree(&ds);
+
+    return printer;
+}
+
+static int
+Cups_Cmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    static const struct CupsCmds {
+	const char *subcmd;
+	CupsSubCmdOp *subCmd;
+    } cupsCmds[] = {
+	{"defaultprinter"   , DefaultPrinterOp},
+	{"getprinters"      , GetPrintersOp},
+	{"print"            , PrintOp},
+	{NULL, NULL}
+    };
+    int index;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObjStruct(interp, objv[1], cupsCmds,
+	    sizeof(struct CupsCmds), "subcommand", 0, &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    return cupsCmds[index].subCmd(interp, objc, objv);
+}
+
+static int
+DefaultPrinterOp(
+    Tcl_Interp *interp,
+    TCL_UNUSED(int),
+    TCL_UNUSED(Tcl_Obj *const *))
+{
+    cups_dest_t *printer;
+    Tcl_Obj *resultObj;
+
+    printer = cupsGetNamedDest(CUPS_HTTP_DEFAULT, NULL, NULL);
+    if (printer) {
+	if (printer->instance) {
+	    resultObj = Tcl_ObjPrintf("%s/%s", printer->name,
+		printer->instance);
+	} else {
+	    resultObj = Tcl_NewStringObj(printer->name, -1);
+	}
+	Tcl_SetObjResult(interp, resultObj);
+    }
+
+    cupsFreeDests(1, printer);
+    return TCL_OK;
+}
+
+static int
+GetPrintersOp(
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    cups_dest_t *dests;
+    cups_option_t *option;
+    int num_dests, i, j;
+    Tcl_Obj *keyPtr, *optPtr, *resultObj;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+	return TCL_ERROR;
+    }
+
+    num_dests = cupsGetDests2(CUPS_HTTP_DEFAULT, &dests);
+    resultObj = Tcl_NewObj();
+
+    for (i = 0; i < num_dests; i++) {
+	if (dests[i].instance)
+	    keyPtr = Tcl_ObjPrintf("%s/%s", dests[i].name, dests[i].instance);
+	else
+	    keyPtr = Tcl_NewStringObj(dests[i].name, -1);
+
+	option = dests[i].options;
+	optPtr = Tcl_NewObj();
+	for(j = 0; j < dests[i].num_options; j++) {
+	    Tcl_DictObjPut(NULL, optPtr,
+		Tcl_NewStringObj(option[j].name, -1),
+		Tcl_NewStringObj(option[j].value, -1));
+	}
+
+	Tcl_DictObjPut(NULL, resultObj, keyPtr, optPtr);
+    }
+
+    cupsFreeDests(num_dests, dests);
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+/* Information needed for parsing */
+struct CupsOptions {
+    const char *name;
+    const char *cupsName;
+};
+
+static const struct CupsOptions colormodeOpts[] = {
+    {"auto",       CUPS_PRINT_COLOR_MODE_AUTO},
+    {"color",      CUPS_PRINT_COLOR_MODE_COLOR},
+    {"monochrome", CUPS_PRINT_COLOR_MODE_MONOCHROME},
+    {NULL, NULL}
+};
+
+static const struct CupsOptions formatOpts[] = {
+    {"auto",       CUPS_FORMAT_AUTO},
+    {"pdf",        CUPS_FORMAT_PDF},
+    {"postscript", CUPS_FORMAT_POSTSCRIPT},
+    {"text",       CUPS_FORMAT_TEXT},
+    {NULL, NULL}
+};
+
+static const struct CupsOptions mediaOpts[] = {
+    {"a4",     CUPS_MEDIA_A4},
+    {"legal",  CUPS_MEDIA_LEGAL},
+    {"letter", CUPS_MEDIA_LETTER},
+    {NULL, NULL}
+};
+
+static const struct CupsOptions orientationOpts[] = {
+    {"portrait",  CUPS_ORIENTATION_PORTRAIT},
+    {"landscape", CUPS_ORIENTATION_LANDSCAPE},
+    {NULL, NULL}
+};
+
+enum {PARSECOLORMODE, PARSEFORMAT, PARSEMEDIA, PARSEORIENTATION};
+
+static const struct ParseData {
+    const char *message;
+    const struct CupsOptions *optionTable;
+} parseData[] = {
+    {"colormode",   colormodeOpts},
+    {"format",      formatOpts},
+    {"media",       mediaOpts},
+    {"orientation", orientationOpts},
+    {NULL, NULL}
+};
+
+static int
+PrintOp(
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    cups_dest_t *printer;
+    cups_dinfo_t *info;
+    int result = TCL_OK;
+    int job_id;
+
+    /* variables for Tcl_ParseArgsObjv */
+    Tcl_Obj *const *parseObjv;
+    Tcl_Size count;
+
+    /* options related vaiables */
+    cups_option_t *options = NULL;
+    int num_options = 0;
+    int copies = 0, pprint = 0;
+    const char *media = NULL, *color = NULL, *orient = NULL, *format = NULL,
+	*nup = NULL, *title = NULL;
+    Tcl_Obj *marginsObj = NULL, *optionsObj = NULL;
+    double tzoom = 1.0;
+
+    /* Data to print
+     * this is a binary buffer, since it can contain data such as
+     * jpg or compressed pdf which might contain any bytes.
+     * USE [encoding convertto] with a proper encoding when passing
+     * text data to print.
+     */
+    const unsigned char *buffer; Tcl_Size buflen;
+
+    const Tcl_ArgvInfo argTable[] = {
+	{TCL_ARGV_GENFUNC,  "-colormode",   ParseEnumOptions, &color,
+	    "color mode", (void *)&parseData[PARSECOLORMODE]},
+	{TCL_ARGV_INT   ,   "-copies",                  NULL, &copies,
+	    "number of copies", NULL},
+	{TCL_ARGV_GENFUNC,  "-format",      ParseEnumOptions, &format,
+	    "data format", (void *)&parseData[PARSEFORMAT]},
+	{TCL_ARGV_GENFUNC,  "-margins",         ParseMargins, &marginsObj,
+	    "media page size", NULL},
+	{TCL_ARGV_GENFUNC,  "-media",       ParseEnumOptions, &media,
+	    "media page size", (void *)&parseData[PARSEMEDIA]},
+	{TCL_ARGV_GENFUNC,  "-nup",                 ParseNup, &nup,
+	    "pages per sheet", NULL},
+	{TCL_ARGV_GENFUNC,  "-options",         ParseOptions, &optionsObj,
+	    "generic options", NULL},
+	{TCL_ARGV_GENFUNC,  "-orientation", ParseEnumOptions, &orient,
+	    "page orientation", (void *)&parseData[PARSEORIENTATION]},
+	{TCL_ARGV_CONSTANT, "-prettyprint",        (void *)1, &pprint,
+	    "print header", NULL},
+	{TCL_ARGV_STRING,   "-title",                   NULL, &title,
+	    "job title", NULL},
+	{TCL_ARGV_FLOAT,    "-tzoom",                   NULL, &tzoom,
+	    "text zoom", NULL},
+	TCL_ARGV_TABLE_END
+    };
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "printer data ?-opt arg ...?");
+	return TCL_ERROR;
+    }
+
+    printer = GetPrinterFromObj(objv[2]);
+    if (!printer) {
+	Tcl_SetObjResult(interp,
+	    Tcl_ObjPrintf("unknown printer or class \"%s\"",
+		Tcl_GetString(objv[2])));
+	return TCL_ERROR;
+    }
+
+    /* T_PAO discards the first arg, but we have 4 before the options */
+    parseObjv = objv+3;
+    count = objc-3;
+
+    if (Tcl_ParseArgsObjv(interp, argTable, &count, parseObjv, NULL)!=TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (copies < 0 || copies > 100) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("copies must be an integer"
+	    "between 0 and 100", -1));
+	cupsFreeDests(1, printer);
+	return TCL_ERROR;
+    }
+    if (tzoom < 0.5 || tzoom > 2.0) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("tzoom must be a number"
+	    "between 0.5 and 2.0", -1));
+	cupsFreeDests(1, printer);
+	return TCL_ERROR;
+    }
+
+/*  Add options */
+    if (copies != 0) {
+	char copiesbuf[4];
+
+	snprintf(copiesbuf, 4, "%d", copies);
+	num_options = cupsAddOption(CUPS_COPIES, copiesbuf,
+	    num_options, &options);
+    }
+    if (color) {
+	num_options = cupsAddOption(CUPS_PRINT_COLOR_MODE, color,
+	    num_options, &options);
+    }
+    if (media) {
+	num_options = cupsAddOption(CUPS_MEDIA, media,
+	    num_options, &options);
+    }
+    if (nup) {
+	num_options = cupsAddOption(CUPS_NUMBER_UP, nup,
+	    num_options, &options);
+    }
+    if (orient) {
+	num_options = cupsAddOption(CUPS_ORIENTATION, orient,
+	    num_options, &options);
+    }
+    if (pprint) {
+	num_options = cupsAddOption("prettyprint", "yes",
+	    num_options, &options);
+    }
+    if (marginsObj) {
+	Tcl_Size n;
+	Tcl_Obj **listArr;
+
+	Tcl_ListObjGetElements(NULL, marginsObj, &n, &listArr);
+	num_options = cupsAddOption("page-top",    Tcl_GetString(listArr[0]),
+	    num_options, &options);
+	num_options = cupsAddOption("page-left",   Tcl_GetString(listArr[1]),
+	    num_options, &options);
+	num_options = cupsAddOption("page-bottom", Tcl_GetString(listArr[2]),
+	    num_options, &options);
+	num_options = cupsAddOption("page-right",  Tcl_GetString(listArr[3]),
+	    num_options, &options);
+    }
+    if (optionsObj) {
+	Tcl_DictSearch search;
+	int done = 0;
+	Tcl_Obj *key, *value;
+
+	for (Tcl_DictObjFirst(interp, optionsObj, &search, &key, &value, &done)
+	    ; !done ; Tcl_DictObjNext(&search, &key, &value, &done))
+	{
+	    num_options = cupsAddOption(Tcl_GetString(key),
+		Tcl_GetString(value), num_options, &options);
+	}
+    }
+    /* prettyprint mess with the default values if set, so we force it */
+    if (tzoom != 1.0 || pprint) {
+	char cpibuf[TCL_DOUBLE_SPACE + 1];
+	char lpibuf[TCL_DOUBLE_SPACE + 1];
+
+	Tcl_PrintDouble(interp, 10.0 / tzoom, cpibuf);
+	Tcl_PrintDouble(interp,  6.0 / tzoom, lpibuf);
+	num_options = cupsAddOption("cpi", cpibuf,
+	    num_options, &options);
+	num_options = cupsAddOption("lpi", lpibuf,
+	    num_options, &options);
+    }
+
+    /* set title and format */
+    if (!title) {
+	title = "Tk print job";
+    }
+    if (!format) {
+	format = CUPS_FORMAT_AUTO;
+    }
+
+    info = cupsCopyDestInfo(CUPS_HTTP_DEFAULT, printer);
+
+    if (cupsCreateDestJob(CUPS_HTTP_DEFAULT, printer, info, &job_id,
+	    title, num_options, options) != IPP_STATUS_OK) {
+
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error creating job: \"%s\"",
+	    cupsLastErrorString()));
+	result = TCL_ERROR;
+	goto cleanup;
+    }
+
+    buffer = Tcl_GetByteArrayFromObj(objv[3], &buflen);
+
+    if (cupsStartDestDocument(CUPS_HTTP_DEFAULT, printer, info, job_id,
+	"(stdin)", format, 0, NULL, 1) != HTTP_STATUS_CONTINUE) {
+	// Can't start document
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error starting document: \"%s\"",
+	    cupsLastErrorString()));
+	result = TCL_ERROR;
+	goto cleanup;
+    }
+
+    if (cupsWriteRequestData(CUPS_HTTP_DEFAULT,(char *) buffer, buflen) !=
+	    HTTP_STATUS_CONTINUE) {
+	// some error ocurred
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error writing data: \"%s\"",
+	    cupsLastErrorString()));
+	result = TCL_ERROR;
+	goto cleanup;
+    }
+
+    if (cupsFinishDestDocument(CUPS_HTTP_DEFAULT, printer, info) ==
+	    IPP_STATUS_OK) {
+	// all OK
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(job_id));
+    } else {
+	// some error ocurred
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error finishing document: \"%s\"",
+	    cupsLastErrorString()));
+	result = TCL_ERROR;
+	goto cleanup;
+    }
+
+cleanup:
+    cupsFreeDestInfo(info);
+    cupsFreeOptions(num_options, options);
+    cupsFreeDests(1, printer);
+    return result;
+}
+
+static Tcl_Size
+ParseEnumOptions(
+    void *clientData,
+    Tcl_Interp *interp,
+    TCL_UNUSED(Tcl_Size),
+    Tcl_Obj *const *objv,
+    void *dstPtr)
+{
+    int index;
+    const char **dest = (const char **) dstPtr;
+    struct ParseData *pdata = (struct ParseData *)clientData;
+
+    if (Tcl_GetIndexFromObjStruct(interp, objv[0], pdata->optionTable,
+	    sizeof(struct CupsOptions), pdata->message, 0, &index) != TCL_OK) {
+	return -1;
+    }
+
+    *dest = pdata->optionTable[index].cupsName;
+    return 1;
+}
+
+static Tcl_Size
+ParseOptions(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    TCL_UNUSED(Tcl_Size),
+    Tcl_Obj *const *objv,
+    void *dstPtr)
+{
+    Tcl_Obj **objPtr = (Tcl_Obj **) dstPtr;
+    Tcl_Size n;
+
+    /* check for a valid dictionary */
+    if (Tcl_DictObjSize(NULL, objv[0], &n) != TCL_OK) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("options must be a proper"
+	    "dictionary", -1));
+	return -1;
+    }
+
+    *objPtr = objv[0];
+    return 1;
+}
+
+static Tcl_Size
+ParseMargins(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    TCL_UNUSED(Tcl_Size),
+    Tcl_Obj *const *objv,
+    void *dstPtr)
+{
+    Tcl_Obj **objPtr = (Tcl_Obj **) dstPtr;
+    Tcl_Obj **listArr;
+    Tcl_Size n;
+    int i;
+
+    if (Tcl_ListObjGetElements(NULL, objv[0], &n, &listArr) != TCL_OK ||
+	n != 4 ||
+	Tcl_GetIntFromObj(NULL, listArr[0], &i) != TCL_OK ||
+	Tcl_GetIntFromObj(NULL, listArr[1], &i) != TCL_OK ||
+	Tcl_GetIntFromObj(NULL, listArr[2], &i) != TCL_OK ||
+	Tcl_GetIntFromObj(NULL, listArr[3], &i) != TCL_OK
+    ) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("margins must be a list "
+	    "of four integers: top left bottom right" , -1));
+	return -1;
+    }
+
+    *objPtr = objv[0];
+    return 1;
+}
+
+static Tcl_Size
+ParseNup(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    TCL_UNUSED(Tcl_Size),
+    Tcl_Obj *const *objv,
+    void *dstPtr)
+{
+    const char **nup = (const char **) dstPtr;
+    int n;
+
+    if (Tcl_GetIntFromObj(NULL, objv[0], &n) != TCL_OK ||
+	(n != 1 && n != 2 && n != 4 && n != 6 && n != 9 && n != 16)
+    ) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong number-up value: "
+	    "should be 1, 2, 4, 6, 9 or 16", -1));
+	return -1;
+    }
+
+    *nup = Tcl_GetString(objv[0]);
+    return 1;
+}
+#endif /*HAVE_CUPS*/
+
+int
+#ifdef HAVE_CUPS
+Cups_Init(Tcl_Interp *interp)
+{
+    Tcl_Namespace *ns;
+    ns = Tcl_FindNamespace(interp, "::tk::print", NULL, TCL_GLOBAL_ONLY);
+    if (!ns)
+	ns = Tcl_CreateNamespace(interp, "::tk::print", NULL, NULL);
+    Tcl_CreateObjCommand(interp, "::tk::print::cups", Cups_Cmd, NULL, NULL);
+    Tcl_Export(interp, ns, "cups", 0);
+#else
+Cups_Init(TCL_UNUSED(Tcl_Interp *))
+{
+    /* Do nothing */
+#endif
+    return TCL_OK;
+}