Tk Source Code

	    return $color
	}

	# Initialize all the variables once.
	_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 &
	}

	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}

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

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

    # _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) {}
	dict for {printer options} [cups getprinters] {
	    lappend optlist(printer) $printer
	    set pinfo($printer) $options
	}

	# 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.
	# option add *Printdialog*Menu.background snow




	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 ")"
		    }
		}
	    }
	    set id [$tv insert {} end \
		-values [list $printer $location $state]]
	    if {$option(printer) eq $printer} {
		$tv selection set $id
	    }
	}

	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
	}

	# 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 $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}

	# cleanup binding
	bind $bf <Destroy> [namespace code [list _cleanup $p]]

	# Center the window as a dialog.
	::tk::PlaceWindow $p
    }

    # _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]
	}
    }

    # _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
	}
    }

    # _cleanup
    #   Perform cleanup when the dialog is destroyed.
    # Arguments:
    #   p - print dialog pathname (not used).
    #
    proc ::tk::print::_cleanup {p} {
	namespace delete dlg

    }

    # _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
	    }
	    # 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]]
	}




	# 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

namespace eval ::tk::print {
    #begin macOS Aqua procedures
    if {[tk windowingsystem] eq "aqua"} {
	# makePDF -
	#   Convert a file to PDF
	# Arguments:
	#   inFilename -  file containing the data to convert; format is
	#                 autodetected.

TCL_STUB_LIB_FLAG	= @TCL_STUB_LIB_FLAG@
TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@

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@ @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
# symbols mean.  The values of the symbols are normally set by the
# configure script.  You shouldn't normally need to modify any of
# these definitions by hand.

REZ			= @REZ@
REZ_SWITCHES = @REZ_FLAGS@ -i $(GENERIC_DIR) -i $(TCL_GENERIC_DIR)

# support for Xft:
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
# modify any of this stuff by hand.
#----------------------------------------------------------------

AC_FLAGS		= @DEFS@

STUB_LIB_OBJS = tkStubLib.o ttkStubLib.o

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 \
	tkUnixPrint.o

AQUA_OBJS = tkMacOSXBitmap.o tkMacOSXButton.o tkMacOSXClipboard.o \
	tkMacOSXColor.o tkMacOSXConfig.o tkMacOSXCursor.o tkMacOSXDebug.o \
	tkMacOSXDialog.o tkMacOSXDraw.o tkMacOSXEmbed.o tkMacOSXEntry.o \
	tkMacOSXEvent.o tkMacOSXFileTypes.o tkMacOSXFont.o tkMacOSXHLEvents.o \
        tkMacOSXImage.o tkMacOSXInit.o tkMacOSXKeyboard.o tkMacOSXKeyEvent.o \
	tkMacOSXMenu.o tkMacOSXMenubutton.o tkMacOSXMenus.o \

	$(UNIX_DIR)/tkUnixRFont.c \
	$(UNIX_DIR)/tkUnixFont.c $(UNIX_DIR)/tkUnixInit.c \
	$(UNIX_DIR)/tkUnixKey.c \
	$(UNIX_DIR)/tkUnixMenu.c $(UNIX_DIR)/tkUnixMenubu.c \
	$(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)/tkUnixPrint.c

AQUA_SRCS = \
	$(MAC_OSX_DIR)/tkMacOSXBitmap.c $(MAC_OSX_DIR)/tkMacOSXButton.c \
	$(MAC_OSX_DIR)/tkMacOSXClipboard.c $(MAC_OSX_DIR)/tkMacOSXColor.c \
	$(MAC_OSX_DIR)/tkMacOSXConfig.c $(MAC_OSX_DIR)/tkMacOSXCursor.c \
	$(MAC_OSX_DIR)/tkMacOSXDebug.c $(MAC_OSX_DIR)/tkMacOSXDialog.c \
	$(MAC_OSX_DIR)/tkMacOSXDraw.c $(MAC_OSX_DIR)/tkMacOSXEmbed.c \

tkUnixMenu.o: $(UNIX_DIR)/tkUnixMenu.c
	$(CC) -c $(CC_SWITCHES) $(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

tkUnixScrlbr.o: $(UNIX_DIR)/tkUnixScrlbr.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixScrlbr.c

tkUnixSelect.o: $(UNIX_DIR)/tkUnixSelect.c

ZIP_INSTALL_OBJS
ZIP_PROG_VFSSEARCH
ZIP_PROG_OPTIONS
ZIP_PROG
MACHER_PROG
EXEEXT_FOR_BUILD
CC_FOR_BUILD
CUPS_LIBS
CUPS_CFLAGS
UNIX_FONT_OBJS
XFT_LIBS
XFT_CFLAGS
XMKMF
CPP
LDFLAGS_DEFAULT
CFLAGS_DEFAULT

enable_rpath
enable_corefoundation
enable_load
enable_symbols
enable_aqua
with_x
enable_xft
enable_libcups
enable_xss
enable_framework
enable_zipfs
'
      ac_precious_vars='build_alias
host_alias
target_alias

  --disable-rpath         disable rpath support (default: on)
  --enable-corefoundation use CoreFoundation API on MacOSX (default: on)
  --enable-load           allow dynamic loading and "load" command (default:
                          on)
  --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)
  --enable-zipfs          build with Zipfs support (default: on)

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]

    else
	UNIX_FONT_OBJS=tkUnixFont.o
    fi



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.
#
# Check whether the header and library for the XScreenSaver
# extension are available, and set HAVE_XSS if so.

    else
	UNIX_FONT_OBJS=tkUnixFont.o
    fi
    AC_SUBST(XFT_CFLAGS)
    AC_SUBST(XFT_LIBS)
    AC_SUBST(UNIX_FONT_OBJS)
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.
#
# Check whether the header and library for the XScreenSaver
# extension are available, and set HAVE_XSS if so.

    Tcl_Interp *interp)
{
    TkCreateXEventSource();
    GetLibraryPath(interp);
    Tktray_Init(interp);
    (void)SysNotify_Init (interp);
    Icu_Init(interp);
    Cups_Init(interp);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TkpGetAppName --

 * they're defined in.
 */

#include "tkIntPlatDecls.h"

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 */


/*
 * Local Variables:
 * mode: c

/*
 * 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;
}