From 8940f0d3fee47a62a1b4ad9a744bacc418a7bde7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emiliano=20Gavil=C3=A1n?= Date: Mon, 27 May 2024 23:31:19 +0000 Subject: Printing on *nix/X11 using libcups API. Initial commit --- library/print.tcl | 757 +++++++++++++++++++++++++++++++++++++---------------- unix/Makefile.in | 6 +- unix/tkUnixInit.c | 1 + unix/tkUnixInt.h | 1 + unix/tkUnixPrint.c | 520 ++++++++++++++++++++++++++++++++++++ 5 files changed, 1051 insertions(+), 234 deletions(-) create mode 100644 unix/tkUnixPrint.c diff --git a/library/print.tcl b/library/print.tcl index 1a7f710..00a6022 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -652,271 +652,564 @@ 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 + } + -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 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 notfound "No destinations added" - if {[string first $notfound $msg] != -1} { - error "Please check or update your CUPS installation." - return - } - - # 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 <> [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 [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] - # launch the job in the background - after 0 [list exec $printcmd {*}$printargs -o PageSize=$sel(paper) $file] - destroy $p + set printargs {} + lappend printargs -title "[tk appname]: Tk window $w" + lappend printargs -copies $option(copies) + lappend printargs -media [dict get $mcmap(media) $option(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 data [encoding convertto utf-8 [$w get -displaychars 1.0 end]] + if {$option(tzoom) != 100} { + set factor [expr {$option(tzoom) / 100.0}] + lappend printargs -tzoom $factor + } + 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) ] } - # 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 } - #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..806a770 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -394,7 +394,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 +517,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 \ 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..f8640ea --- /dev/null +++ b/unix/tkUnixPrint.c @@ -0,0 +1,520 @@ +/* + * 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 + +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; + int 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(ClientData), + 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; int buflen; + + const Tcl_ArgvInfo argTable[] = { + {TCL_ARGV_GENFUNC, "-colormode", ParseEnumOptions, &color, + "color mode", (ClientData) &parseData[PARSECOLORMODE]}, + {TCL_ARGV_INT , "-copies", NULL, &copies, + "number of copies", NULL}, + {TCL_ARGV_GENFUNC, "-format", ParseEnumOptions, &format, + "data format", (ClientData) &parseData[PARSEFORMAT]}, + {TCL_ARGV_GENFUNC, "-margins", ParseMargins, &marginsObj, + "media page size", NULL}, + {TCL_ARGV_GENFUNC, "-media", ParseEnumOptions, &media, + "media page size", (ClientData) &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", (ClientData) &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) { + int n; + Tcl_Obj **listArr; + + Tcl_ListObjGetElements(interp, 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); + } + } + if (tzoom != 1.0) { + 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 int +ParseEnumOptions( + ClientData clientData, + Tcl_Interp *interp, + TCL_UNUSED(int), + 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 int +ParseOptions( + TCL_UNUSED(ClientData), + Tcl_Interp *interp, + TCL_UNUSED(int), + Tcl_Obj *const *objv, + void *dstPtr) +{ + Tcl_Obj **objPtr = (Tcl_Obj **) dstPtr; + int 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 int +ParseMargins( + TCL_UNUSED(ClientData), + Tcl_Interp *interp, + TCL_UNUSED(int), + Tcl_Obj *const *objv, + void *dstPtr) +{ + Tcl_Obj **objPtr = (Tcl_Obj **) dstPtr; + Tcl_Obj **listArr; + int n; + + if (Tcl_ListObjGetElements(NULL, objv[0], &n, &listArr) != TCL_OK || + n != 4 || + Tcl_GetIntFromObj(interp, listArr[0], &n) != TCL_OK || + Tcl_GetIntFromObj(interp, listArr[1], &n) != TCL_OK || + Tcl_GetIntFromObj(interp, listArr[2], &n) != TCL_OK || + Tcl_GetIntFromObj(interp, listArr[3], &n) != 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 int +ParseNup( + TCL_UNUSED(ClientData), + Tcl_Interp *interp, + TCL_UNUSED(int), + 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 +Cups_Init(Tcl_Interp *interp) +{ +#ifdef HAVE_CUPS + 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); +#endif + return TCL_OK; +} -- cgit v0.12